[Date Index]
[Thread Index]
[Author Index]
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
Prev by Date:
**Re: Getting rid of annoying zeroes in algebraic expressions**
Next by Date:
**Re: Getting rid of annoying zeroes in algebraic expressions**
Previous by thread:
**Triangles and trigonometry**
Next by thread:
**Re: Triangles and trigonometry**
| |