(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.2' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 83682, 1705]*) (*NotebookOutlinePosition[ 84554, 1736]*) (* CellTagsIndexPosition[ 84465, 1730]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["\<\ Computer Algebra in Geodesy Resection N-points problem\ \>", "Title", TextAlignment->Center], Cell["B\[EAcute]la Pal\[AAcute]ncz", "Author", TextAlignment->Left], Cell["\<\ Department of Photogrammetry and Geoinformatics Budapest University of Technology and Economics, H-1111 Budapest, M\[UDoubleAcute]egyetem rkp. K. I. 19., HUNGARY palancz@epito.bme.hu\ \>", "TextAboutAuthor", TextAlignment->Left], Cell[TextData[{ "Ranging, resection, intersection and parameter estimation of \ transformations as well as adjustment are the most frequent problems in \ Geodesy and Geoinformatics. In this tutorial type study, we present ", StyleBox["Mathematica", FontSlant->"Italic"], " solutions for resection problem. Symbolic solutions of the Grunert \ equations via Groebner basis built in ", StyleBox["Mathematica ", FontSlant->"Italic"], "are presented ", StyleBox[" ", FontSlant->"Italic"], "for the 3-points as well as for the N-points problem, where Gauss - Jacobi \ combinatorical method was employed. Numerical example illustrates, that \ direct numerical solution needs considerably more computation time than the \ evalutation of the symbolic solution built in a ", StyleBox["Mathematica", FontSlant->"Italic"], " package, ", StyleBox["Resection3D", FontFamily->"Courier New", FontWeight->"Bold"], ". The computations were carried out with ", StyleBox["Mathematica", FontSlant->"Italic"], " version 5.2" }], "Abstract", TextAlignment->Left], Cell[CellGroupData[{ Cell["1. Introduction", "Section", TextAlignment->Left], Cell[TextData[{ "Nowadays, general purpose computer algebra systems (CAS) like ", StyleBox["Mathematica", FontSlant->"Italic"], ", Maple, Axiom, Macsyma etc., are widely used by scientists and engineers \ in different fields. A new paradigm seems to be arising in communication of \ scientific information traditionally restricted using mathematics, namely the \ application of CAS to explain algorithms, methods or computation techniques. \ Although, most of the scientists believe, even today, that CAS language is a \ programming language, however this is not so. CAS can be used like \"live\" \ mathematics for creating, proving as well evaluating formulas and expressions \ in numeric or symbolic form, see for example Freeman [3], Helton and Merino \ [5], Bellomo et al. [6] and Romeny [4]. \nRecently, Haneberg [1] as well as \ Awange and Grafarend [2] published books about the applications of CAS in \ Geosciences, Geodesy and Geoinformatics. The first one, even contains ", StyleBox["Mathematica", FontSlant->"Italic"], " notebooks providing instant computational facility for practitioners. \n\ Ranging, resection, intersection and parameter estimation of transformations \ as well as adjustment are the most frequent problems in Geodesy and \ Geoinformatics.The resection N-points problem representing one of the \ important problems of determination of position as well as orientation, has \ been studied since many years. , For example, recently resection methods find \ use in densification of GPS networks. If a station is inside a tunnel or \ forest, the GPS receiver can not be used due to signal blockage. In such \ case, the coordinates of the unknown tunnel or forest station can be computed \ via resection based on angular measurements to three known GPS stations.\n \ The first solution of the three-dimensional resection in closed form by \ solving an algebraic equation of degree four was published by Grunert [7] in \ the year 1841. Recently, the closed form solution of overdetermined, N-points \ problem of resection is presented by Awange and Grafahrend [8] and an \ extensive overview of the subject can be found in Awange's Ph.D. thesis [9].\n\ In this tutorial type study, we present ", StyleBox["different ", FontVariations->{"CompatibilityType"->0}], "solutions for resection problem using built in functions of ", StyleBox["Mathematica,", FontSlant->"Italic"], " and also provide a ", StyleBox["Mathematica", FontSlant->"Italic"], " package to solve this problem. It will be illustrated, how CAS can be \ employed to explain and demonstrate ideas, algoritms as well as computing \ techniques. " }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["2. Grunert distance equations", "Section"], Cell[TextData[{ "The three-dimensional resection problem concerns itself with the \ determination of position and orientation of point ", Cell[BoxData[ \(TraditionalForm\`P\_0\)]], " connected by angular observations, ", Cell[BoxData[ \(TraditionalForm\`\[CurlyPhi]\_\(i, j\)\)]], ", ", StyleBox["i", FontSlant->"Italic"], ", ", StyleBox[",j", FontSlant->"Italic"], " = 1,2,3 to three known stations, ", Cell[BoxData[ \(TraditionalForm\`P\_i\)]], ", i = 1,2,3, see Figure 1. It means, that the space angles, ", Cell[BoxData[ \(TraditionalForm\`\[CurlyPhi]\_\(i, j\)\)]], " as well as the distances ", Cell[BoxData[ \(TraditionalForm\`S\_\(i, j\)\)]], ", ", StyleBox["i", FontSlant->"Italic"], ", ", StyleBox[",j", FontSlant->"Italic"], " = 1,2,3 are known and the distances ", Cell[BoxData[ \(TraditionalForm\`S\_i\)]], ", ", StyleBox["i ", FontSlant->"Italic"], "=1, 2, 3 should be computed.\n" }], "Text"], Cell[GraphicsData["Metafile", "\<\ CF5dJ6E]HGAYHf4PEfU^I6mgLb15CDHPAVmbKF5d0@0004_/0@0008`0001D0P009@000?T:002H1000 00000000001F>000cA<00215CDH00040k4/000@2000:00003`0006`0000000009Q80058J00350000 7@40000000000000000004T00`0jFP@0EP1905<0B@1?0000A01b0640M`1Y06h0I`000000000U0000 300000P0080U0000300000D0081B0000L0400040002Loooo0000000000000000T04000000>h00000 @@1b06T0H@1/00000000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000=0000000000000000000000000000000000000000000000000000 0000000000000000003U0@0000000000J00001T0000003d07?LB0000001/nA806>j@O?06TGcooooo j`JAO@1V4?U0@00001TMP08000002D0000<00000@0002D0000<00003P00P2P0000<0000 0@0000X0000@00000000000000090000400004l=002^10009P0001`000010000000000H000000000 000002D0000<00000@000180000<00000@000180000<00000P0002L0000H00000P000000003oool0 000002D0000<00000P0005H0000/0000Y`800?D0003S2P00j`<000@0003O2^L3:0Gi0:/2i`?O2^L3 9@0000`000080020:00000`0000100009@0000`000050020:00000`0000200006@0000`0003oool0 5P0000`0000H0000DP00070100020000W?ooo`0000000000000009010000003^00008440LP1Y0640 K0000000000000000000000000000000000000000000000000000000000000000000000000000180 D@FAO1P7?@1]1I5l?9Ba032NiP400000000000000000000000000000000000000000000000000000 0000000000000000B1[W0@000000000060000000000003d0W?8B0000000H00006>j@O?06TGcooooo j`JAO000`GL003d000000@12?H100<0001@m180 ooooodCe4P00091lL0FAO?oooom]1I5lg/;1M`00?@000000hl;1McbD/@0`W^H1000006ce4P000000 6A8SH0`0000PmA80I7H02000000U000030000080000H000030000000000U0000300000d0080V0000 70000040000000001P000000000000009@0000`0000100004P0000`0000100006`000100002a0P00 i`<003H0000@0000_0800>@3000K000040000X2003F0`006`000100003e0P00dP<003H0000@00000@<000`00=P000100002e1000 B`<001/0000@0000`0@004L3000f000040000<`400140`006`000100003G1000@@<003H0000@0000 hP@003d3000K000040000>h4000j0`00=P000100003i1000=P<001/0000@00001@D003<3000f0000 40000105000_0`006`000100000L1@00;0<003H0000@00009`D002P3000K0000400003<5000U0`00 =P000100000n1@008@<001/0000@0000BPD001h3000f0000400005D5000J0`006`000100001Q1@00 5`<003H0000@0000K0D001<3000K0000400007P5000@0`00=P00010000231@003@<001/0000@0000 SPD000T3000f0000400009T500060`009@0000`000080020:00000`0000100009@0000`000050020 9P0001`000010000000000H000000000000002D0000<00000@000180000<00000@0001/0000@0000 :`D00?X0000f0000400002d500060@006`000100000`1@004P4003H0000@0000<`D001h1000K0000 400003D5000Z0@00=P000100000h1@00=P4001/0000@0000>PD00481000f0000400003d5001>0@00 6`000100000o1@00FP4003H0000@0000@PD006H1000K0000400004@5001b0@00=P00010000171@00 OP4001/0000@0000B@D008X1000f0000400004`5002F0@006`000100001>1@00XP4003H0000@0000 D@D00:h1000K0000400005<5002j0@00=P000100001F1@00aP4001/0000@0000F0D00=81000f0000 400005/5003N0@006`000100001M1@00jP4003H0000@0000H0D00?H1000K00004000068500020P00 =P000100001U1@003P8001/0000@0000I`D001X2000f0000400006X5000V0P006`000100001/1@00 @H00243000K0000400004D6000S0`00=P000100001A1P009@<001/0000@0000 G@H002L3000f0000400006T6000Y0`006`000100001e1P00:`<003H0000@0000P@H002d3000K0000 400008d6000_0`00=P000100002I1P00<@<001/0000@0000Y@H003<3000f000040000;46000e0`00 6`000100002m1P00=`<003H0000@0000b@H003T3000K000040000=D6000k0`00=P000100003Q1P00 ?@<001/0000@0000k@H003l3000f000040000?T600110`006`00010000051`00@`<003H0000@0000 4@L004D3000K0000400001d700170`00=P000100000Y1`00B@<001/0000@0000=@L004/3000f0000 40000447001=0`006`000100001=1`00C`<003H0000@0000F@L00543000K0000400006D7001C0`00 =P000100001a1`00E@<001/0000@0000O@L005L3000f0000400008T7001I0`006`000100002E1`00 F`<003H0000@0000X@L005d3000K000040000:d7001O0`00=P000100002i1`00H@<001/0000@0000 a@L006<3000f000040000=47001U0`006`000100003M1`00I`<003H0000@0000j@L006T3000K0000 40000?D7001[0`00=P00010000012000K@<001/0000@00003@P006l3000f0000400001T8001a0`00 6`000100000U2000L`<003H0000@0000<@P007D3000K0000400003d8001g0`00=P00010000192000 N@<001/0000@0000E@P007/3000f000040000648001m0`006`000100001]2000O`<003H0000@0000 N@P00843000K0000400008D800230`00=P000100002A2000Q@<001/0000@0000W@P008L3000f0000 40000:T800290`006`000100002e2000R`<003H0000@0000`@P008d3000K000040000d9002o0`00=P000100003i2@00`@<001/0000@00001@X00<<3000f0000 4000014:00350`006`000100000M2P00a`<003H0000@0000:@X0043000K0000 40000L3000f000040000=l:003W0`00 9@0000`000080020:00000`0000100009@0000`0000500209P0001`000010000000000H000000000 000002D0000<00000@000180000<00000@0005L0000T00002PD000/1001H1@0070400080000>1AP1 E0D?0BD0000<00002000P2P0000<00000@0002D0000<00001@00P2H0000L00000@00000000060000 00000000000U000030000040000B000030000040000K0000400003L5000g0@00=P00010000111@00 <04001/0000@0000B`D002T1000f0000400005@5000R0@006`000100001N1@006`4003H0000@0000 H`D001L1000U0000300000P0080X000030000040000U0000300000D0080V00007000004000000000 1P000000000000009@0000`0000100004P0000`0000100006`000100003S1000BP4003H0000@0000 k`@004/1000K000040000?/4001=0@00=P00010000071@00CP4001/0000@00004`D00501000f0000 400001l5001A0@006`000100000[1@00D`4003H0000@0000=`D005@1000U0000300000P0080X0000 30000040000U0000300000D0080U0000300000P0080F0000300001P0001B0000L0400040002Loooo 0000000000000000T04000000>h0000P@@1b06T0H@1/000000000000000000000000000000000000 00000000000000000000000000000000000000004P1A1I5l60Lm06d5TG`lU;40>1WW0@0000000000 00000000000000000000000000000000000000000000000000000000000`W^H100000000000H0000 00000000?@2LlQ80000001P0000HkY1ll0JAO?ooooo[1Y5l0031M`00?@000000c/?1M`O4`GL003d0 ooooofCe4P3[Xb=Pd?@B01E/i048mP400`00053d4P3oooooA?DB0000T7a`1I5looooofd5TGcN`/5g 000m0000003S`/5g?9Ba03PIi`400000K?DB0000000I4R=P3000023e4P1TMP08000002D0000<0000 0@0001P0000<000000000180000<00000@0005@0001D0000E0800>03002F0P00C`@000400036[hM0 2eZ7@5@2000j10000@0004`00000000000000000003ooooooooooe00001@0000@`000180000<0000 0@000580001`0@000`000;goool0000000000000002@0@000000kP0002110780J@1Q06`000000000 0000000000000000000000000000000000000000000000000000000000000000000B0545TG`H1cd0 K@FAO3bD/@3HUNH100000440LP1Y0640K00000000000000000000420iP4000000000000000000000 000003PIi`6i0b45@83V0AP000000000000m09cb4P1]1I5l600001S^T7c`1Y5looooon/6TG`00<5g 000m0000003>`l5g1lC1M`00?@3oooooI?DB0>^S8f3@m180oEKU0@Sf0@030000D?@B0?oooom4mA80 002@O705TGcoooooK@FAO=k2`GL003d000000>?2`GLlU;40f9GV0@00001/mA80000001TB8f0<0000 8?DB06Af00P000009@0000`0000300004P0000`000010000E00005@0002G0P007`@00;/2001Y1000 0@000j@O?06TGcoooooj`JAO000`GL003d000000@12?H100<0001@m180ooooodCe4P00091lL0FAO?oooom]1I5l g/;1M`00?@000000hl;1McbD/@186^L1000006ce4P0000006A8SH0`0000PmA80I7H02000000U0000 300000@0000H000030000000000B000030000040001D0000E000098:000?1000e0X007h400010000 aZn7@0]JQd2B2P00J@@00040001<00000000000000000000oooooooooom@0000D03ood<0000B0000 30000040001B0000L04000D0002moooo0000000000000000T04000000>h0000P@@1b06T0H@1/0000 0000000000000000000000000000000000000000000000000000000000000000000000004P1A1I5l 60Lm06d5TG`lU;4001KW0@0000110780J@1Q06`00000000000000000003@FNH10000000000000000 0000000000186^L1^@`l5g 1lC1M`00?@3oooooI?DB0>^S8f3@m1805FcT0@Sf0@030000D?@B0?oooom4mA80002@O705TGcooooo K@FAO=k2`GL003d000000>?2`GLlU;40<9kV0@00001/mA80000001TB8f0<00008?DB06Af00P00000 9@0000`000060000600000`0000000004P0000`000010000E00005@0002>1@007@<00=05002<0`00 0@000j@O?06TGcooooo j`JAO000`GL003d000000h0000P@@1b06T0H@1/0000 0000000000000000000000000000000000000000000000000000000000000000000000004P1A1I5l 60Lm06d5TG`lU;40f9GV0@0000000000000000000000000000000000000000000000000000000000 00000000000h6NL100000000000H000000000000?@2LlQ80000001P0000HkY1ll0JAO?ooooo[1Y5l 0031M`00?@000000c/?1M`O4`GL003d0ooooofCe4P3[Xb=Pd?@B01E/i048mP400`00053d4P3ooooo A?DB0000T7a`1I5looooofd5TGcN`/5g000m0000003S`/5g?9Ba0=REiP400000K?DB0000000I4R=P 3000023e4P1TMP08000002D0000<00000P0001P0000<000000000180000<00000@0005@0001D0000 6@D002L0001K1@00UP0000400036[hM02eZ7@1T5002100000@0004`00000000000000000003ooooo oooooe00001@0000@`000180000<00000@000580001`0@0020000;goool0000000000000002@0@00 0000kP0002110780J@1Q06`000000000000000000000000000000000000000000000000000000000 0000000000000000000B0545TG`H1cd0K@FAO3bD/@186^L100000440LP1Y0640K000000000000000 00000;RPiP400000000000000000000000000=REiP6i0b45^:3V0AP000000000000m09cb4P1]1I5l 600001S^T7c`1Y5looooon/6TG`00<5g000m0000003>`l5g1lC1M`00?@3oooooI?DB0>^S8f3@m180 oEKU0@Sf0@030000D?@B0?oooom4mA80002@O705TGcoooooK@FAO=k2`GL003d000000>?2`GLlU;40 B1[W0@00001/mA80000001TB8f0<00008?DB06Af00P000009@0000`0000800004P0000`000010000 E00005@0001M1@00IP000845002`00000@000j@O?06TGcoooooj`JAO000`GL003d000000@12?H100<0001@m180ooooodCe4P00091lL0FAO?oooom]1I5lg/;1M`00?@000000 hl;1McbD/@005^L1000006ce4P0000006A8SH0`0000PmA80I7H02000000U0000300000<0000H0000 30000000000B000030000040001D0000E00005L3003Y0@00V@<005P200010000aZn7@0]JQd1G0`00 @`800040001<00000000000000000000oooooooooom@0000D`2a04<0000B000030000040001B0000 L0400040002moooo0000000000000000T04000000>h0000P@@1b06T0H@1/00000000000000000000 000000000000000000000000000000000000000000000000000000004P1A1I5l60Lm06d5TG`lU;40 <9kV0@0000110780J@1Q06`00000000000000000002@_>H100000000000000000000000000005^L1 ^@`l5g1lC1M`00?@3oooooI?DB0>^S8f3@m1805FcT0@Sf0@030000D?@B0?oooom4mA80 002@O705TGcoooooK@FAO=k2`GL003d000000>?2`GLlU;40>1WW0@00001/mA80000001TB8f0<0000 8?DB06Af00P000009@0000`000050000600000`0000000004P0000`000010000E00005@000082000 h@4004X8001@0P000@0001WW0KT38@G0_NH160000000000003d0W?8B06d5TG`H0000 6>j@O?06TGcoooooj`JAO000`GL003d000000h0000P@@1b06T0H@1/0000000000000000000000000000000000000000000000000000 0000000000000000000000004P1A1I5l60Lm06d5TG`lU;40B1[W0@00000000000000000000000000 0000000000000000000000000000000000000000003HUNH100000000000H000000000000?@2LlQ80 000001P0000HkY1ll0JAO?ooooo[1Y5l0031M`00?@000000c/?1M`O4`GL003d0ooooofCe4P3[Xb=P d?@B01E/i048mP400`00053d4P3oooooA?DB0000T7a`1I5looooofd5TGcN`/5g000m0000003S`/5g ?9Ba04PJi`400000K?DB0000000I4R=P3000023e4P1TMP08000002D0000<00001`0001P0000<0000 00000180000<00000@0005@0001D0000QPD002`200381@00V`8000400036[hM02eZ7@8H500260P00 0@0004`00000000000000000003ooooooooooe00001C0000@`000180000<00000@000580001`0@00 1P000;goool0000000000000002@0@000000kP0002110780J@1Q06`0000000000000000000000000 000000000000000000000000000000000000000000000000000B0545TG`H1cd0K@FAO3bD/@005^L1 00000440LP1Y0640K0000000000000000000000Ji@4000000000000000000000000004PJi`6i0b45 01[U0AP000000000000m09cb4P1]1I5l600001S^T7c`1Y5looooon/6TG`00<5g000m0000003>`l5g 1lC1M`00?@3oooooI?DB0>^S8f3@m180oEKU0@Sf0@030000D?@B0?oooom4mA80002@O705TGcooooo K@FAO=k2`GL003d000000>?2`GLlU;4001KW0@00001/mA80000001TB8f0<00008?DB06Af00P00000 9@0000`0000600004P0000`000010000E00005@000391@00J`800>d5002e0P000@000j@O?06TGcoooooj`JAO000`GL003d0 00000@12?H100<0001@m180ooooodCe4P00091l L0FAO?oooom]1I5lg/;1M`00?@000000hl;1McbD/@0`W^H1000006ce4P0000006A8SH0`0000PmA80 I7H02000000U0000300000P0000H000030000000000B000030000040001D0000E0000186003n0`00 E0H006d400010000aZn7@0]JQd0B1P00F0@00040001<00000000000000000000oooooooooom@0000 D`31Md<0000B000030000040001B0000L0400080002moooo0000000000000000T04000000>h0000P @@1b06T0H@1/00000000000000000000000000000000000000000000000000000000000000000000 000000004P1A1I5l60Lm06d5TG`lU;40>1WW0@0000110780J@1Q06`00000000000000000003HgN@1 000000000000000000000000000`W^H1^@h0000P@@1b06T0H@1/0000000000000000000000000000000000000000000000000000 0000000000000000000000004P1A1I5l60Lm06d5TG`lU;40f9GV0@00000000000000000000000000 0000000000000000000000000000000000000000000h6NL100000000000H000000000000?@2LlQ80 000001P0000HkY1ll0JAO?ooooo[1Y5l0031M`00?@000000c/?1M`O4`GL003d0ooooofCe4P3[Xb=P d?@B01E/i048mP400`00053d4P3oooooA?DB0000T7a`1I5looooofd5TGcN`/5g000m0000003S`/5g ?9Ba0=REiP400000K?DB0000000I4R=P3000023e4P1TMP08000002D0000<00000@0001P0000<0000 00000180000<00000@0005@0001D0000?PL00=8200201`00@@<000400036[hM02eZ7@3h7000/0`00 0@0004`00000000000000000003ooooooooooe00001C091l@`000180000<00000@000580001`0@00 0`000;goool0000000000000002@0@000000kP0002110780J@1Q06`0000000000000000000000000 000000000000000000000000000000000000000000000000000B0545TG`H1cd0K@FAO3bD/@186^L1 00000440LP1Y0640K000000000000000000003R>iP400000000000000000000000000=REiP6i0b45 >8kV0AP000000000000m09cb4P1]1I5l600001S^T7c`1Y5looooon/6TG`00<5g000m0000003>`l5g 1lC1M`00?@3oooooI?DB0>^S8f3@m180oEKU0@Sf0@030000D?@B0?oooom4mA80002@O705TGcooooo K@FAO=k2`GL003d000000>?2`GLlU;40B1[W0@00001/mA80000001TB8f0<00008?DB06Af00P00000 9@0000`0000300004P0000`000010000E00005P000211`004P<00`l5g1lC1M`00?@3oooooI?DB0>^S8f3@m1805FcT0@Sf0@030000D?@B0?oooom4mA80 002@O705TGcoooooK@FAO=k2`GL003d000000>?2`GLlU;4001KW0@00001/mA80000001TB8f0<0000 8?DB06Af00P000009@0000`000040000600000`0000000004P0000`000010000E00005@0000V1000 dP8006P400110`000@000j@O?06TGcoooooj`JAO000`GL003d000000CU0Ec^4P3ekL=g 7nk3Ml3Ti@5o4cYP=>lB00<000000000?a<0023`4P0000=P00000=Od4P000000OahB06Af00P000009@0000`000060000 600000`0000000004P0000`000010000E00005@0000510009@0003D4002N00000@0001WW0@000000000060000000008003d0W?8B06d0HP0H00006>j@O?06TGcoooooj`JAO000`GL003d0 00000CU0Ec^4P3ekL=g7nk3Ml3Ti@5o4cYP=>lB00<000000000?a<0023`4P0000=P 00000=Od4P000000OahB06Af00P000009@0000`000020000600000`0000000004P0000`000010000E00005@0001I1P00 k00008T6001U0@000@000j@O?06TGcoooooj`JAO000`GL003d000000CU0Ec^4P3ekL=g7nk3Ml3Ti@5o4cYP =>lB00<000000000?a<0023`4P0000=P00000=Od4P000000OahB06Af00P000009@0000`000030000600000`000000000 4P0000`000010000E00005@000351000c@400?D400160P000@000j@O?06TGcoooooj`JAO000`GL003d000000"], "Graphics", ImageSize->{342.625, 120.063}, ImageMargins->{{0, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ StyleBox["Fig. 1", FontSlant->"Italic"], " Geometrical interpretation of the 3D resection" }], "Text", TextAlignment->Center], Cell["Grunert proposed the following distance equations, ", "Text"], Cell[BoxData[{ \(S\_\(1, 2\)\^2 = S\_1\^2 + S\_2\^2 - 2\ \(S\_1\) \(S\_2\) cos \((\[CurlyPhi]\_\(1, 2\))\)\), "\[IndentingNewLine]", \(S\_\(2, 3\)\^2 = S\_2\^2 + S\_3\^2 - 2\ \(S\_2\) \(S\_3\) cos \((\[CurlyPhi]\_\(2, 3\))\)\), "\[IndentingNewLine]", \(S\_\(3, 1\)\^2 = S\_3\^2 + S\_1\^2 - 2\ \(S\_3\) \(S\_1\) cos \((\[CurlyPhi]\_\(3, 1\))\)\)}], "Text", TextAlignment->Center, FontFamily->"Times New Roman"], Cell[BoxData[ RowBox[{ "This", " ", "is", " ", "a", " ", "system", " ", "of", " ", "polynomial", " ", "equations", " ", "for", " ", "the", " ", "variables", " ", FormBox[\(\(\ \)\(S\_1\)\), "TraditionalForm"], FormBox[\(S\_2\), "TraditionalForm"], "\[EAcute]s", FormBox[\(S\_3\), "TraditionalForm"], " ", "representing", " ", \(\(distances\)\(.\)\)}]], "Text", FontFamily->"Times New Roman"], Cell["Let us intruduce the folllowing variables", "Text"], Cell[BoxData[ RowBox[{" ", RowBox[{ RowBox[{\(cos \((\[CurlyPhi]\_\(i, , j\))\)\), " ", "=", FormBox[\(f\_\(i, j\)\), "TraditionalForm"]}], ",", RowBox[{ RowBox[{ FormBox[\(\(\ \ \)\(S\_i = x\_i\)\), "TraditionalForm"], " ", "and", " ", FormBox[\(S\_\(i, j\)\), "TraditionalForm"]}], " ", "=", FormBox[\(\@\(\(d\)\(\ \)\)\_\(i, j\)\), "TraditionalForm"]}]}]}]], "Text", TextAlignment->Center, FontFamily->"Times New Roman"], Cell["then our system can be written in the following form,", "Text"], Cell[BoxData[{ \(\(p1 = \ x1\^2 - \ 2\ f12\ x1\ x2\ \ + x2\^2 - d12 \[Equal] 0;\)\), "\[IndentingNewLine]", \(\(p2 = \ x2\^2 - \ 2\ f23\ x2\ x3\ + x3\^2 - d23 \[Equal] 0;\)\), "\[IndentingNewLine]", \(\(p3 = \ x3\^2 - \ 2\ f31\ x1\ x3\ + x1\^2 - d31 \[Equal] 0;\)\)}], "Input", CellLabel->"In[1]:="] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["3. Solution of the 3-points problem", FontWeight->"Bold"]], "Section", FontWeight->"Plain"], Cell[CellGroupData[{ Cell["3.1 Direct numerical solution", "Subsection", CellDingbat->None], Cell["\<\ The first approach is to solve the system on the field of high, but finite \ precision numbers. Let us suppose that the observation data are, see \ Grafarend and Shan [10],\ \>", "Text"], Cell[BoxData[ \(\(rawdata = {d12 -> 15603302. \^2\ 10\^\(-8\), d23 -> \(7558681. \^2\) 10\^\(-8\), d31 -> 17181090. \^2\ 10\^\(-8\), f12 -> Cos[1.843620], f23 -> Cos[1.768989], f31 -> Cos[2.664537]};\)\)], "Input", CellLabel->"In[4]:="], Cell["\<\ Here, we use high precision numbers to decrease round-off error,\ \>", "Text"], Cell[BoxData[ \(\(data = SetPrecision[rawdata, 20];\)\)], "Input", CellLabel->"In[6]:="], Cell[TextData[{ "The most simple, direct solution is the numerical one. Employing the \ built-in function of ", StyleBox["Mathematica", FontSlant->"Italic"], ", ", StyleBox["NSolve", FontFamily->"Courier New", FontWeight->"Bold"], ", we get" }], "Text"], Cell[BoxData[ \(solN = NSolve[Map[\((# /. data)\) \[Equal] 0 &, {p1, p2, p3}], {x1, x2, x3}, 20] // Timing\)], "Input", CellLabel->"In[7]:="], Cell["\<\ In order to select positive, real roots is reasonable to define a logical \ function,\ \>", "Text"], Cell[BoxData[ \(PositiveReal[x_List] := Apply[And, Map[\((Im[#[\([2]\)]] \[Equal] 0 \[And] Re[#[\([2]\)]] > 0)\) &, x]]\)], "Input", CellLabel->"In[8]:="], Cell["then the admissable solution is", "Text"], Cell[BoxData[ \(solx1x2x3 = \(Select[solN[\([2]\)], PositiveReal[#] &] // Flatten\) // SetPrecision[#, 20] &\)], "Input", CellLabel->"In[9]:="], Cell["\<\ To check this solution let us substitute it back into the equations,\ \>", "Text"], Cell[BoxData[ \(\(Map[#[\([1]\)] &, {p1, p2, p3}] /. data\) /. solx1x2x3 // SetPrecision[#, 20] &\)], "Input", CellLabel->"In[10]:="] }, Open ]], Cell[CellGroupData[{ Cell["3.2 Groebner bases solution", "Subsection", CellDingbat->None], Cell[TextData[{ "Fully explicit symbolic solution using ", StyleBox["Solve ", FontFamily->"Courier New", FontWeight->"Bold"], "needs a lot of memory and computation time, and the result would be too \ complicated to handle it properly. The function ", StyleBox["Reduce", FontFamily->"Courier New", FontWeight->"Bold"], " can be also considered as a candidated to solve this problem, however \ this function also needs a lot of memory and a long running time." }], "Text"], Cell[TextData[{ "Employing other techniques like Sturmfels' method, Dixon resultant or \ reduced Groebner bases, which trying to find fully symbolic solution in \ explicit form for each variables are also unsuitables because of their high \ demand of computation resources.\nThat is why, we choose lexicographic \ Groebner bases, which is probably, the most effective elimination technique \ in order to find symbolic solution. The lexicographic Groebner basis utilizes \ the Gauss elimination technique for multivariate polynomial systems proposed \ by Buchberger [11]. This method is implemented in ", StyleBox["Mathematica", FontSlant->"Italic"], " and Maple, too. However, there are more effective algorithms, already \ built in some other CAS, like Magma, Singular, Slimgb, FGb for Maple and \ others. \nNow let us employ here the built function ", StyleBox["GroebnerBasis ", FontFamily->"Courier New", FontWeight->"Bold"], StyleBox["to compute the lexicograhic basis for our system. The key idea is \ to reduce the system of the polynomial equations to a higher order polynomial \ with only one variable by transforming the system into a triangular form.", FontVariations->{"CompatibilityType"->0}] }], "Text"], Cell[BoxData[ \(\(Gb = GroebnerBasis[{p1, p2, p3}, {x1, x2, x3}, ParameterVariables \[Rule] {d12, d23, d31, f12, f23, f31}];\)\)], "Input", CellLabel->"In[11]:="], Cell["\<\ The result is a many pages long expression, therefore we show here only a \ part of it\ \>", "Text"], Cell[BoxData[ \(Short[Gb, 10]\)], "Input", CellLabel->"In[12]:="], Cell["The number of the polynomials of this basis,", "Text"], Cell[BoxData[ \(Length[Gb]\)], "Input", CellLabel->"In[13]:="], Cell[TextData[{ "The highest powers of the variables ", Cell[BoxData[ \(TraditionalForm\`x\_1\)]], ", ", Cell[BoxData[ \(TraditionalForm\`x\_2\)]], " \[EAcute]s ", Cell[BoxData[ \(TraditionalForm\`x\_3\)]], " in the polynomials," }], "Text"], Cell[BoxData[ \(Table[Exponent[Gb[\([i]\)], {x1, x2, x3}], {i, 1, 31}]\)], "Input", CellLabel->"In[14]:="], Cell[TextData[{ "It can be seen, that the first polynomial contains only the variable ", Cell[BoxData[ \(TraditionalForm\`x\_3\)]], ", {0, 0, 8} and its highest power is eight. The coefficient of this \ polynomial can be computed in the the following way," }], "Text"], Cell[BoxData[ \(A8 = Coefficient[Gb[\([1]\)], x3\^8]\)], "Input", CellLabel->"In[15]:="], Cell[BoxData[ \(A7 = Coefficient[Gb[\([1]\)], x3\^7]\)], "Input", CellLabel->"In[16]:="], Cell[BoxData[ \(A6 = Coefficient[Gb[\([1]\)], x3\^6]\)], "Input", CellLabel->"In[17]:="], Cell[BoxData[ \(A5 = Coefficient[Gb[\([1]\)], x3\^5]\)], "Input", CellLabel->"In[18]:="], Cell[BoxData[ \(A4 = Coefficient[Gb[\([1]\)], x3\^4]\)], "Input", CellLabel->"In[19]:="], Cell[BoxData[ \(A3 = Coefficient[Gb[\([1]\)], x3\^3]\)], "Input", CellLabel->"In[20]:="], Cell[BoxData[ \(A2 = Coefficient[Gb[\([1]\)], x3\^2]\)], "Input", CellLabel->"In[21]:="], Cell[BoxData[ \(A1 = Coefficient[Gb[\([1]\)], x3]\)], "Input", CellLabel->"In[22]:="], Cell["The constant coefficient is ", "Text"], Cell[BoxData[ \(A0 = Gb[\([1]\)] - \((A8\ x3\^8 + A6\ x3\^6 + A4\ x3\^4 + A2\ x3\^2)\) // Simplify\)], "Input", CellLabel->"In[23]:="], Cell[TextData[{ "So we have got a polynomial equation with a single variable, ", Cell[BoxData[ \(TraditionalForm\`x\_3\)]], ". The numerical values of the coefficients are " }], "Text"], Cell[BoxData[ \(A = Map[# /. data &, {A8, A6, A4, A2, A0}]\)], "Input", CellLabel->"In[24]:="], Cell[TextData[{ "Let us introduce a new variable, namely let u = ", Cell[BoxData[ \(TraditionalForm\`x3\^2\)]], " in order to reduce this equation to a quartic polynomial, " }], "Text"], Cell[BoxData[ \(equ = A . {\ u\^4, \ u\^3, u\^2, \ u, 1} // SetPrecision[#, 20] &\)], "Input",\ CellLabel->"In[25]:="], Cell["Then the solutions are", "Text"], Cell[BoxData[ \(NSolve[equ \[Equal] 0, u, 20]\)], "Input", CellLabel->"In[26]:="], Cell[TextData[{ "The positive, real solutions for the variable ", StyleBox["u", FontSlant->"Italic"], "," }], "Text"], Cell[BoxData[ \(rootu = Select[u /. %, \((Im[#] \[Equal] 0 \[And] # > 0)\) &]\)], "Input", CellLabel->"In[27]:="], Cell["\<\ So we have two solutions. The positive roots give the solutions for x3, \ \>", "Text"], Cell[BoxData[ \(rootx3 = Sqrt[rootu]\)], "Input", CellLabel->"In[28]:="], Cell["\<\ Let us try the first solution and substitute it into the 14-th polynomial of \ the Groebner basis, {0, 1, 4}.\ \>", "Text"], Cell[BoxData[ \(eqx2 = \((Gb[\([14]\)] /. data)\) /. {x3 \[Rule] rootx3[\([1]\)]}\)], "Input", CellLabel->"In[29]:="], Cell[TextData[{ "This equation can be solved for ", Cell[BoxData[ \(TraditionalForm\`x\_2\)]], ", " }], "Text"], Cell[BoxData[ \(NSolve[eqx2 \[Equal] 0, x2]\)], "Input", CellLabel->"In[30]:="], Cell["\<\ which is negative, therefore it is not admissable solution. Let us try the \ second root,\ \>", "Text"], Cell[BoxData[ \(eqx2 = \((Gb[\([14]\)] /. data)\) /. {x3 \[Rule] rootx3[\([2]\)]}\)], "Input", CellLabel->"In[31]:="], Cell[BoxData[ \(NSolve[eqx2 \[Equal] 0, x2]\)], "Input", CellLabel->"In[32]:="], Cell["which is already positive,", "Text"], Cell[BoxData[ \(rootx2 = x2 /. %[\([1]\)]\)], "Input", CellLabel->"In[33]:="], Cell[TextData[{ "To get the solution of ", Cell[BoxData[ \(TraditionalForm\`x\_1\)]], ", we can use the 21-st polynomial of the basis, {1, 1, 3}. Then the \ correspondig equation is," }], "Text"], Cell[BoxData[ \(eqx1 = \((Gb[\([21]\)] /. data)\) /. {x3 \[Rule] rootx3[\([2]\)], x2 -> rootx2}\)], "Input", CellLabel->"In[34]:="], Cell["which has the solution", "Text"], Cell[BoxData[ \(NSolve[eqx1 \[Equal] 0, x1]\)], "Input", CellLabel->"In[35]:="], Cell["therefore", "Text"], Cell[BoxData[ \(rootx1 = x1 /. %[\([1]\)]\)], "Input", CellLabel->"In[36]:="], Cell["\<\ So the solution of the 3-points resection problem via Groebner basis is\ \>", "Text"], Cell[BoxData[ \(SetPrecision[{rootx1, rootx2, rootx3[\([2]\)]}, 20]\)], "Input", CellLabel->"In[37]:="], Cell["\<\ This is the same solution what we have got via direct numerical method,\ \>", "Text"], Cell[BoxData[ \(solx1x2x3\)], "Input", CellLabel->"In[38]:="], Cell["\<\ This solution satisfies all of the polynomials of the Groebner basis, too\ \>", "Text"], Cell[BoxData[ \(Table[\(Gb[\([i]\)] /. data\) /. {x3 \[Rule] rootx3[\([2]\)], x2 -> rootx2, x1 \[Rule] rootx1}, {i, 1, 31}] // SetPrecision[#, 20] &\)], "Input", CellLabel->"In[39]:="] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["4. Mathematica Package for 3-points resection", "Section"], Cell[TextData[{ "The steps of the computation can be implemented as a ", StyleBox["Mathematica", FontSlant->"Italic"], " package, see Appendix. Let us load the package," }], "Text"], Cell[BoxData[ \(<< GeoAlgebra`Resection3D`\)], "Input", CellLabel->"In[40]:="], Cell["\<\ A short description of the package is given concerning the description of \ the input and output structures, \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(?Resection3D\)\)], "Input", CellLabel->"In[41]:="], Cell[BoxData[ \(" Resection3D[{s,cos\[CurlyPhi]}] function solves the Grunert distance \ equations. The first input, the list s = {s12,s23,s31} contains the known \ distances, the list con\[CurlyPhi] = \ {cos(\[CurlyPhi]12),cos(\[CurlyPhi]23),cos(\[CurlyPhi]31)}, contains the \ cosinus of the angular observations. The output list provides the distances \ of the known stations from the point having unknown position."\)], "Print", GeneratedCell->False, CellAutoOverwrite->False, CellTags->"Info3350393112-1213565"] }, Open ]], Cell["Let us test this function with our data. The distances are,", "Text"], Cell[BoxData[ \(S = Map[\@#[\([2]\)] &, Drop[data, \(-3\)]]\)], "Input", CellLabel->"In[43]:="], Cell["and the cosinus of the angular observations,", "Text"], Cell[BoxData[ \(cos\[CurlyPhi] = Map[#[\([2]\)] &, Drop[data, 3]]\)], "Input", CellLabel->"In[44]:="], Cell["then", "Text"], Cell[BoxData[ \(\(Resection3D[{S, cos\[CurlyPhi]}] // Flatten\) // Timing\)], "Input", CellLabel->"In[47]:="], Cell["\<\ In this case the running time is less at least with a magnitude, than that of \ the direct numerical solution.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["5. N - points problem", "Section"], Cell["\<\ In this case, we have more than three stations, therefore the system of the \ polynomial equations is overdetermined. Fig. 2. shows the topology of such a \ system in case of N = 7, see Grafarend and Shan [10],\ \>", "Text"], Cell[GraphicsData["Metafile", "\<\ CF5dJ6E]HGAYHf4PEfU^I6mgLb15CDHPAVmbKF5d0@0002:P0@0008`0000`0000>`000@0000900003`0006`0000000009Q80058J00350000 7@40000000000000000004T00`0jFP@0EP1905<0B@1?0000A01b0640M`1Y06h0I`000000000U0000 300000P0080U0000300000D0081B0000L0400040002Loooo0000000000000000T04000000>h00000 @@1b06T0H@1/00000000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000=0000000000000000000000000000000000000000000000000000 0000000000000000003V0@0000000000J00001T0000003d07?LB0000001/nA806>j@O?06TGcooooo j`JAOoT0Oooooo80000=:;V0@Nf=60dX^H100000200001DX^H1 8:;V0MBe=63Lkn@18:;V0@00001TMP08000002D0000<00000@0002D0000<00003P00P2P0000<0000 0@0000X0000@00000000000000090000400001D:001F2@009P0001`000010000000000H000000000 000002D0000<00000@000180000<00000@000180000<00000P0002L0000H00000P000000003o0000 000002D0000<00000P0005H0001`0000h0@00=<5000d1@009PH001D0000`1Od5;PGa1BP5iPDP1Mh5 5PGI1@X5e`Gn1=T5m0CN1N`4iPGV1?45i0Cm1NH420K/11<6m0@K1_h480H:1B865PDP1R056`HX1A<6 ;PD81S05o@DU0000300000P0080X000030000040000U0000300000D0080X000030000080000I0000 30000?ooo`0V000070000080000000001P000000000000009@0000`0000200004P0000`000010000 4P0000`0000200009`0001P000010000000003=Vo`0000009@0000`000010000EP000700002W0@00 /P000?X100050@005@000?H1g03e0M00k`760>L1_P3M0KP0d@6f0l1lP3e0NL0mP7L02D0000<00002000P2P0000<0000 0P0002D0000<00001@00P2P0000<00000@0001T0000<0000oooo02H0000L00000@00000000060000 00000000000U000030000040000B000030000040000B000030000080000W00006000008000000000 1aX2@PLE0SP7 308`1`82:POf0BT7j`4Z1n01<0OH0CP7d`521m41CPOC0EX7f05T1n01K0O[0G87mP5d1`82LPL<0V`7 5@9T1aX2FPLL0Th79@0000`000080020:00000`0000100009@0000`000050020:00000`000020000 6@0000`0003oool09P0001`000020000000000H000000000000002D0000<00000P000180000<0000 0@000180000<00000P0002L0000H00000@000000000cI_l0000002D0000<00000@0005H0001`0000 O@H007/3003@1P00cP<001D0003<1Z@3bPJI0lD6SP>m1XH3/PJ10jL6O`>K1X43T0J60hP6SP>31YT3 P@JT0h<6/0>81[/3T0K30i/6b0>W1/X3/PK80kd6``?51[/3bPJ`0l`6Y01[<7c0Jo1lh6bPOC1]D7g0KM1nH6hPOb1^@7 o@KR1`P7g@L@1mD75@O:1aL7_`LU0000300000P0080X000030000040000U0000300000D0080X0000 30000080000I000030000?ooo`0V000070000080000000001P000000000000009@0000`000020000 4P0000`0000100004P0000`0000200009`0001P000010000000003=Vo`0000009@0000`000010000 EP000700002k1000D@P000h5002T20005@0000X5NPP81Fl80`ET2?/4G0S`15H8i0AE2=T4EPS>15`8 aPAT2<44K`Ro17X8`@B6219P8f@BN2>@4X0S`19h8n`BH20<5T0P81HH82PEj22D0000<0000 2000P2P0000<00000P0002D0000<00001@00P2P0000<00000@0001T0000<0000oooo02H0000L0000 0@0000000006000000000000000U000030000040000B000030000040001G000090000=d1003j0000 l`@00>H500020000h@7n0>l4hPDU0000300000P0080X000030000040000U0000300000D0080V0000 70000040000000001P000000000000009@0000`0000100004P0000`000010000E`0002@0000H0P00 k@D00>X4001F1`000P0001`2DPOV1?459@0000`000080020:00000`0000100009@0000`000050020 9P0001`000010000000000H000000000000002D0000<00000@000180000<00000@0005L0000T0000 i0@001T6003l1000F@P00080003h11d6j0AE22D0000<00002000P2P0000<00000@0002D0000<0000 1@00P2H0000L00000@0000000006000000000000000U000030000040000B000030000040001G0000 900001L5000J1P00=0H003@8000200006`DN1S06<0PU0000300000P0080X000030000040000U0000 300000D0080V000070000040000000001P000000000000009@0000`0000100004P0000`000010000 E`0002@0000Q1@00gPD00=X6002Y1`000P0002D5hPGF1ZD79@0000`000080020:00000`000010000 9@0000`0000500209P0001`000010000000000H000000000000002D0000<00000@000180000<0000 0@0005L0000T00006`D00:P5001P1P00h@D00080000O1Md5G0J/1BD0000<00002000P2P0000<0000 0@0002D0000<00001@00P2H0000L00000@0000000006000000000000000U000030000040000B0000 30000040001G0000900000H5002m0`00TPH00=/5000200002PGG1Hh6`@h0S@0P@@1b06T0H@1/000000000000000000000000000000000000 00000000000000000000000000000000000000000>h0000P@@1b06T0H@1/00000000000000000000 00000000000000000000000000000000000000000008QND1mNg3M`00002Ll180mNg3M`R5i@5LkQ80 mNg3Mao^`gL8QND1Oa`B0000003dkQ806>j@O?06TGcooooo j`JAO00P06d0:@0`00009@0002D0000Y0000>@0002D0000U0000 9@000280000C00005P0001<0000F00009@0002D0000U00009@0001<0000U00009@0002D0000C0000 >@0001H0000B000030000040000U0000300000d0080U0000300000P0080F0000300001P0001B0000 L0400080002moooo0000000000000000T04000000>h0S@0P@@1b06T0H@1/00000000000000000000 000000000000000000000000000000000000000000000000000000000>h0000P@@1b06T0H@1/0000 000000000000000000000000000000000000000000000000000000000008QND1mNg3M`00002Ll180 mNg3M`R5i@5LkQ80mNg3Mao^`gL8QND1Oa`B0000003dkQ80 6>j@O?06TGcoooooj`JAO@D00>l2000B2000 >@<000400036[hM02eZ7@3T5000[0`005`0004`00000000000000000003oooooooooog`0001C06<0 J01/06l0g`1`06`0H@1d07X0800X03D0=P0f02h0>00f03@0801]02T0M00]00008P0002D0000?0000 9@0002T0000U00003`0002D0000C00008@0001<0000F00009@0002D0000U00004`0002D0000U0000 9@0001<0000i00005P000180000<00000@0002D0000<00003@00P2D0000<00002000P1H0000<0000 60000580001`0@000`000;goool0000000000000002@0@000000kP0002110780J@1Q06`000000000 0000000000000000000000000000000000000000000000000000000000000000000B0545TG`H1cd0 K@FAO6BD/@08c>@10000000000000000000000000000000000000000000000000000000000000000 0000012]i0400000000001P000000000000m09cb4P000000600001S^T7c`1Y5looooon/6TG`00<5g 000m0000003>`l5g1lC1M`00?@3oooooI?DB0>^S8f3@m180[HGU0@Sf0@030000D?@B0?oooom4mA80 002@O705TGcoooooK@FAO=k2`GL003d000000>?2`GMTU;402j@O?06TGcoooooj`JAO000`GL003d00000000d0200K@0Y0300000U00008P0002D0000C00009@0002d0000g0000 4`0001H0000U00009@0002D0000C00009@0002D0000U00004`0003T0000F00004P0000`000010000 9@0000`0000=00209@0000`0000800205P0000`0000H0000DP00070100050000_Oooo`0000000000 000009010000003^00008440LP1Y0640K00000000000000000000000000000000000000000000000 00000000000000000000000000000180D@FAO1P7?@1]1I5lI9Ba012]i04000000000000000000000 000000000000000000000000000000000000000000000000H:7T0@000000000060000000000003d0 W?8B0000000H00006>j@O?06TGcoooooj`JAO000`GL003d000000409@0000l0000U00009@0002D0000F00009@0002D0000?0000 3`0002D0000C00005P0002D0000U00009@0001<0000U00009@0002D0000C0000>@0001H0000B0000 30000040000U0000300000d0080U0000300000P0080F0000300001P0001B0000L04000H0002moooo 0000000000000000T04000000>h0000P@@1b06T0H@1/000000000000000000000000000000000000 00000000000000000000000000000000000000004P1A1I5l60Lm06d5TGaTU;402@0h0300801]02T0<`0U00003`0002D0000U00009@0002D0000i0000 9@000280000U00009@0003T0000F00009@0002D0000U00004`0002D0000U00009@0001<0000i0000 5P000180000<00000@0002D0000<00003@00P2D0000<00002000P1H0000<000060000580001`0@00 1`000;goool0000000000000002@0@000000kP0002110780J@1Q06`0000000000000000000000000 000000000000000000000000000000000000000000000000000B0545TG`H1cd0K@FAO6BD/@1PXN@1 0000000000000000000000000000000000000000000000000000000000000000000000S`l5g 1lC1M`00?@3oooooI?DB0>^S8f3@m180[HGU0@Sf0@030000D?@B0?oooom4mA80002@O705TGcooooo K@FAO=k2`GL003d000000>?2`GMTU;40H:7T0@00001/mA80000001TB8f0<00008?DB06Af00P00000 9@0000`000070000600000`0000000004P0000`000010000E0000>@0000d0@00SPL00404003H1`00 0@000j@O?06TGcooooo j`JAO000`GL003d000000"], "Graphics", ImageSize->{373.688, 345.813}, ImageMargins->{{0, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}], Cell[TextData[{ StyleBox["Fig.2", FontSlant->"Italic"], " The topology of the N-points resection problem" }], "Text", TextAlignment->Center], Cell["\<\ The measured global GPS coordinates of the known stations are given in Table \ 1. \ \>", "Text"], Cell[TextData[{ StyleBox["Table 1", FontSlant->"Italic"], ". GPS - coordinates of the known stations in global system, Grafarend and \ Shan [10]," }], "Text", TextAlignment->Center], Cell[BoxData[GridBox[{ {"Stations", \(X \((m)\)\), \(Y \((m)\)\), \(Z \((m)\)\)}, {\(K1\ \((reference\ point)\)\), ".", ".", "."}, {"1", "4157246.5346", "671877.0281", "4774581.6314"}, {"2", "4156749.5977", "672711.4554", "4774981.5459"}, {"3", "4156748.6829", "671171.9385", "4775235.5483"}, {"4", "4157066.8851", "671064.9381", "4774865.8238"}, {"5", "4157266.6181", "671099.1577", "4774689.8536"}, {"6", "4157307.5147", "671171.7006", "4774690.5691"}, {"7", "4157244.9515", "671338.5915", "4774699.9070"} }, GridFrame->True, ColumnLines->True]], "Text", TextAlignment->Center, FontFamily->"Times New Roman"], Cell["The list of these coordinate values are", "Text"], Cell[BoxData[ \(\(XYZI = {{4157246.5346, 671877.0281, 4774581.6314}, \[IndentingNewLine]{4156749.5977, 672711.4554, 4774981.5459}, \[IndentingNewLine]{4156748.6829, 671171.9385, 4775235.5483}, \[IndentingNewLine]{4157066.8851, 671064.9381, 4774865.8238}, \[IndentingNewLine]{4157266.6181, 671099.1577, 4774689.8536}, \[IndentingNewLine]{4157307.5147, 671171.7006, 4774690.5691}, \[IndentingNewLine]{4157244.9515, 671338.5915, 4774699.9070}\[IndentingNewLine]};\)\)], "Input", CellLabel->"In[49]:="], Cell["So the distances between the stations can be computed, ", "Text"], Cell[BoxData[ \(\(Sij = Table[Norm[XYZI[\([i]\)] - XYZI[\([j]\)]], {i, 1, 7}, {j, 1, 7}];\)\)], "Input", CellLabel->"In[50]:="], Cell["\<\ The cosinus of the angular observations are also given as input,\ \>", "Text"], Cell[BoxData[ \(\(cos\[CurlyPhi]ij = {{1. , 0.6472921, \(-0.9063975\), \(-0.7684706\), \(-0.2263849\), \ \(-0.0688486\), 0.2945752}, {0.6472921, 1. , \(-0.2694492\), \(-0.9706436\), \(-0.8883271\), \(-0.8037237\ \), \(-0.5376386\)}, {\(-0.9063975\), \(-0.2694492\), 1. , 0.4493329, \(-0.1968823\), \(-0.3562715\), \(-0.6659245\)}, \ {\(-0.7684706\), \(-0.9706436\), 0.4493329, 1. , 0.7844799, 0.66229971, 0.36418151}, {\(-0.2263849\), \(-0.8883271\), \(-0.1968823\), 0.7844799, 1. , 0.9824936, 0.8624879}, {\(-0.0688486\), \(-0.8037237\), \(-0.3562715\), 0.66229971, 0.9824936, 1. , 0.9323184}, {0.2945752, \(-0.5376386\), \(-0.6659245\), 0.3641815, 0.86248799, 0.9323184, 1. }};\)\)], "Input", CellLabel->"In[51]:="], Cell["\<\ In order to get the solution of the overdeterminated system we shall use the \ Gauss - Jacobi combinatorical method. Now we have three unkonwn and seven \ equations,\ \>", "Text"], Cell[BoxData[ \(n = 3; m = 7;\)], "Input", CellLabel->"In[52]:="], Cell["\<\ The number of the possible combinations of the equations, the number of \ triplets are\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Binomial[m, n]\)], "Input", CellLabel->"In[53]:="], Cell[BoxData[ \(35\)], "Output", CellLabel->"Out[53]="] }, Open ]], Cell["or more explicitely", "Text"], Cell[BoxData[ \(qs = Partition[Map[# &, Flatten[Subsets[Range[m], {n}]]], 3]\)], "Input",\ CellLabel->"In[54]:="], Cell["\<\ The list of distances and the cosinus values belonging to a triplet labeled \ by indeces (i, j, k) , can be generated by the following functions,\ \>", "Text"], Cell[BoxData[ \(Sn[i_, j_, k_] := {Sij[\([i, j]\)], Sij[\([j, k]\)], Sij[\([k, i]\)]}\)], "Input", CellLabel->"In[55]:="], Cell[BoxData[ \(cos\[CurlyPhi]n[i_, j_, k_] := {\ cos\[CurlyPhi]ij[\([i, j]\)], \ cos\[CurlyPhi]ij[\([j, k]\)], \ cos\[CurlyPhi]ij[\([k, i]\)]}\)], "Input", CellLabel->"In[57]:="], Cell["Therefore the input list for all triplets, ", "Text"], Cell[BoxData[ \(\(Sncos\[CurlyPhi]n = Table[{Sn[qs[\([r, 1]\)], qs[\([r, 2]\)], qs[\([r, 3]\)]], cos\[CurlyPhi]n[qs[\([r, 1]\)], qs[\([r, 2]\)], qs[\([r, 3]\)]]}, {r, 1, 35}];\)\)], "Input", CellLabel->"In[58]:="], Cell[TextData[{ "Now, we can utilize the package", StyleBox[" Resection3D", FontFamily->"Courier New", FontWeight->"Bold"], " developed via symbolic computation. The result for the 35 triplets, " }], "Text"], Cell[BoxData[ \(solxT = Map[Flatten[#] &, Map[Resection3D[#] &, Sncos\[CurlyPhi]n]] // Timing\)], "Input", CellLabel->"In[66]:="], Cell["\<\ The time of the solution of the 35 triplets is just the double of the running \ time of one direct numerical solution. Now, we should extract the solutions \ belonging to the same station. This means, that the 35 \[Times] 3 = 105 \ solutions, should be partitioned into seven lists corresponding to the seven \ different stations and containing 15 solutions each, 7 \[Times] 15 = 105. Let \ \ \>", "Text"], Cell[BoxData[ \(\(solx = solxT[\([2]\)];\)\)], "Input", CellLabel->"In[68]:="], Cell["then the solutions for the distance of each station are", "Text"], Cell[BoxData[ \(sol = Table[Select[\(Table[ If[\ MemberQ[qs[\([i]\)], j], \[IndentingNewLine]If[ Length[solx[\([i]\)]] \[Equal] 6, \[IndentingNewLine]s = Partition[solx[\([i]\)], 3]; {\(s[\([1]\)]\)[\([First[ Flatten[ Position[qs[\([i]\)], j]]]]\)], \(s[\([2]\)]\)[\([First[ Flatten[ Position[qs[\([i]\)], j]]]]\)]}, \ \[IndentingNewLine]\(solx[\([i]\)]\)[\([First[ Flatten[Position[qs[\([i]\)], j]]]]\)]\ ]], {j, 1, 7}, {i, 1, 35}]\)[\([r]\)], \[Not] # === Null &], {r, 1, 7}]\)], "Input", CellLabel->"In[69]:="], Cell["\<\ It can be realized that in some cases, we have got parasitic solutions. For \ example, the solutions for the distance of the first station are\ \>", "Text"], Cell[BoxData[ \(sol[\([1]\)]\)], "Input", CellLabel->"In[71]:="], Cell["\<\ where the last four solutions are accompanied by a wrong, parasitic solution. \ Although, these wrong solutions can be eliminated by inspection, in order to \ keep the computation automatic, the most simple way of the elimination of \ these wrong solutions is to remove them together with their correct \ counterparts. This is easy, but one has to belive, that there will remain \ solution at all.\ \>", "Text"], Cell["\<\ It means, that all of the lists of elements in the solution list, which are \ longer than one, will be dropped, or in an other way, only those elements \ will be selected as a solution, which has no mate.\ \>", "Text"], Cell[BoxData[ \(solred = Map[Select[#, Length[Flatten[{#}]] \[Equal] 1 &] &, sol]\)], "Input", CellLabel->"In[72]:="], Cell["\<\ Then using these purified solutions, the average distance of each station can \ be computed,\ \>", "Text"], Cell[BoxData[ \(SetPrecision[Table[Mean[solred[\([i]\)]], {i, 1, 7}], 10]\)], "Input", CellLabel->"In[73]:="], Cell["\<\ Certifying this result, one may use direct numerical least square \ minimization to get, \ \>", "Text"], Cell[BoxData[ \({566.8650000000000090949`8. , 1324.2393999999999323336`7.999999999999999, 542.2605999999999539796`8. , 364.9791000000000167347`8. , 430.5355000000000131877`7.999999999999999, 400.5856999999999743522`7.999999999999999, 269.2264999999999872671`8. }\)], "Output"], Cell["The numbers on Fig.2 show the official distances.", "Text"], Cell["\<\ The result of the Gauss - Jacobi method can be somewhat improved by \ weighting the solutions belonging to a certain station instead of just \ computing their average.\ \>", "Text"], Cell["\<\ Having the distances of the known stations from the point of K1, ranging can \ be employed to find the coordinates of position of K1, see Pal\[AAcute]ncz \ [12]. In addition, to determine the orientation of K1, one can use the \ Procrustes algorithm. \ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["6.Conclusions", "Section"], Cell[TextData[{ "A computer algebra solution has been developed for N-points resection \ problem using Groebner bases facility of ", StyleBox["Mathematica.", FontSlant->"Italic"], " The solution of the Grunert equations, a system of polynomial equations, \ can be reduced to the solution of a monomial equation, a ", "quartic polynomial", ". In this way the computation time of the N-points resection problem can \ be reduced at least with one magnitude in comparison of the direct numerical \ solution. The ", StyleBox["Mathematica", FontSlant->"Italic"], " package for solving 3-points can be utilized in case of the N-points \ resection problem, too. " }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["7. Acknowledgements", "Section"], Cell["\<\ This work has been supported by the Hungarian National Research Fund, Grants \ No. (OTKA T-037880 and T029830), and partly conducted during the Special \ Semester on Groebner Bases, February 1 July 31, 2006, organized by RICAM, \ Austrian Academy of Sciences, and RISC, Johannes Kepler University, Linz, \ Austria.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["8. References", "Section"], Cell[TextData[{ "\n[1] Haneberg, W.C.:", StyleBox["Computational Geosciences with Mathematics", FontVariations->{"CompatibilityType"->0}], ", Springer , Berlin, (2004)\n\n[2] Awange J.L. and Grafarend E.W.: Solving \ Algebraic Computational Problems in Geodesy and Geoinformatics, Springer, \ Berlin, (2005)\n\n[3] Freeman, J.A.: Simulating neural networks with ", StyleBox["Mathematica", FontSlant->"Italic"], ", Addison-Wesley, (1994)\n\n[4] Bart M. ter Haar Romeny: Front-End Vision \ and Multi-Scale Image Analysis, Kluwer, Dordrecht, (2003)\n\n[5] Helton, J.W \ and Merino O.: Classical Control using ", Cell[BoxData[ \(TraditionalForm\`H\^\[Infinity]\)]], " Methods, SIAM, (1998)\n\n[6] Bellomo, N., Preziosi, L. and Romano, A.: \ Mechanics and Dynamical Systems with ", StyleBox["Mathematica", FontSlant->"Italic"], ", Birkh\[ADoubleDot]user, (2000)\n\n[7] Grunert J.A.: Das Pothenotsche \ Problem in erweiterte Gestalt; nebst Bemerkungen \[UDoubleDot]ber seine \ Anwendungen in der Geod\[ADoubleDot]sie. Grunerts Archiv f\[UDoubleDot]r \ Mathematik und Physik 1, (1841), pp. 238-241.\n\n[8] Awange J.L. and \ Grafarend E.W.: Groebner basis solution of the three-dimensional resection \ problem. Journal of Geodesy 76, (2003), pp. 605-616.\n\n[9] Awange J.L.: \ Groebner bases, multipolynomial resultants and the Gauss-Jacobi combinatorial \ algrithms-adjustment of nonlinear GPS/LPS observation. Ph.D. thesis, \ Department of Geodesy and Geoinformatics, Stuttgart University, Germany. \ (2002).\n\n[10] Grafarend EW. and Shan J.: ", StyleBox["Closed - form solution of the nonlinear pseudoranging equations \ (GPS),", FontVariations->{"CompatibilityType"->0}], " Artificial Satellites, Planetary Geodesy 31, (1996), pp.133 - 147.\n\n\ [11] Buchber B. Gr\[ODoubleDot]bner bases: An Algorithmic method in \ Polynomial Ideal theory, Multidimensional Systems Theory, N.K. Bose, ed., \ D.Reidel Publ.Co. (1985)\n\n[12] Pal\[AAcute]ncz, B.: GPS N-points problem, \ ", StyleBox["Mathematica", FontSlant->"Italic"], " in Education and Research, Vol.11 No.2, (2006), pp.153-171." }], "Reference"] }, Open ]], Cell[CellGroupData[{ Cell["9. Appendix", "Section"], Cell[TextData[{ "The ", StyleBox["Mathematica", FontSlant->"Italic"], " package for the 3-points resection problem." }], "Text"], Cell[BoxData[{ \(\(\(BeginPackage["GeoAlgebra`Resection3D`"];\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(Resection3D::usage = \[IndentingNewLine]" Resection3D[{s,cos\ \[CurlyPhi]}] function solves the Grunert distance equations. The first \ input, the list s = {s12,s23,s31} contains the known distances, the list con\ \[CurlyPhi] = {cos(\[CurlyPhi]12),cos(\[CurlyPhi]23),cos(\[CurlyPhi]31)}, \ contains the cosinus of the angular observations. The output list provides \ the distances of the known stations from the point having unknown position.";\ \)\ \[IndentingNewLine]\), "\[IndentingNewLine]", \(\(\(Begin["`Private`"]\ ;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(\(Resection3D[{s_List, cosf_List}] := Module[{d12, d23, d13, f12, f23, f13, A0, \ A2, A4, A6, A8, equ, solu, rootu, rootx3, Gbx2, eqx2, solx2, \ Gbx1, \ eqx1, \ solx1, rootx2, rootx1, rootx123}, \[IndentingNewLine]\[IndentingNewLine]{d12, d23, d31} = SetPrecision[Map[#\^2 &, s], 20]; \[IndentingNewLine]{f12, f23, f31} = SetPrecision[cosf, 20]; \[IndentingNewLine]\[IndentingNewLine]A8 = 16 - 32\ f12\^2 + 16\ f12\^4 - 32\ f23\^2 + 32\ f12\^2\ f23\^2 + 16\ f23\^4 + 64\ f12\ f23\ f31 - 64\ f12\^3\ f23\ f31 - 64\ f12\ f23\^3\ f31 - 32\ f31\^2 + 32\ f12\^2\ f31\^2 + 32\ f23\^2\ f31\^2 + 64\ f12\^2\ f23\^2\ f31\^2 - 64\ f12\ f23\ f31\^3 + 16\ f31\^4; \[IndentingNewLine]\[IndentingNewLine]A6 = 32\ d12 - 32\ d23 - 32\ d31 - 32\ d12\ f12\^2 + 64\ d23\ f12\^2 + 64\ d31\ f12\^2 - 32\ d23\ f12\^4 - 32\ d31\ f12\^4 - 64\ d12\ f23\^2 + 32\ d23\ f23\^2 + 64\ d31\ f23\^2 + 32\ d12\ f12\^2\ f23\^2 - 32\ d23\ f12\^2\ f23\^2 - 64\ d31\ f12\^2\ f23\^2 + 32\ d12\ f23\^4 - 32\ d31\ f23\^4 + 32\ d12\ f12\ f23\ f31 - 96\ d23\ f12\ f23\ f31 - 96\ d31\ f12\ f23\ f31 + 32\ d12\ f12\^3\ f23\ f31 + 96\ d23\ f12\^3\ f23\ f31 + 96\ d31\ f12\^3\ f23\ f31 - 32\ d12\ f12\ f23\^3\ f31 + 32\ d23\ f12\ f23\^3\ f31 + 96\ d31\ f12\ f23\^3\ f31 - 64\ d12\ f31\^2 + 64\ d23\ f31\^2 + 32\ d31\ f31\^2 + 32\ d12\ f12\^2\ f31\^2 - 64\ d23\ f12\^2\ f31\^2 - 32\ d31\ f12\^2\ f31\^2 + 128\ d12\ f23\^2\ f31\^2 - 32\ d23\ f23\^2\ f31\^2 - 32\ d31\ f23\^2\ f31\^2 - 128\ d12\ f12\^2\ f23\^2\ f31\^2 - 64\ d23\ f12\^2\ f23\^2\ f31\^2 - 64\ d31\ f12\^2\ f23\^2\ f31\^2 - 64\ d12\ f23\^4\ f31\^2 - 32\ d12\ f12\ f23\ f31\^3 + 96\ d23\ f12\ f23\ f31\^3 + 32\ d31\ f12\ f23\ f31\^3 + 128\ d12\ f12\ f23\^3\ f31\^3 + 32\ d12\ f31\^4 - 32\ d23\ f31\^4 - 64\ d12\ f23\^2\ f31\^4; \ \[IndentingNewLine]\[IndentingNewLine]A4 = 24\ d12\^2 - 48\ d12\ d23 + 24\ d23\^2 - 48\ d12\ d31 + 48\ d23\ d31 + 24\ d31\^2 - 8\ d12\^2\ f12\^2 + 48\ d12\ d23\ f12\^2 - 40\ d23\^2\ f12\^2 + 48\ d12\ d31\ f12\^2 - 112\ d23\ d31\ f12\^2 - 40\ d31\^2\ f12\^2 + 16\ d23\^2\ f12\^4 + 64\ d23\ d31\ f12\^4 + 16\ d31\^2\ f12\^4 - 40\ d12\^2\ f23\^2 + 48\ d12\ d23\ f23\^2 - 8\ d23\^2\ f23\^2 + 80\ d12\ d31\ f23\^2 - 48\ d23\ d31\ f23\^2 - 40\ d31\^2\ f23\^2 + 16\ d12\^2\ f12\^2\ f23\^2 + 16\ d23\^2\ f12\^2\ f23\^2 - 64\ d12\ d31\ f12\^2\ f23\^2 + 32\ d23\ d31\ f12\^2\ f23\^2 + 48\ d31\^2\ f12\^2\ f23\^2 + 16\ d12\^2\ f23\^4 - 32\ d12\ d31\ f23\^4 + 16\ d31\^2\ f23\^4 + 16\ d12\^2\ f12\ f23\ f31 - 32\ d12\ d23\ f12\ f23\ f31 + 16\ d23\^2\ f12\ f23\ f31 - 32\ d12\ d31\ f12\ f23\ f31 + 160\ d23\ d31\ f12\ f23\ f31 + 16\ d31\^2\ f12\ f23\ f31 - 32\ d12\ d23\ f12\^3\ f23\ f31 - 32\ d23\^2\ f12\^3\ f23\ f31 - 32\ d12\ d31\ f12\^3\ f23\ f31 - 128\ d23\ d31\ f12\^3\ f23\ f31 - 32\ d31\^2\ f12\^3\ f23\ f31 - 32\ d12\^2\ f12\ f23\^3\ f31 - 32\ d12\ d23\ f12\ f23\^3\ f31 + 64\ d12\ d31\ f12\ f23\^3\ f31 - 32\ d23\ d31\ f12\ f23\^3\ f31 - 32\ d31\^2\ f12\ f23\^3\ f31 - 40\ d12\^2\ f31\^2 + 80\ d12\ d23\ f31\^2 - 40\ d23\^2\ f31\^2 + 48\ d12\ d31\ f31\^2 - 48\ d23\ d31\ f31\^2 - 8\ d31\^2\ f31\^2 + 16\ d12\^2\ f12\^2\ f31\^2 - 64\ d12\ d23\ f12\^2\ f31\^2 + 48\ d23\^2\ f12\^2\ f31\^2 + 32\ d23\ d31\ f12\^2\ f31\^2 + 16\ d31\^2\ f12\^2\ f31\^2 + 48\ d12\^2\ f23\^2\ f31\^2 - 64\ d12\ d23\ f23\^2\ f31\^2 + 16\ d23\^2\ f23\^2\ f31\^2 - 64\ d12\ d31\ f23\^2\ f31\^2 + 16\ d31\^2\ f23\^2\ f31\^2 + 64\ d12\ d23\ f12\^2\ f23\^2\ f31\^2 + 64\ d12\ d31\ f12\^2\ f23\^2\ f31\^2 + 64\ d23\ d31\ f12\^2\ f23\^2\ f31\^2 - 32\ d12\^2\ f12\ f23\ f31\^3 + 64\ d12\ d23\ f12\ f23\ f31\^3 - 32\ d23\^2\ f12\ f23\ f31\^3 - 32\ d12\ d31\ f12\ f23\ f31\^3 - 32\ d23\ d31\ f12\ f23\ f31\^3 + 16\ d12\^2\ f31\^4 - 32\ d12\ d23\ f31\^4 + 16\ d23\^2\ f31\^4; \[IndentingNewLine]\[IndentingNewLine]A2 = 8\ d12\^3 - 24\ d12\^2\ d23 + 24\ d12\ d23\^2 - 8\ d23\^3 - 24\ d12\^2\ d31 + 48\ d12\ d23\ d31 - 24\ d23\^2\ d31 + 24\ d12\ d31\^2 - 24\ d23\ d31\^2 - 8\ d31\^3 + 8\ d12\^2\ d23\ f12\^2 - 16\ d12\ d23\^2\ f12\^2 + 8\ d23\^3\ f12\^2 + 8\ d12\^2\ d31\ f12\^2 - 64\ d12\ d23\ d31\ f12\^2 + 56\ d23\^2\ d31\ f12\^2 - 16\ d12\ d31\^2\ f12\^2 + 56\ d23\ d31\^2\ f12\^2 + 8\ d31\^3\ f12\^2 - 32\ d23\^2\ d31\ f12\^4 - 32\ d23\ d31\^2\ f12\^4 - 8\ d12\^3\ f23\^2 + 16\ d12\^2\ d23\ f23\^2 - 8\ d12\ d23\^2\ f23\^2 + 24\ d12\^2\ d31\ f23\^2 - 32\ d12\ d23\ d31\ f23\^2 + 8\ d23\^2\ d31\ f23\^2 - 24\ d12\ d31\^2\ f23\^2 + 16\ d23\ d31\^2\ f23\^2 + 8\ d31\^3\ f23\^2 - 16\ d12\^2\ d31\ f12\^2\ f23\^2 - 16\ d23\^2\ d31\ f12\^2\ f23\^2 + 32\ d12\ d31\^2\ f12\^2\ f23\^2 - 16\ d31\^3\ f12\^2\ f23\^2 + 8\ d12\^3\ f12\ f23\ f31 - 8\ d12\^2\ d23\ f12\ f23\ f31 - 8\ d12\ d23\^2\ f12\ f23\ f31 + 8\ d23\^3\ f12\ f23\ f31 - 8\ d12\^2\ d31\ f12\ f23\ f31 + 48\ d12\ d23\ d31\ f12\ f23\ f31 - 40\ d23\^2\ d31\ f12\ f23\ f31 - 8\ d12\ d31\^2\ f12\ f23\ f31 - 40\ d23\ d31\^2\ f12\ f23\ f31 + 8\ d31\^3\ f12\ f23\ f31 + 32\ d12\ d23\ d31\ f12\^3\ f23\ f31 + 32\ d23\^2\ d31\ f12\^3\ f23\ f31 + 32\ d23\ d31\^2\ f12\^3\ f23\ f31 - 8\ d12\^3\ f31\^2 + 24\ d12\^2\ d23\ f31\^2 - 24\ d12\ d23\^2\ f31\^2 + 8\ d23\^3\ f31\^2 + 16\ d12\^2\ d31\ f31\^2 - 32\ d12\ d23\ d31\ f31\^2 + 16\ d23\^2\ d31\ f31\^2 - 8\ d12\ d31\^2\ f31\^2 + 8\ d23\ d31\^2\ f31\^2 - 16\ d12\^2\ d23\ f12\^2\ f31\^2 + 32\ d12\ d23\^2\ f12\^2\ f31\^2 - 16\ d23\^3\ f12\^2\ f31\^2 - 16\ d23\ d31\^2\ f12\^2\ f31\^2; \[IndentingNewLine]\ \[IndentingNewLine]A0 = \((d12\^2 + d23\^2 + 2\ d23\ d31 + d31\^2 - 2\ d12\ \ \((d23 + d31)\) - 4\ d23\ d31\ f12\^2)\)\^2; \[IndentingNewLine]\ \[IndentingNewLine]equ = {A8, A6, A4, A2, A0} . {u\^4, u\^3, u\^2, u, 1}; \[IndentingNewLine]\[IndentingNewLine]solu = NSolve[equ \[Equal] 0, u]; \[IndentingNewLine]\[IndentingNewLine]rootu = Select[u /. solu, \((Im[#] \[Equal] 0 \[And] # > 0)\) &]; \[IndentingNewLine]\[IndentingNewLine]rootx3 = Sqrt[rootu]; \[IndentingNewLine]\[IndentingNewLine]Gbx2 = d12\^2 - 2\ d12\ d23 + d23\^2 - 2\ d12\ d31 + 2\ d23\ d31 + d31\^2 - 4\ d23\ d31\ f12\^2 - 4\ d12\ f23\ x2\ x3 + 4\ d23\ f23\ x2\ x3 + 4\ d31\ f23\ x2\ x3 - 8\ d31\ f12\^2\ f23\ x2\ x3 + 4\ d12\ f12\ f31\ x2\ x3 - 4\ d23\ f12\ f31\ x2\ x3 + 4\ d31\ f12\ f31\ x2\ x3 + 4\ d12\ x3\^2 - 4\ d23\ x3\^2 - 4\ d31\ x3\^2 + 4\ d23\ f12\^2\ x3\^2 + 4\ d31\ f12\^2\ x3\^2 + 4\ d23\ f23\^2\ x3\^2 - 8\ d23\ f12\ f23\ f31\ x3\^2 - 4\ d12\ f31\^2\ x3\^2 + 4\ d23\ f31\^2\ x3\^2 - 8\ f23\ x2\ x3\^3 + 8\ f12\^2\ f23\ x2\ x3\^3 + 8\ f23\^3\ x2\ x3\^3 - 16\ f12\ f23\^2\ f31\ x2\ x3\^3 + 8\ f23\ f31\^2\ x2\ x3\^3 + 4\ x3\^4 - 4\ f12\^2\ x3\^4 - 4\ f23\^2\ x3\^4 + 8\ f12\ f23\ f31\ x3\^4 - 4\ f31\^2\ x3\^4; \[IndentingNewLine]\[IndentingNewLine]\ \[IndentingNewLine]eqx2 = Map[Gbx2 /. {x3 \[Rule] #} &, rootx3]; \ \[IndentingNewLine]\[IndentingNewLine]solx2 = Map[NSolve[# \[Equal] 0, x2] &, eqx2]; \[IndentingNewLine]\[IndentingNewLine]rootx2 = Map[x2 /. #[\([1]\)] &, solx2]; \[IndentingNewLine]\[IndentingNewLine]Gbx1 = d12\ f12\^2\ x1 + d23\ f12\^2\ x1 - d31\ f12\^2\ x1 - 2\ d12\ f12\ f23\ f31\ x1 + 2\ d31\ f12\ f23\ f31\ x1 + d12\ f31\^2\ x1 - d23\ f31\^2\ x1 - d31\ f31\^2\ x1 + d12\ f12\ x2 - d23\ f12\ x2 - d31\ f12\ x2 + 2\ d31\ f12\^3\ x2 - d12\ f23\ f31\ x2 + d23\ f23\ f31\ x2 + d31\ f23\ f31\ x2 - 4\ d31\ f12\^2\ f23\ f31\ x2 + 2\ d31\ f12\ f31\^2\ x2 - d12\ f12\ f23\ x3 - d23\ f12\ f23\ x3 + d31\ f12\ f23\ x3 + d12\ f31\ x3 - d23\ f31\ x3 - d31\ f31\ x3 - 2\ d12\ f12\^2\ f31\ x3 + 2\ d23\ f12\^2\ f31\ x3 + 2\ d23\ f23\^2\ f31\ x3 + 4\ d12\ f12\ f23\ f31\^2\ x3 - 4\ d23\ f12\ f23\ f31\^2\ x3 - 2\ d12\ f31\^3\ x3 + 2\ d23\ f31\^3\ x3 + 2\ f12\ x2\ x3\^2 - 2\ f12\^3\ x2\ x3\^2 - 2\ f12\ f23\^2\ x2\ x3\^2 - 4\ f23\ f31\ x2\ x3\^2 + 8\ f12\^2\ f23\ f31\ x2\ x3\^2 + 4\ f23\^3\ f31\ x2\ x3\^2 - 2\ f12\ f31\^2\ x2\ x3\^2 - 8\ f12\ f23\^2\ f31\^2\ x2\ x3\^2 + 4\ f23\ f31\^3\ x2\ x3\^2 + 2\ f31\ x3\^3 - 2\ f12\^2\ f31\ x3\^3 - 2\ f23\^2\ f31\ x3\^3 + 4\ f12\ f23\ f31\^2\ x3\^3 - 2\ f31\^3\ x3\^3; \[IndentingNewLine]\[IndentingNewLine]eqx1 = MapThread[ Gbx1 /. {x3 \[Rule] #1, x2 \[Rule] #2} &, {rootx3, rootx2}]; \[IndentingNewLine]\[IndentingNewLine]solx1 = Map[NSolve[# \[Equal] 0, x1] &, eqx1]; \[IndentingNewLine]\[IndentingNewLine]rootx1 = Map[x1 /. #[\([1]\)] &, solx1]; \[IndentingNewLine]\[IndentingNewLine]rootx123 = Transpose[{rootx1, rootx2, rootx3}]; \[IndentingNewLine]\[IndentingNewLine]Select[ rootx123, \((#[\([1]\)] > 0)\) \[And] \((#[\([2]\)] > 0)\) \[And] \((#[\([3]\)] > 0)\) &]];\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(\(End[]\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(EndPackage[]\), "\[IndentingNewLine]", \(Null\)}], "Program"] }, Open ]] }, Open ]] }, FrontEndVersion->"5.2 for X", ScreenRectangle->{{0, 1920}, {0, 1200}}, WindowSize->{627, 647}, WindowMargins->{{79, Automatic}, {Automatic, 25}}, ShowSelection->True, Magnification->1, StyleDefinitions -> "IMS2006styles.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{ "Info3350393112-1213565"->{ Cell[46134, 973, 527, 9, 70, "Print", CellTags->"Info3350393112-1213565"]} } *) (*CellTagsIndex CellTagsIndex->{ {"Info3350393112-1213565", 84354, 1723} } *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1776, 53, 104, 4, 172, "Title"], Cell[1883, 59, 69, 1, 22, "Author"], Cell[1955, 62, 240, 6, 79, "TextAboutAuthor"], Cell[2198, 70, 1096, 28, 241, "Abstract"], Cell[CellGroupData[{ Cell[3319, 102, 57, 1, 62, "Section"], Cell[3379, 105, 2690, 44, 530, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[6106, 154, 48, 0, 62, "Section"], Cell[6157, 156, 1013, 36, 70, "Text"], Cell[7173, 194, 26437, 329, 70, 26337, 326, "GraphicsData", "Metafile", \ "Graphics"], Cell[33613, 525, 151, 5, 70, "Text"], Cell[33767, 532, 67, 0, 70, "Text"], Cell[33837, 534, 497, 13, 70, "Text"], Cell[34337, 549, 460, 11, 70, "Text"], Cell[34800, 562, 57, 0, 70, "Text"], Cell[34860, 564, 567, 15, 70, "Text"], Cell[35430, 581, 70, 0, 70, "Text"], Cell[35503, 583, 367, 9, 70, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[35907, 597, 119, 2, 70, "Section"], Cell[CellGroupData[{ Cell[36051, 603, 73, 1, 70, "Subsection"], Cell[36127, 606, 196, 4, 70, "Text"], Cell[36326, 612, 275, 5, 70, "Input"], Cell[36604, 619, 88, 2, 70, "Text"], Cell[36695, 623, 94, 2, 70, "Input"], Cell[36792, 627, 275, 10, 70, "Text"], Cell[37070, 639, 165, 4, 70, "Input"], Cell[37238, 645, 110, 3, 70, "Text"], Cell[37351, 650, 187, 5, 70, "Input"], Cell[37541, 657, 47, 0, 70, "Text"], Cell[37591, 659, 158, 3, 70, "Input"], Cell[37752, 664, 92, 2, 70, "Text"], Cell[37847, 668, 146, 3, 70, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[38030, 676, 71, 1, 70, "Subsection"], Cell[38104, 679, 497, 12, 70, "Text"], Cell[38604, 693, 1246, 21, 70, "Text"], Cell[39853, 716, 203, 5, 70, "Input"], Cell[40059, 723, 110, 3, 70, "Text"], Cell[40172, 728, 71, 2, 70, "Input"], Cell[40246, 732, 60, 0, 70, "Text"], Cell[40309, 734, 68, 2, 70, "Input"], Cell[40380, 738, 274, 11, 70, "Text"], Cell[40657, 751, 112, 2, 70, "Input"], Cell[40772, 755, 280, 6, 70, "Text"], Cell[41055, 763, 94, 2, 70, "Input"], Cell[41152, 767, 94, 2, 70, "Input"], Cell[41249, 771, 94, 2, 70, "Input"], Cell[41346, 775, 94, 2, 70, "Input"], Cell[41443, 779, 94, 2, 70, "Input"], Cell[41540, 783, 94, 2, 70, "Input"], Cell[41637, 787, 94, 2, 70, "Input"], Cell[41734, 791, 91, 2, 70, "Input"], Cell[41828, 795, 44, 0, 70, "Text"], Cell[41875, 797, 156, 4, 70, "Input"], Cell[42034, 803, 197, 5, 70, "Text"], Cell[42234, 810, 100, 2, 70, "Input"], Cell[42337, 814, 198, 5, 70, "Text"], Cell[42538, 821, 132, 4, 70, "Input"], Cell[42673, 827, 38, 0, 70, "Text"], Cell[42714, 829, 87, 2, 70, "Input"], Cell[42804, 833, 127, 5, 70, "Text"], Cell[42934, 840, 126, 3, 70, "Input"], Cell[43063, 845, 97, 2, 70, "Text"], Cell[43163, 849, 78, 2, 70, "Input"], Cell[43244, 853, 133, 3, 70, "Text"], Cell[43380, 858, 136, 3, 70, "Input"], Cell[43519, 863, 124, 5, 70, "Text"], Cell[43646, 870, 85, 2, 70, "Input"], Cell[43734, 874, 113, 3, 70, "Text"], Cell[43850, 879, 136, 3, 70, "Input"], Cell[43989, 884, 85, 2, 70, "Input"], Cell[44077, 888, 42, 0, 70, "Text"], Cell[44122, 890, 83, 2, 70, "Input"], Cell[44208, 894, 207, 6, 70, "Text"], Cell[44418, 902, 148, 3, 70, "Input"], Cell[44569, 907, 38, 0, 70, "Text"], Cell[44610, 909, 85, 2, 70, "Input"], Cell[44698, 913, 25, 0, 70, "Text"], Cell[44726, 915, 83, 2, 70, "Input"], Cell[44812, 919, 96, 2, 70, "Text"], Cell[44911, 923, 109, 2, 70, "Input"], Cell[45023, 927, 95, 2, 70, "Text"], Cell[45121, 931, 67, 2, 70, "Input"], Cell[45191, 935, 97, 2, 70, "Text"], Cell[45291, 939, 210, 4, 70, "Input"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[45550, 949, 64, 0, 70, "Section"], Cell[45617, 951, 191, 5, 70, "Text"], Cell[45811, 958, 84, 2, 70, "Input"], Cell[45898, 962, 134, 3, 70, "Text"], Cell[CellGroupData[{ Cell[46057, 969, 74, 2, 70, "Input"], Cell[46134, 973, 527, 9, 70, "Print", CellTags->"Info3350393112-1213565"] }, Open ]], Cell[46676, 985, 75, 0, 70, "Text"], Cell[46754, 987, 101, 2, 70, "Input"], Cell[46858, 991, 60, 0, 70, "Text"], Cell[46921, 993, 107, 2, 70, "Input"], Cell[47031, 997, 20, 0, 70, "Text"], Cell[47054, 999, 115, 2, 70, "Input"], Cell[47172, 1003, 134, 3, 70, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[47343, 1011, 40, 0, 70, "Section"], Cell[47386, 1013, 237, 4, 70, "Text"], Cell[47626, 1019, 12165, 153, 70, 12065, 150, "GraphicsData", "Metafile", \ "Graphics"], Cell[59794, 1174, 150, 5, 70, "Text"], Cell[59947, 1181, 106, 3, 70, "Text"], Cell[60056, 1186, 191, 6, 70, "Text"], Cell[60250, 1194, 706, 14, 70, "Text"], Cell[60959, 1210, 56, 0, 70, "Text"], Cell[61018, 1212, 595, 9, 70, "Input"], Cell[61616, 1223, 71, 0, 70, "Text"], Cell[61690, 1225, 155, 4, 70, "Input"], Cell[61848, 1231, 88, 2, 70, "Text"], Cell[61939, 1235, 840, 14, 70, "Input"], Cell[62782, 1251, 190, 4, 70, "Text"], Cell[62975, 1257, 71, 2, 70, "Input"], Cell[63049, 1261, 110, 3, 70, "Text"], Cell[CellGroupData[{ Cell[63184, 1268, 72, 2, 70, "Input"], Cell[63259, 1272, 61, 2, 70, "Output"] }, Open ]], Cell[63335, 1277, 35, 0, 70, "Text"], Cell[63373, 1279, 120, 3, 70, "Input"], Cell[63496, 1284, 169, 3, 70, "Text"], Cell[63668, 1289, 136, 3, 70, "Input"], Cell[63807, 1294, 203, 4, 70, "Input"], Cell[64013, 1300, 59, 0, 70, "Text"], Cell[64075, 1302, 256, 5, 70, "Input"], Cell[64334, 1309, 222, 6, 70, "Text"], Cell[64559, 1317, 151, 4, 70, "Input"], Cell[64713, 1323, 415, 7, 70, "Text"], Cell[65131, 1332, 84, 2, 70, "Input"], Cell[65218, 1336, 71, 0, 70, "Text"], Cell[65292, 1338, 824, 17, 70, "Input"], Cell[66119, 1357, 166, 3, 70, "Text"], Cell[66288, 1362, 70, 2, 70, "Input"], Cell[66361, 1366, 423, 7, 70, "Text"], Cell[66787, 1375, 230, 4, 70, "Text"], Cell[67020, 1381, 130, 3, 70, "Input"], Cell[67153, 1386, 116, 3, 70, "Text"], Cell[67272, 1391, 115, 2, 70, "Input"], Cell[67390, 1395, 113, 3, 70, "Text"], Cell[67506, 1400, 315, 6, 70, "Output"], Cell[67824, 1408, 65, 0, 70, "Text"], Cell[67892, 1410, 192, 4, 70, "Text"], Cell[68087, 1416, 277, 5, 70, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[68401, 1426, 32, 0, 70, "Section"], Cell[68436, 1428, 693, 15, 70, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[69166, 1448, 38, 0, 70, "Section"], Cell[69207, 1450, 338, 6, 70, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[69582, 1461, 32, 0, 70, "Section"], Cell[69617, 1463, 2151, 39, 70, "Reference"] }, Open ]], Cell[CellGroupData[{ Cell[71805, 1507, 30, 0, 70, "Section"], Cell[71838, 1509, 138, 5, 70, "Text"], Cell[71979, 1516, 11675, 185, 70, "Program"] }, Open ]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)