Re: Triangles and trigonometry

*To*: mathgroup at smc.vnet.net*Subject*: [mg15248] Re: [mg15000] Triangles and trigonometry*From*: jtischer at col2.telecom.com.co (Cl-Jurgen Tischer)*Date*: Sun, 27 Dec 1998 03:58:39 -0500*Organization*: Universidad del Valle*References*: <199812050630.BAA04458@smc.vnet.net.>*Sender*: owner-wri-mathgroup at wolfram.com

Mark, it's a long time since you asked for help, I hope you are still interested. I found the problem not at all trivial (maybe I'm just stupid) and fooled around with it in my spare time. The result you can see if you copy the notebook below into a new notebook. Evaluate the code and look at the examples if you like. It's almost surely with bugs, not all problems can be solved, some solutions won't show up due to facts like Solve will give back one solution for cases of ArcSin and so on. And I restricted myself to some standard parts of the triangle, i.e. a,b,c,\[Alpha],\[Beta],\[Gamma],ha,hb,hc,r,\[Rho],pac,pbc,pca,pba,pab,pcb, where pac is the projection of a on c (for a full explanation see the notebook). To be sure, what Mathematica does is essentially consulting a database of formulas and trying to extend it's knowledge about parts one by one (I found if one Solve's for multiple parts at once, one runs immediately in problems of the type "The equations appear to involve transcendental functions of the variables in an essentially non-algebraic way.") This one-at-a-time method has the drawback that one easily produces additional wrong solutions. So I had to check every solution for consistency. To this effect I in a second database put together some basic inequalities and implications. (I felt quite happy that this way I used for the first time in my life the built-in function Implies.) Jurgen Notebook[{ Cell[CellGroupData[{ Cell["TriangleSolve", "Subsection"], Cell[TextData[ "a,b,c : length of sides; \[Alpha], \[Beta], \[Gamma] : opposite angles; ha, \ hb, hc: height over a, b, c; r: radius of circumscribed circle; \[Rho] : \ radius of inner circle; pac : projection of a onto c, etc"], "Text"], Cell[CellGroupData[{ Cell["Code", "Subsubsection", InitializationCell->True], Cell[BoxData[ \(Clear[a, b, c, \[Alpha], \[Beta], \[Gamma], ha, hb, hc, r, \[Rho], pac, pbc, pca, pba, pab, pcb]\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(extNames = {a, b, c, \[Alpha], \[Beta], \[Gamma], ha, hb, hc, pab, pac, pba, pbc, pca, pcb, r, \[Rho]}; \)\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(intNames = {$s[1], $s[2], $s[3], $a[1], $a[2], $a[3], $h[1], $h[ 2], $h[3], \($p[1]\)[2], \($p[1]\)[3], \($p[2]\)[1], \($p[2]\)[3], \($p[3]\)[1], \($p[3]\)[2], $r[0], $\[Rho][0]}; \)\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(posvars = {$s[1], $s[2], $s[3], $a[1], $a[2], $a[3], $h[1], $h[2], $h[ 3], $r[0], $\[Rho][0]}; \)\)], "Input", InitializationCell->True], Cell[BoxData[ \(nonposvars = Complement[intNames, posvars]\)], "Input", InitializationCell->True], Cell[BoxData[ \(ext2int := Thread[Rule[extNames, intNames]]\)], "Input", InitializationCell->True], Cell[BoxData[ \(int2ext := Thread[Rule[intNames, extNames]]\)], "Input", InitializationCell->True], Cell[BoxData[ \(trans[li_] := li /. ext2int\)], "Input", InitializationCell->True], Cell[BoxData[ \(invtrans[li_] := \((li /. int2ext)\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[a_ -> _] := True /; MemberQ[nonposvars, a]\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[x_] := False /; NonPositive[x]\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[x_] := False /; \(! FreeQ[x, Complex]\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[x_. \ at _] := positiveQ[x]\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[x_. \/\ at _] := positiveQ[x]\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[expr_. \ x_] := positiveQ[expr] /; MemberQ[posvars, x]\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[_ -> x_] := positiveQ[x]\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[Rule[a_, b_]] := False /; MemberQ[posvars, a] && \(! positiveQ[b]\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[li : {__Rule}] := And@@\((positiveQ/@li)\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(positiveQ[x_] := True\)], "Input", InitializationCell->True], Cell[BoxData[ \(permut[eq_, perm_] := eq /. {x_Symbol[l_Integer?Positive] :> x[perm[\([l]\)]], \(x_Symbol[n_Integer?Positive]\)[m_Integer?Positive] :> \(x[perm[\([n]\)]]\)[perm[\([m]\)]]}\)], "Input", InitializationCell->True], Cell[BoxData[ \(allpermut[eq_] := Union[\(permut[eq, #]&\)/@{{1, 2, 3}, {2, 3, 1}, {3, 1, 2}}]\)], "Input",\ InitializationCell->True], Cell[BoxData[ \(database1 = {\(-\[Pi]\) + \[Alpha] + \[Beta] + \[Gamma], a\^2 - b\^2 - c\^2 + 2\ b\ c\ Cos[\[Alpha]], \(-b\)\ Sin[\[Alpha]] + a\ Sin[\[Beta]], a\ ha - b\ hb, ha - b\ Sin[\[Gamma]], ha - c\ Sin[\[Beta]], a - 2\ r\ Sin[\[Alpha]], ha\ Sin[\[Alpha]] - a\ Sin[\[Beta]]\ Sin[\[Gamma]], pba + pca - a, \(-b\)\ pab + a\ pba, \(-c\^2\) + ha\^2 + pca\^2, \(-b\^2\) + ha\^2 + pba\^2, a - \[Rho]\ \((Cot[\[Beta]\/2] + Cot[\[Gamma]\/2])\), \(-b\)\ c + 2\ ha\ r, a\^2\ b\^2 - a\^4 - b\ hb\ \((\(-2\)\ a\^2\ Cot[\[Beta]] + b\ hb\ Csc[\[Beta]]\^2)\), c\^2\ Cos[\[Alpha]]\^2 - \((c\^2 - 2\ \[Rho]\^2)\)\ Cos[\[Gamma]] + 2\ \[Rho]\ \((\[Rho] + c\ Sin[\[Gamma]])\) + c\ Cos[\[Alpha]]\ \((c\ \((\(-1\) + Cos[\[Gamma]])\) - 2\ \[Rho]\ Sin[\[Gamma]])\)} \)], "Input", InitializationCell->True], Cell[BoxData[ \(\(database2 = {a + b > c, \[Alpha] + \[Beta] < \[Pi], hc <= a, hc <= b, a <= 2 r, \[Rho] < a\/2, Implies[pac < 0, \[Beta] > \[Pi]\/2], Implies[pbc < 0, \[Alpha] > \[Pi]\/2], Implies[pac > 0, \[Beta] < \[Pi]\/2], Implies[pbc > 0, \[Alpha] < \[Pi]\/2]}; \)\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(equations = Flatten[allpermut/@trans[database1]]; \)\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(checks = Flatten[allpermut/@trans[database2]]; \)\)], "Input", InitializationCell->True], Cell[BoxData[ \(compatibleQ[x : {__Rule}] := If[And@@Join[Thread[Chop[equations /. x] == 0], checks /. x] === False, False, True]\)], "Input", InitializationCell->True], Cell[BoxData[ \(vars[eq_] := Union[Cases[eq, x_[_Integer] | \(x_[_Integer]\)[_Integer], \[Infinity]]] \)], "Input", InitializationCell->True], Cell[BoxData[ \(toRule[x_Rule] := x\)], "Input", InitializationCell->True], Cell[BoxData[ \(toRule[{a_, b_}] := a -> b\)], "Input", InitializationCell->True], Cell[BoxData[ \(toRule[x_Symbol] := x -> x\)], "Input", InitializationCell->True], Cell[BoxData[ \(triangleSolve = ts\)], "Input", InitializationCell->True], Cell[BoxData[ \(ts[li : {__Rule}, goal_List: {a, b, c}] := Module[{res = ts1[trans[li], trans[goal]], sol}, \n\t\t sol = Sort/@Cases[{res}, {__Rule}, \[Infinity]]; \n\t\t If[FreeQ[res, Fail], invtrans[sol], {Fail, invtrans[sol], goal}]]\)], "Input", InitializationCell->True], Cell[BoxData[ \(ts[x__, goal_List: {a, b, c}] := ts[toRule/@{x}, goal]\)], "Input", InitializationCell->True], Cell[BoxData[ \(ts1[li_, goal_] := If[compatibleQ[li], \ Select[li, Or@@Thread[#[\([1]\)] == goal]&], Message[ts1::ncomp]; Abort[]] /; \((Union[Cases[First/@li, Alternatives@@goal, \[Infinity]]] == Union[goal])\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(ts1[li_, goal_] := Module[{eq = Select[equations, Length[Complement[vars[#1], First/@li]] == 1&, 1], sol}, If[eq == {}, Return[{Fail, {{li}, goal}}]]; \n\t\t sol = Union[ Select[Solve[eq == 0 /. li, Complement[vars[eq], First/@li]], positiveQ[#] && compatibleQ[Join[li, #]]&]]; \n\t\t If[sol == {}, Return[]]; \n\t\((ts1[Join[li, #1], goal]&)\)/@sol]\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(ts1::ncomp = "\<Data is not compatible.\>"; \)\)], "Input", InitializationCell->True] }, Open ]], Cell[CellGroupData[{ Cell["Examples", "Subsubsection"], Cell["By default triangleSolve calculates a, b and c. ", "Text"], Cell[BoxData[ \(triangleSolve[a -> 2, b -> 3, hc -> 1]\)], "Input"], Cell["\<\ To calculate other parts (of the above called vars), one adds them as a list.\ \ \>", "Text"], Cell[BoxData[ \(triangleSolve[a -> 2, b -> 3, hc -> 1, {\[Alpha], r, \[Rho]}]\)], "Input"], Cell["\<\ It is allowed to leave values out. In that case there may be non valid \ solutions. Especially triangleSolve cannot check always for negative \ (non compatible) solutions.\ \>", "Text"], Cell[BoxData[ \(triangleSolve[a, b, hc, {\[Alpha], r, \[Rho]}]\)], "Input"], Cell["\<\ The next two examples are the reason it took me so long. The last two (fourth \ order) equations of database1 are for those two cases.\ \>", "Text"], Cell[BoxData[ \(triangleSolve[c -> 3. , hc -> 1, \[Gamma] -> 60 \[Degree]]\)], "Input"], Cell[BoxData[ \(triangleSolve[\[Alpha] -> 45 \[Degree], \[Rho] -> 1. , r -> 3. ]\)], "Input"] }, Closed]] }, Closed]] }] DIAMOND Mark R wrote: > > I'm embarrassed to need help with this, given how trivial it should be, > but ... Does anyone know of a package suitable for solving triginometry > problems such as > > (Upper case are angles, lower case is opposite side) > > A=12 Degree > a=5 > b=17 > C<90 Degree > > I've written something (which works) using repeated applications of > Solve with the Sin and Cos rules which does the job very badly(!). > However, it doesn't cope with the _generic_ case of _any_ mixture of > (minimally sufficient) information, and I've had to go about the > solution in several steps to get it to work properly. > > Mark R Diamond

**References**:**Triangles and trigonometry***From:*"DIAMOND Mark R" <gabrielle@XXXpsy.uwa.edu.au>