(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 5.0' 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[ 169600, 5081]*) (*NotebookOutlinePosition[ 219496, 6488]*) (* CellTagsIndexPosition[ 219452, 6484]*) (*WindowFrame->Normal*) Notebook[{ Cell[GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg05eMG@2l_;`0jn_[0>c/k031`L407QhN0000000L71`0QXJ60<[:bP3[jn/0gmoO0:^[ Z`1ADE420000000;06UYJ@3GemL0e=CD055AD@0000009BDU030080oooo00<0Hf=S0000002n_[h00`3oool01@0K6a/0O7al 0?ooo`3oool0WinO00<0000000<0QHF50?ooo`3oool00`3oool01P1IFET0F5QH0?ooo`3oool0/K6a 075aL@80oooo00<0h^;R01XJ6P1mOGd01@3oool01`1iNGT0>3Ph0?ooo`3oool0X:2P00000024Q8@0 0`3oool00`1SHf<01@D50;fm_@040?ooo`030=cLg00G5aL0m?Cd00@0oooo00<0nMOM0=L7;P3E02@0 1@3F02L01@3E0240f0/`0=L4:`3F02H0eP0W0080e`@Z00@0e`D/0=H1:03F02L0eP0W0P3G12X30=H0 9`090=D08@3H2c00e`@[0=H09P3F02L0e`L]0=D08P3G0bX0eP3P0oOgm0?ooo`3oool0alO7 09BDU037alL0=3@d09bLW0020?ooo`030>KViP2FUYH0^[Zj0080oooo00<0oOgm024Q8@1gMgL00P3o ool00`1EEED0H61P0?ooo`020?ooo`030?Shn00J6QX0N7Qh0080oooo00D0Z:RX01`L700L71`00000 07moO`020?ooo`050<30`01KFe/0GemO01XJ6P1NGUh00P3oool01`3Jf]X0k>c/0?ooo`3_knl0@d=3 00000021PH400P3oool01@30`<00Fe]K065QH@0V9RH0@T920080oooo00<0T92@034a<@3kno/00`3o ool04@1FEUH0GemO0?ooo`3oool0o_kn0;6a/@2HV9P0_Kfm01hN7P3/k>`0oooo0?[jnP1iNGT0FEUI 071?E@3A0R40eP0V00@0eP0W00`0e@0O0>=CK@3d^L@0fado0=D08`3D01d0iF1g0>ELM@3/QYP0fQTl 0=D08`3D01d20>IQN@0I0=@07@3F02L0e@0O0>=CK@3d^L@0fado0=D08`3D01d0jG>80>f>X03aZKL0 fADi0=D08`3E0200gRi>0?Fob@3YN8d0eP8T0=H09P3E0200gBm?0?G0bP3^UJH0ePDW0=H09@090=H0 9`0F0=H09@3G0bX0kYFU0=XH>`3E02<0eP0W0=D08@3M;dl0jWjB0=D08P3F02H0eP0W0=@07@3TFG80 iEae0=@07P3F02L0e00O0>AJL`3c]l80i5Yc0=@07`@0eP0W00<0/@0P000000000000oP0000000`0? 3`l000000000003J00000000200000003`2>SXh0oooo0?ooo`34a<@02`/;0000000<30`08R8R0>CT i03oool0o?cl04aCT0?oo o`3bl_80oooo0?Shn00J6QX0N7Qh0P3oool01@3inOT0k^k^0>7Qh@000000Ng]k0080oooo00D0k^k^ 0=;BdP35aLD00000061PH0050?ooo`040=?Cd`0d=3@000000820P080oooo00D0k^k^0=;BdP34a<@0 000004E5A@020?ooo`080:6QX@32`/80oooo0>c/k03kno/0oooo06EUI@2h^;P20?ooo`0<09:BTP00 0000000001XJ6P0F5QH0kno_0?ooo`3no_h0f][J0=;BdP24AE40`00E103F02L03@3F02@0e`d`0?G4 c@3O=eH0e@4T0=H09`3D01/0ifb20?6Y]P3d_LL0fQPk0=D08`3D01`00P3YL8H06@3D01`0eP0T0=L= <03eaAJL`3ieM`0lkG10=L4:@3F02D0e00L0>b8VP3_UjL0mKo90=TC =`3E02<0e00L0>fAXP3XLHL0l:Bb0>51G`3D01l02@3F02L05P3F02D0e`^1 U@3D01l40=H09`030;408000000000000?h0000000<03`l?000000000000fP00000000P0000000@0 Vi^K0?ooo`3oool0YJFU0`0000001@0@4100l?3`0?ooo`3jn_X03Ph02[Zj/0moOg0?oo o`3Zj^X04aS0?gm o@3oool0JFUY0IWO`3e`l`0m/SA0=TE>@3E02<0 e00L0080j6j301T0e00L0=D08`3I4cL0ml[B0=P=YmT@3D01`0 eP0V0=@07P3^UJH0jWfA0>MXOP3G22d0e@0U0=@07P3_VZX0he=]0>jFYP3SCf/0e00N00T0eP0W01H0 eP0U0=L1:03aY[@0fQ/n0=D08`3F02@0f0/`0?:/^@3b[k/0i5E_0=@07P3E0240gS1@0?>g`@3d^lD0 fQLl0=D08`3D01/0iEYd0?_Xk03UFg@0e00K103F02L00`2a020000000000003n0000000300l?3`00 000000000=X0000000080000000905IFEP3oool0oooo0?KfmP1eMGD0ATI608Z:RP0g=cL0^KVi0080 oooo00@0bl_;05YJFP2:RXX0n?Sh0P3oool00`0i>CT0M7Ad0?ooo`020?ooo`070?;blP0l?3`0a/K6 0?ooo`3hn?P06QXJ07QhN0020?ooo`050;Ng]`14A4@0ADE500X:2P1mOGd00P3oool01@2d];@0>c/k 03/k>`000000HV9R0080oooo00<0/[:b01hN7P3Shn<00P3oool01@0e=CD0M7Ad0?ooo`3oool0];Bd 0080>c/k00<00P8204I6AP3oool00`3oool01P1OGel0SHf=0?ooo`3oool0FEUI0861P@80oooo00d0 g]kN05YJFP1;Bd/0TY:B01lO7`3/k>`0oooo0?[jnP1OGel0>SXj04/]<`3=01/0eP0V00<0eP0W00d0 eP0V0=D18@3ZNi00lk>n0=TF>@3E02<0e00L0>M]P`3WJX40kiVX0=XL?`3E02<0e00L0080j6n401T0 e00L0=H09P3E0B40jW^@0?>c_P3I5ST0e@0S0=H0903G12X0n=3G0>AJM03D01`0eP0W0=@07@3RBfL0 mlWA0>YhS@3F0RD0eP0V0=@07P3QAV<0mlWB0?:_^`3H3S00e@0T00T0eP0W01H0e@0S0=XH?03fbM80 fQPk0=D08`3F02D0eP@W0>j@X@3c]l80gRi>0=D08@3E02<0fQTk0?:^^`3aYK<0e``^0=D0903D01`0 i5Uc0?O@f03TFG<0e00L103F02L00`2a020000000000003n0000000300l?3`00000000000=X00000 00080000000300H61P2k^k/0oooo00@0oooo00<08bSX04U9 B@1bLW800P3oool01@3^k^h0d];B0=CDe00_;bl0FUYJ0080oooo00L0mOGe0>KViP3oool0oooo0>7Q h@0=3@d0NWYj0080oooo00D0kno_0=;BdP3De=@0c/k03oool0o_kn0=_Kf`3AdM40f;Fl0=L5 ;03E02@40=H09`040=H09@3F02L0gS9A0=P:<080eP0U00H0fADh0=XF>@3K7T00e`D[0=H09P3F02D2 0=XE>@070=H09@3F02L0eP0U0=H09`3N0=XH?03E02<:0=H09`0:0=H09@3H3340gS1@ 0=L3:P3F02H0eP0W0=D08`3I53P0gBU:0=D08`80eP0W00X0e@0T0=`RA03J6ch0e@0T0=H09`3F02H0 e`@[0=dZB`3G12/0eP0V103F02L00`2a020000000000003n0000000300l?3`00000000000=X00000 00090000000;01`0UiNG00T92@000000NGUi0?gmo@3lo?`0`L7100d=3@030`<0f][J0?gmo@3emOD0410@07al O03oool0oOgm00<0oooo00@0BTY:06UYJ@3moOd0oOgm0`3oool0100b[ZjP02 0?gmo@80oooo00L0n=?J0=P1:03D01l0eP0Q0=L08`3G0280e@0R0080e`0R00`0e00I0=D0803G0280 e@0R0=D07P3F01h0e`0J0=P07`3G0280e@0R0=D07P3G01h20=D08P0?0=P08@3G0240eP0J0=D0803E 0280e`0R0=L08`3E01/0e@0O0=P08P3H0240e@0R0=D08@3D01X0e@0N0080e`0R00T0e@0R0=D08@3F 01P0e`0L0=D08P3H0240f00P0=L08P3E02800P3F02820=D08P80f00P00T0f00Q0=D0803D01T0e`0Q 0=H08P3E0280f00R0=H07`3F01X00P3E0280103H0240e`0S0=H06P3G01/30=D08P060=H0803D01X0 e@0P0=P08@3H0200f00Q0P3E02800`2b01`000000000003n0000000300l?3`00000000000=X00000 000;0000000<04E5A@2c/k<0_[jn071`L0061PH08R8R05IFEP1]KFd0K6a/05UIF@1=CDd09BDU0P00 00004`0n?Sh0SHf=0;jn_P2DU9@0>3Ph000000010@40>c/k09ZJVP2OWil0H61P01`L701`L700XZ:R 0:2PX02FUYH0N7Qh07IfMP1lO7`00P2PX:006`2NWYh0HF5Q09FEU@1_Kfl0MWIf0::RXP2CTi<0L71` 0451@@0_;bl03@d=000000051@D0MWIf0::RXP2?Shl0?clo04a1HL02X:401G>d00MeIK07=CF01PADT0Le=H07IIGP1F:340=@D<04dP:01eFEh0 M5QM04DL900e1@h0KdiD07MGG@1F=cd0DRP_07IHG@0307EDFP0/06I9CP1OA4P0MUEK079>E00f31<0 BB0W07ELH@1C9Bd0<`/B06]9C`1fEE/0L51F07EDF@1fEE/0Kd]B02l<4P0Z2@h0DBD]07IIGP1fEEX0 F3m306i?E01gEU/0HDA903D53P1;7RH0MEUN07IIGP1F:340=@D=02h83`1D5B00PeUQ08iVK@1_CeD0 KTmD07IEFP1dEe`0?A`R02X93@0o7B<0MEQM07IEFP1G?T;o00000040000000<03`l?000000000000 fP00000000/0000000H0N7Qh0?gmo@3moOd0]kNg0000002c/`00000000000000 000ag]k@3moOd0lo?c018B4P38b3P00<0oooo00@0o_kn0>_[j`2VYZH0 6QXJ0P0000002P18B4P0o_kn0?gmo@3YjNT000000492@P3lo?`0oooo0>o_k`0820P2000000030;no _`3oool0oooo0080C4a<103oool01P3moOd0fMWI07EeM@00000030`<0>k^kP80oOgm0P3oool08P39 bl/0KWEc0:ji]`2V];401PD505ADE02__;X0HV9R0000002LZ:H0[kZh0828Q`29TY00[kZh0:>]Z`17 BDP0S@2_^[P0Yk6`05QNG@2W/K00[kZh06E/JP000000:b/[0:jj^02_^kT0>SXj0000002? VYP0[kZh06ieL`0m@3l20:nj^080/;^i0180VZBR05eSHP2_^[P0[;Ne01LH600m@3l0[kZh07MnO@00 0000Qi2>0:nj^02=UY@0OXF40:nj^02Z]K<0AdY9030bSX0WJJU0:nj^02`^kT0Z[Fc08F=R`80[kZh00<0HFMV 02`^;P1NHf800P2_^[P00`1UK6/000000000003n0000000300l?3`00000000000=X00000000:0000 000700D51@3Fe]H0oooo0?ooo`3/k>`051@D0;Ng]`020?ooo`050?KfmP0X:2P0000000h>3P3De=@0 0`3oool02P3bl_80oooo0?ooo`3oool0FUYJ00@4103`l?00oooo0>SXj02:RXX20?ooo`030CT0?ooo`3no_h0lO7a00<0oooo00@0bSX0N7Qh0?ooo`020?ooo`0405mOG`00000000000;Rh^080oooo0P1EEED2 0?ooo`030?Win@3dm?@0oooo0080oooo01@0KFe]00820P3`l?00oooo0?knoP3SP2b/[80MgMg03dm?@H0/[:b0240Xj>S02DU 9@2XZ:P0/[:b08>3P`00000051@D0:b/[02b/[80FU]K0000001bLW80/[:b09>CT`0_;bl0[jn_0;:b /P2VYZH0QhN707emO@0j>SX0[Jf]0;:b/P1=CDd0FEUI0;:b/P2_[jl0:b/[07UiN@2b/[80S8b<034a <@2`/;001@2b/[80302][Jd092@T08J6QP2b/[80Z:RX00P92@0A4Q80[:b/0;:b/P1oOgl04aT Y080/[:b00@0[Zj^0:n_[`1VIVH0U9BD1P2b/[800`19BDT000000000003n0000000300l?3`000000 00000=X00000000:0000000703dm?@3no_h0oooo0?ooo`3moOd0E5AD0=cLg0030?ooo`0308Z:RP00 0000KVi^0080oooo00@0i>CT04Y:BP0_;bl0ZJVY0P3oool01@3:b/X04ac/k03oool0oOgm0080 oooo00@0l?3`0410@0000000PH610P3oool02P2e]KD0@41003lo?`0Q8B40kNg]0?ooo`3inOT0BTY: 05UIF@3_knl20?ooo`0303hn?P071`L0i>CT00<0oooo00<0Ng]k0:6QX@3oool00P3oool01035aLD0 0@410000002h^;P20?ooo`80EEEE0P3oool00`31`L40c/ 0?ooo`3kno/0P82006QXJ00_;bl020P80:2PX02b/[80Jf][08B4Q0020;:b/P0@06UYJ@23Ph<0/[:b 07inOP0410@0T92@0;:b/P2][Jd0LG5a0:ZZZP2b/[80Rh^;00P8202IVIT0/[:b09bLW0800`<30180 WIfM0;:b/P2CTi<0GUiN096AT@2b/[80YZJV02DU9@2VYZH0/[:b09BDU018B4P0@T9200P8202>SXh0 /[:b07YjNP1gMgL20;:b/P0F07MgM`1dM7@0/[:b09>CT`020P80OWin0;:b/P2a/K40MgMg0:6QX@2b /[80WinO00@4101`L700/[:b0;2`/00S8b<00@4109ZJVP2b/[80U9BD03Ti>@80/[:b00D0UiNG02XZ :P0[:b/0<30`05EEE@020;:b/P0508>3P`2>SXh0/[:b0;6a/@0[:b/0o`0000010000000300l?3`00 000000000=X00000000:0000000=0:RXZ03oool0i>CT0k^kP0P8200jn_[0?oo o`3no_h0oOgm0?ooo`3moOd0_Kfm01DE5@1jNWX00P3oool02P2GUiL000000000000<30`0lO7a0?oo o`3hn?P07QhN0000002j^[X20?ooo`0?06m_K`1JFUX0oooo0?KfmP2l_;`0oooo0@3Xj>P40?ooo`0K08F5Q@000000Lg=c0;:b/P2JVYX0YJFU0:n_[`2XZ:P0YJFU09>C T`2b/[80P82000000012@T80/[:b0:n_[`0g=cL0WYjN0;:b/P1^KVh0000008:2PP2b/[80[:b/01300D0/[:b00<0[jn_034a<@2@T900102b/[805@0J6QX0FEUI0;:b/P2UYJD0VYZJ0:n_ [`2XZ:P0ZZZZ08n?S`2b/[80Ti>C0000000];Bd0/[:b0;6a/@16ATH0QhN70;:b/P24Q8@0000005UI F@020;:b/P0903/k>`000000Ph>30;:b/P2SXj<0BDU90;2`/02b/[80KFe]00<0000000P04A4A0:>S X`2b/[80Hf=S069RHP2b/[80Z:RX00l?3ol000000@0000000`0?3`l000000000003J000000002@00 00001@0F5QH0k^k^0?ooo`2ZZZX0MGEe00<0oooo00H0Shn?08Z:RP3oool0o_kn03Xj>P1kNg/20?oo o`040=3@d00O7al02`/;08:2PP80oooo00L0g=cL01TI6@3/k>`0oooo0>o_k`0c7Qh@02 0?ooo`0605=CD`2a/K40oooo0>?Sh`1ADE40no_k0P3oool01`35aLD0HV9R0?ooo`3oool0PH610000 002g]kL00P3oool205EEE@80oooo00l0^KVi00`<301]KFd0o_kn0?ooo`3Kfm/08B4Q0>_[j`3oool0 o?cl0:BTY02DU9@0ATI600000010@4000`2b/[800`2@T900KVi^0;:b/P020;:b/P0D0820P0000000 1@D509FEU@2b/[80Q8B40:FUY@2b/[80D51@00820P1YJFT0/[:b0;6a/@0bC00<30`000000Q8B40;:b/P2;Rh/0W9bL0;:b/P1SHf<00`<304=3 @`2a/K40/[:b05QHF0020P80JFUY0;:b/P2^[Zh0@41009jNWP2b/[80VIVI01TI6@0000008B4Q0000 001IFET0/[:b0:6QX@28R8P0/[:b08Z:RP010@40o`0000010000000300l?3`00000000000=X00000 00090000000605eMG@3oool0oooo0820P00/;2`0o_kn0P3oool01`1HF5P0E5AD0?ooo`3oool0YZJV 01`L703bl_800P3oool00`3Vi^H0c/k>0?ooo`020?ooo`0708R8R0051@D0kno_0?ooo`3emOD0MgMg 0=GEe@020?ooo`05065QH@1_Kfl0oooo0?ooo`2LW9`00P0000001P0?3`l0l?3`0?ooo`3moOd0d=3@ 0>g]k@80oooo00L0fm_K03De=@3alO40oooo0;jn_P0>3Ph0hN7Q0080oooo00L0V9RH020P803inOT0 oooo0=oOg`0<30`0/k>c0080oooo0P1EEED20?ooo`030>k^kP3@d=00oooo0080oooo00/0RXZ:00<3 0`3_knl0oooo0?_kn`29RHT0Lg=c059BDP0000004Q8B0:JVYP020;:b/P030820P00S8b<0[Jf]0080 /[:b00@0P820000000000000B4Q80`2b/[80102`/;00?Cdm07MgM`2IVIT20;:b/P0;09ZJVP1aLG40 Fe]K0;:b/P2_[jl0;bl_02@T902][Jd0/[:b05ADE01LG5`00P2b/[801@1YJFT0D51@03Hf=P061PH0 V9RH0080/[:b00<0UYJF01TI6@2SXj<00P2b/[80102CTi<01@D50000000d=3@40;:b/P0804E5A@1J FUX0TI6A0;6a/@2b/[80XZ:R07emO@1fMWH20;:b/P0>0410@01ADE40/[:b0;:b/P2MWId0O7al0:2P X00E5AD03Ph>0:FUY@2b/[80/K6a0;:b/P1]KFgo00000080000000<03`l?000000000000fP000000 00P0000000L020P80=?Cd`3oool0oooo05YJFP010@40jNWY0080oooo00P0;Bd]02HV9P3oool0oooo 0?knoP0N7Qh0Fe]K0?7al@D0oooo00@0/;2`010@400;2`/0no_k1@3oool00`3Cdm<04Q8B0820P002 0?ooo`050:>SX`0000000000010@403kno/01@3oool00`3Lg=`0?clo092@T0020?ooo`0309NGU`00 0000[jn_0080oooo00<0K6a/0000003Ogml00P3oool0101LG5`0/k>c0?ooo`3oool205UIF@H0oooo 00@0];Bd01LG5`0:2PX0no_k103oool01038bSX`061PH00P8209JFUP2g]kL0^[Zj04=3@`00000000<30`0000002`/;0:ZZZP<0]KFe00D0^;Rh 08>3P`000000000003`l?0020820P00604aCT`20P8008B4Q0000000E5AD0Ng]k07moO`1n OWh09bLWo`0000020000000300/;2`00000000000=X00000001X0000000301hN7P0?3`l03`l?0?l0 3`l?@@0?3`l00`0N7Qh000000000003J00000000o`00003o000008X00000003o00000?l00000RP00 00000?l00000o`00002:00000000\ \>"], "WWMCHeader", ShowCellBracket->False, CellMargins->{{0, 0}, {0, 0}}, Evaluatable->False, CellFrameMargins->4, ImageSize->{648, 25}, ImageMargins->{{0, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, Background->GrayLevel[0]], Cell[CellGroupData[{ Cell["Tactics for solving equations in Mathematica", "Title"], Cell["\<\ Daniel Lichtblau Wolfram Research, Inc. danl@wolfram.com Original version: June 1998 Most recent update: January 2005\ \>", "Author"], Cell[CellGroupData[{ Cell["Abstract", "Section"], Cell[TextData[{ "We will discuss equation solving via Solve and other commands. We will \ outline the workings of ", StyleBox["Solve", "InputWord"], ", give simple examples of its use, and provide pointers to related \ functions and when/how to use them. We will also show ways in which to tackle \ problems that are not immediately tractable for ", StyleBox["Solve", "InputWord"], "." }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["Initialization", "Section"], Cell[BoxData[{ \(\(Off[General::spell]; \)\), \(\(Off[General::spell1]; \)\)}], "Input"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[{ "Functions in ", StyleBox["Mathematica", FontSlant->"Italic"], " for solving equations and systems of equations" }], "Section"], Cell[TextData[{ "The general purpose algebraic equation solver engine is ", StyleBox["Solve", "InputWord"], ". For linear systems one might instead use matrix notation and call ", StyleBox["LinearSolve", "InputWord"], " or ", StyleBox["RowReduce", "InputWord"], " (an example of the difference will be shown below). For large sparse \ systems with machine number real or constant coefficients, there is ", StyleBox["Developer`SparseLinearSolve", "InputWord"], ". For solving linear systems repeatedly with the same matrix of \ coefficients one might use ", StyleBox["LUDecomposition", "InputWord"], " followed (repeatedly) by ", StyleBox["LUBackSubstitution", "InputWord"], ". For approximate solutions to algebraic systems that have finitely many \ solutions there is ", StyleBox["NSolve", "InputWord"], ". For approximate solutions near a given point one can use ", StyleBox["FindRoot", "InputWord"], " or, in some cases, ", StyleBox["FindMinimum", "InputWord"], ". It is not feasible to discuss all these in detail. I will show examples \ of several and for the rest we will make do with general remarks. " }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["How Solve works", "Section"], Cell[TextData[{ "I will begin with an abbreviated description of what ", StyleBox["Solve", "InputWord"], " does. First we look for special cases such as one polynomial equation in \ one unknown, or linear equations in the given variables. Then we try \ preprocessing to transform various sorts of transcendentals such as logs or \ exponentials. We also will attempt factorization and other methods of \ regrouping to try to obtain simpler equations. After this we put the \ equations into disjunctive-normal-form (", StyleBox["Or", "InputWord"], "'s of ", StyleBox["And", "InputWord"], "'s). After this we make the equations into polynomials in terms of \ internal variables. Transcendentals, radicals, and denominators will all \ become new variables, with appropriate auxiliary polynomials that describe \ relations between them and other variables. For example, ", StyleBox["Sqrt[x-1]", "InputWord"], " gives rise to an equation ", StyleBox["newvar^2-(x-1)", "InputWord"], ". ", StyleBox["Cos[x+y]", "InputWord"], " will get a new variable that in essence \"inverts\" it (using ", StyleBox["InverseFunction", "InputWord"], ") so that we can get at it's innards." }], "Text"], Cell[TextData[{ "At this point we sort variables and form a lexicographic \ Gr\[ODoubleDot]bner basis for the polynomials with respect to the ordered \ variables. We then do further work to try to determine if the system has \ finitely many solutions (did we solve for all variables?) because there are \ some simplifications in this case. After this we perform root extraction. \ This itself is a strenuous procedure. It may try factoring, decomposition, \ Cardano formulas (with attempts to simplify radicals used therein), and \ algebraic number (", StyleBox["Root[...]", "InputWord"], ") technology. ", StyleBox["Roots", "InputWord"], " obtained for the last variable will be back-substituted into polynomials \ in the basis in the remaining variables, we get roots for the next-to-last \ variable, back substitute, etc." }], "Text"], Cell["\<\ Once we have found solutions we need to check for circular \ dependencies (that is, did we solve for a variable in terms of itself?) in \ cases where we had transcendentals in the input. Under some circumstances we \ may also need to attempt numerical verification, in case non-polynomial \ functions were in the input (say radicals or transcendentals) because in such \ cases we may get parasite solutions from the process of forming polynomials \ of the input.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[ "Types of equations Solve can frequently handle\[IndentingNewLine]"], "Section"], Cell[TextData[{ "Below are several classes of problem that can frequently be handled simply \ by calling ", StyleBox["Solve", "InputWord"], "." }], "Text"], Cell["(1) Polynomial systems (it is designed for this).", "Text"], Cell["\<\ (2) More generally, algebraic systems (that is, we allow radicals). \ Here is an example.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[a\^2 - \@a + a\^\(2/3\) == 5, a]\)], "Input"], Cell[BoxData[ \({{a \[Rule] Root[15625 - 1875\ #1 - 18925\ #1\^2 + 1469\ #1\^3 + 9496\ #1\^4 - 444\ #1\^5 - 2527\ #1\^6 + 60\ #1\^7 + 377\ #1\^8 - 3\ #1\^9 - 30\ #1\^10 + #1\^12 &, 2]}, {a \[Rule] Root[15625 - 1875\ #1 - 18925\ #1\^2 + 1469\ #1\^3 + 9496\ #1\^4 - 444\ #1\^5 - 2527\ #1\^6 + 60\ #1\^7 + 377\ #1\^8 - 3\ #1\^9 - 30\ #1\^10 + #1\^12 &, 3]}, {a \[Rule] Root[15625 - 1875\ #1 - 18925\ #1\^2 + 1469\ #1\^3 + 9496\ #1\^4 - 444\ #1\^5 - 2527\ #1\^6 + 60\ #1\^7 + 377\ #1\^8 - 3\ #1\^9 - 30\ #1\^10 + #1\^12 &, 4]}}\)], "Output"] }, Open ]], Cell[TextData[{ "(3) Systems that are polynomials in trigs, exponentials, or (sometimes) \ logs. Also, equations that mix a power and an exponential or logarithm can \ frequently be solved in terms of the ", StyleBox["ProductLog", "InputWord"], " function. Here are a few examples, taken from benchmark tests. The last \ example below is a power-and-logarithm problem in disguise (take logs of both \ sides). Further down I show a related example, where we use an infinite \ ladder of exponentials in the variable of interest." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[{\[ExponentialE]\^\(x + 3\ y - 2\) == 7, 3\^\(2\ x - y + 4\) == 2}, {x, y}]\)], "Input"], Cell[BoxData[ \(Solve::"ifun" \( : \ \) "Inverse functions are being used by \!\(Solve\), so some solutions may \ not be found."\)], "Message"], Cell[BoxData[ \({{x \[Rule] \(-\(\(\(-3\)\ Log[2] + 10\ Log[3] - Log[3]\ Log[7]\)\/\(7\ Log[3]\)\)\), y \[Rule] \(-\(\(Log[2] - 8\ Log[3] - 2\ Log[3]\ Log[7]\)\/\(7\ Log[3]\)\)\)}} \)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[ \(-Log[3]\) + 1\/2\ Log[2 + y\/3] - 1\/2\ Log[y\/3] == 1\/2\ \((\(-\[ImaginaryI]\))\)\ \[Pi], y]\)], "Input"], Cell[BoxData[ \({{y \[Rule] \(-\(3\/5\)\)}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[ Cos[1\/5 + alpha + x] == 5 && Cos[2\/5 + alpha - x] == 6, {alpha, x}] \)], "Input"], Cell[BoxData[ \(Solve::"ifun" \( : \ \) "Inverse functions are being used by \!\(Solve\), so some solutions may \ not be found."\)], "Message"], Cell[BoxData[ \({{alpha \[Rule] 1\/10\ \((\(-3\) + 5\ ArcCos[5] + 5\ ArcCos[6])\), x \[Rule] 1\/10\ \((1 + 5\ ArcCos[5] - 5\ ArcCos[6])\)}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[a\^\(2\ x\) - a\^\(x/2\) + a\^\(x/3\) == 2, x]\)], "Input"], Cell[BoxData[ \(Solve::"ifun" \( : \ \) "Inverse functions are being used by \!\(Solve\), so some solutions may \ not be found."\)], "Message"], Cell[BoxData[ \({{x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 1]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 2]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 3]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 4]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 5]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 6]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 7]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 8]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 9]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 10]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 11]]\/Log[a\^\(1/6\)]}, {x \[Rule] Log[Root[\(-2\) + #1\^2 - #1\^3 + #1\^12 &, 12]]\/Log[a\^\(1/6\)]}} \)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[\((x\^2 - 5\ x + 5)\)\^\(x\^2 - 9\ x + 20\) == 1, x]\)], "Input"], Cell[BoxData[ \(Solve::"ifun" \( : \ \) "Inverse functions are being used by \!\(Solve\), so some solutions may \ not be found."\)], "Message"], Cell[BoxData[ \({{x \[Rule] 1}, {x \[Rule] 4}, {x \[Rule] 5}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[x\^x == \[ExponentialE], x]\)], "Input"], Cell[BoxData[ \(InverseFunction::"ifun" \( : \ \) "Inverse functions are being used. Values may be lost for multivalued \ inverses."\)], "Message"], Cell[BoxData[ \(InverseFunction::"ifun" \( : \ \) "Inverse functions are being used. Values may be lost for multivalued \ inverses."\)], "Message"], Cell[BoxData[ \(Solve::"ifun" \( : \ \) "Inverse functions are being used by \!\(Solve\), so some solutions may \ not be found."\)], "Message"], Cell[BoxData[ \({{x \[Rule] 1\/ProductLog[1]}}\)], "Output"] }, Open ]], Cell[TextData[{ "(4) Systems that can be transformed into amenable problems of the above \ type by adroit use of ", StyleBox["Collect", "InputWord"], ", ", StyleBox["Together", "InputWord"], ", ", StyleBox["Factor", "InputWord"], ", etc. A fair amount of transformative (is that a word?) preprocessing is \ built into ", StyleBox["Solve", "InputWord"], "; we try to look for excessive leaf count growth in an attempt to avoid \ hanging due to such transformations." }], "Text"], Cell[TextData[{ StyleBox["Solve", "InputWord"], " is by no means perfect in regards to (3) or (4), but it is tolerably \ good. Several examples may be found in the \"further examples\" for ", StyleBox["Solve", "InputWord"], " in the on-line documentation." }], "Text"], Cell[TextData[{ "(5) Simple equations involving ", StyleBox["Abs", "InputWord"], ", ", StyleBox["Min", "InputWord"], ", etc. Anything too hard for ", StyleBox["Solve", "InputWord"], " might be attempted with ", StyleBox["Algebra`InequalitySolve`", "InputWord"], ". Actually this is often preferable for the simple reason that it can \ represent solution sets in regions of real space, unlike ", StyleBox["Solve", "InputWord"], ". Examples:" }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[Abs[x - 1]\ \[Equal] \ Min[x + 2, \ 4], \ x]\)], "Input"], Cell[BoxData[ \(Solve::"ifun" \( : \ \) "Inverse functions are being used by \!\(Solve\), so some solutions may \ not be found."\)], "Message"], Cell[BoxData[ \({{x \[Rule] \(-\(1\/2\)\)}, {x \[Rule] 5}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ RowBox[{\(Solve[Abs[x - 1] + Abs[x + 2] \[Equal] 3, x]\), " ", RowBox[{ StyleBox["(*", "CodeComment"], StyleBox[" ", "CodeComment"], StyleBox[\(gives\ garbage\ result\), "CodeComment"], StyleBox[" ", "CodeComment"], StyleBox["*)", "CodeComment"]}]}]], "Input"], Cell[BoxData[ \({{}}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[{ \(<< Algebra`InequalitySolve`\), \(InequalitySolve[Abs[x - 1] + Abs[x + 2] \[Equal] 3, x]\)}], "Input"], Cell[BoxData[ \(\(-2\) \[LessEqual] x \[LessEqual] 1\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(InequalitySolve[Abs[x - 1]\ \[Equal] \ Min[x + 2, \ 4], \ x]\)], "Input"], Cell[BoxData[ \(InequalitySolve::"npi" \( : \ \) "A nonpolynomial equation or inequality encountered. The solution set \ may be incorrect."\)], "Message"], Cell[BoxData[ \(x == \(-\(1\/2\)\) || x == 5\)], "Output"] }, Open ]], Cell[TextData[{ "We do not pursue inequalities further here. This is the topic of another \ talk and ", StyleBox["Mathematica", FontSlant->"Italic"], " notebook." }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["\<\ \[IndentingNewLine]Tactics for solving difficult systems of \ equations\ \>", "Section"], Cell[TextData[{ "(1) Subtract right-hand-sides from left-hand-sides, apply ", StyleBox["Numerator[Together[#]]&", "InputWord"], ", set result equal to zero. This will ignore difficulties at vanishing \ denominators but is often more efficient than built-in methods. The built-in \ code will create extra variables and equations for every denominator, in \ effect as ", StyleBox["newvar*denom==1", "InputWord"], " (this enforces that denom cannot vanish). These extra equations can \ drastically slow the solve process.\n\n(2) For strenuous nonlinear polynomial \ systems, precompute ", StyleBox["GroebnerBasis[polynomials,vars]", "InputWord"], ", set the result to zero, and call ", StyleBox["Solve", "InputWord"], " on that. This is often effective because ", StyleBox["Solve", "InputWord"], " is not yet overhauled to use the better Gr\[ODoubleDot]bner code. More \ importantly, you can play with the variable ordering and might find one that \ is better than the ordering ", StyleBox["Solve", "InputWord"], " chooses according to its heuristics.\n\n(3) Use ", StyleBox["FindRoot", "InputWord"], ". Many problems do not have \"nice\" algebraic solutions, and ", StyleBox["FindRoot", "InputWord"], " will use Newton's method and relatives (e.g. secant method) to find an \ approximate solution, given a reasonable starting point. Caveat: ", StyleBox["FindRoot", "InputWord"], " requires same number of equations as unknowns. If for some reason the \ system is underdetermined then you may want to \"specialize\" some variables, \ that is, choose particular values for them, and then solve for the rest. \ Alternatively you might try ", StyleBox["FindMinimum", "InputWord"], ". Below is a simple example. We want a solution to one equation, ", StyleBox["x^2+y^2==1", "InputWord"], ", in two variables ", StyleBox["x", "InputWord"], " and ", StyleBox["y", "InputWord"], ". If we only require a real solution we can rephrase it as a ", StyleBox["FindMinimum", "InputWord"], " problem by squaring the (left hand side) - (right hand side). If we had \ more equations we would sum all such squares." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(FindMinimum[\((x^2 + y^2 - 1)\)^2, {x, 3}, {y, \(-4\)}]\)], "Input"], Cell[BoxData[ \({4.930380657631324`*^-32, {x \[Rule] 0.6000000000000001`, y \[Rule] \(-0.7999999999999998`\)}} \)], "Output"] }, Open ]], Cell[TextData[{ "(4) If you have algebraic equations (nothing transcendental), only \ finitely many solutions, want all of them, and will settle for \ approximations, try ", StyleBox["NSolve", "InputWord"], ". Our new ", StyleBox["NSolve", "InputWord"], " code is generally alot faster than ", StyleBox["Solve", "InputWord"], " for such systems." }], "Text"], Cell[TextData[{ "(5) If you have a symbolic linear system you can expect intermediate \ coefficient swell as the culprit of hanging or huge solution sets. For such \ systems ", StyleBox["Solve", "InputWord"], " will directly call ", StyleBox["RowReduce", "InputWord"], " (not ", StyleBox["LinearSolve", "InputWord"], ", more on this below). Hence tactics to improve matters might involve \ setting the ", StyleBox["Method", "InputWord"], " option of ", StyleBox["RowReduce", "InputWord"], " to either ", StyleBox["CofactorExpansion", "InputWord"], " or ", StyleBox["OneStepRowReduction", "InputWord"], ". The default of ", StyleBox["Automatic", "InputWord"], " will generally select ", StyleBox["DivisionFreeRowReduction", "InputWord"], " because it is often fastest on \"small\" examples and because I know of \ no heuristics to decide between methods for symbolic linear algebra. For \ systems that have symbolic entries that are low-degree polynomial or rational \ functions in one variable you might go so far as to code something to \ interpolate the solutions. The result is often remarkably smaller and more \ rapidly obtained than what you might get using built-in methods of row \ reduction. See The ", StyleBox["Mathematica", FontSlant->"Italic"], " Journal, Vol. 7 #1, pp 26-27 for an example of how one might do this." }], "Text"], Cell["\<\ (6) Sometimes conversion from trigs to exponentials, or expansion \ of trigs, can be of help. For example, the following was posed in the news \ group comp.soft-sys.math.mathematica.\ \>", "Text"], Cell[BoxData[ \(\(eqns\ = \ {\(-L\) + C*x + \((2*R)\)/Tan[y/2], \(-x\) + 2*\((\((V - R - R/Cos[y])\)*Tan[y])\)}; \)\)], "Input"], Cell[BoxData[ \(Timing[sol1 = Solve[Together[TrigToExp/@eqns] \[Equal] 0, \ {x, y}]; ] \)], "Input"], Cell[TextData[{ "An alternative that works better is to expand the trigs, first changing ", StyleBox["y", "InputWord"], " to ", StyleBox["2*z", "InputWord"], " to get rid of the denominator inside one of the trigs. We get a result \ with small ", StyleBox["LeafCount", "InputWord"], " quite fast." }], "Text"], Cell[BoxData[{ \(\(eqs = TrigExpand/@ {\(-L\) + C*x + \((2*R)\)/Tan[z], \(-x\) + 2*\((\((V - R - R/Cos[2*z])\)*Tan[2*z])\)};\)\), \(Timing[ sol = Solve[eqs \[Equal] 0, {x, z}] /. \((z \[Rule] a_)\) \[RuleDelayed] \(y \[Rule] 2*a\); ]\)}], "Input"], Cell[BoxData[ \(us\ = \ \((u*\((1\ + \ 2*v\ + \ h*t*\((\(-1\)\ + \ \[Theta])\))\)\ + \n\t v*\((1\ + \ h*t*\((\(-1\)\ + \ \[Theta])\)\ - \ t*\[Theta])\)) \)/\n\t\(( 2\ + \ u\ + \ v\ + \ t*\((\(-2\)\ + \ h*\((u\ + \ v)\)*\((\(-1\)\ + \ \[Theta])\)\ - \ v*\[Theta])\))\)\)], "Input"] }, Open ]], Cell[CellGroupData[{ Cell["Working through some difficult systems by hand", "Section"], Cell["\<\ We will discuss a few systems of equations that were posted to the \ Usenet news group comp.soft-sys.math.mathematica. These use methods discussed \ above for making a system more tractable, analyzing it, and the like. Much of \ the methodology shown below comes from responses posted by the author to that \ news group.\ \>", "Text"], Cell[CellGroupData[{ Cell["example (i)", "Subsection"], Cell["We start with the following set of equations.", "Text"], Cell[BoxData[ \(\(exprs = {x1\ x2 - x3\ x4 - 100, 3\/x2 - x1\^2 - 1\/10\^3, x4\/x1 + x2\ x3 - 2\/10\^6, x1\ x4 - x3\/x2 - 5\/10\^13}; \)\)], "Input"], Cell[TextData[{ "The poster was using ", StyleBox["FindRoot", "InputWord"], " to look for solutions, and noted that machine precision did not seem to \ give adequate results. Two approaches worth trying are to use ", StyleBox["Solve", "InputWord"], " or ", StyleBox["NSolve", "InputWord"], " directly, or to use ", StyleBox["FindRoot", "InputWord"], " with some sensible starting values. It happens that the system above has \ no real solutions, hence giving real starting values is hopeless because ", StyleBox["FindRoot", "InputWord"], " uses variations of Newton's method and will never leave the real axes in \ its search for a result." }], "Text"], Cell[TextData[{ "First we show that ", StyleBox["Solve", "InputWord"], " can do this directly." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(vars\ = \ {x1, x2, x3, x4}; \n\ \ sol\ = \ Solve[exprs == 0, \ vars]; \n\tnsol1\ = \ N[sol, \ 100]; \n\ \ \ exprs\ /. \ nsol1\ // \ Chop\)], "Input"], Cell[BoxData[ \(Root::"amb" \( : \ \) "Root object \!\(Root[\(\(\(\(\[LeftSkeleton] 16 \[RightSkeleton]\) + \ \(48000000000000000000\\ #1\^11\)\) &\), 1\)]\) may be ambiguous. Changing \ the value of ExactRootIsolation option to Root to True and redoing the \ computations is recommended."\)], "Message"], Cell[BoxData[ \(Root::"amb" \( : \ \) "Root object \!\(Root[\(\(\(\(\[LeftSkeleton] 16 \[RightSkeleton]\) + \ \(48000000000000000000\\ #1\^11\)\) &\), 1\)]\) may be ambiguous. Changing \ the value of ExactRootIsolation option to Root to True and redoing the \ computations is recommended."\)], "Message"], Cell[BoxData[ \(Root::"amb" \( : \ \) "Root object \!\(Root[\(\(\(\(\[LeftSkeleton] 16 \[RightSkeleton]\) + \ \(48000000000000000000\\ #1\^11\)\) &\), 1\)]\) may be ambiguous. Changing \ the value of ExactRootIsolation option to Root to True and redoing the \ computations is recommended."\)], "Message"], Cell[BoxData[ \(General::"stop" \( : \ \) "Further output of \!\(Root :: \"amb\"\) will be suppressed during this \ calculation."\)], "Message"], Cell[BoxData[ \($MaxExtraPrecision::"meprec" \( : \ \) "In increasing internal precision while attempting to evaluate \ \!\(Root[\(\(\(\(\[LeftSkeleton] 16 \[RightSkeleton]\) + \ \(48000000000000000000\\ #1\^11\)\) &\), 1\)]\), the limit $MaxExtraPrecision \ = \!\(50.`\) was reached. Increasing the value of $MaxExtraPrecision may help \ resolve the uncertainty."\)], "Message"], Cell[BoxData[ \($MaxExtraPrecision::"meprec" \( : \ \) "In increasing internal precision while attempting to evaluate \ \!\(Root[\(\(\(\(\[LeftSkeleton] 16 \[RightSkeleton]\) + \ \(48000000000000000000\\ #1\^11\)\) &\), 1\)]\), the limit $MaxExtraPrecision \ = \!\(50.`\) was reached. Increasing the value of $MaxExtraPrecision may help \ resolve the uncertainty."\)], "Message"], Cell[BoxData[ \($MaxExtraPrecision::"meprec" \( : \ \) "In increasing internal precision while attempting to evaluate \ \!\(Root[\(\(\(\(\[LeftSkeleton] 16 \[RightSkeleton]\) + \ \(48000000000000000000\\ #1\^11\)\) &\), 1\)]\), the limit $MaxExtraPrecision \ = \!\(50.`\) was reached. Increasing the value of $MaxExtraPrecision may help \ resolve the uncertainty."\)], "Message"], Cell[BoxData[ \(General::"stop" \( : \ \) "Further output of \!\($MaxExtraPrecision :: \"meprec\"\) will be \ suppressed during this calculation."\)], "Message"], Cell[BoxData[ \({{4.\ 087822381084812036212230816971280343020861677317127916397068597625103910548038\ 083451095776588`95.584*^167, \(-6.94444444444449444444444804465449444443148365179243698006561541362\ 275868832818833546092472130539016`99.699*^25\), \(-8.20031754436720153537818856552840242048152747577481458289665338915\ 00534025949828205662920564033`95.5606*^170\), \(-3.36954014316489607767784715236998892271085745774985190799092588676\ 646523484180041869556377664665`95.9099*^88\)}, {0, 0, 0, 0}, {0, 0, 0, 0}, { 0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}, { 0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}\)], "Output"] }, Open ]], Cell["\<\ This also shows that sometimes the default methods are not quite \ adequate. If we do\ \>", "Text"], Cell[BoxData[ \(SetOptions[Roots, \ ExactRootIsolation -> True]\)], "Input"], Cell[TextData[{ "and then redo the ", StyleBox["Solve", "InputWord"], " and ", StyleBox["N[...]", "InputWord"], " all will be better when we plug the solutions into the original \ expressions." }], "Text"], Cell["\<\ We now use FindRoot to obtain a solution. The method below will \ work for some random starting values, but not for others. All the same, it \ gives a way to get solutions without undue labor.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\ max\ = \ 50; \n\ \ \ start\ := \ Table[Random[Complex, max + I*max, 100], \ {4}]\), \(\ \ \ FindRoot[Evaluate[Thread[exprs == 0]], \n\ \ \ \ \ \ \ \ \ \ \ Evaluate[Sequence\ @@\ Thread[{vars, start}]], \n\ \ \ \ \ \ \ \ \ \ \ WorkingPrecision -> 100, \ AccuracyGoal -> 20, \n\ \ \ \ \ \ \ \ \ \ \ MaxIterations -> 300]\)}], "Input"], Cell[BoxData[ \({x1 \[Rule] 0.014999999999999999999998560063001797467485306137763735528722624`61.\ 5885 + 0.027838821814150109610597485501729138095641673087701624312539091`61.\ 857\ \[ImaginaryI], x2 \[Rule] 1500.00000000000000000012005098860166131938755187657706797779511352333\ 579600459954`80.6197 - 2783.882181415010961060015791169690956380565829751248000610343942077\ 34012394438016`80.8883\ \[ImaginaryI], x3 \[Rule] 2.99895010498950104989467481934183504089753701696503`50.6093*^-10 + 5.56859944397633179442005056109410866719010788409747`50.878*^-10\ \[ImaginaryI], x4 \[Rule] 1.0498950104989501049894177125115846977259072934103859655`55.7582*^-11 - 8.350811463098723010879728025757227629980271572657320752`55.6588*\ ^-12\ \[ImaginaryI]}\)], "Output"] }, Open ]], Cell[TextData[{ "One comment is that, given the spread in scales of the input coefficients, \ machine precision will most likely be inadequate for getting results. Hence \ the desire to meddle with the ", StyleBox["WorkingPrecision", "InputWord"], ", ", StyleBox["AccuracyGoal", "InputWord"], ", and ", StyleBox["MaxIterations", "InputWord"], " options of ", StyleBox["FindRoot", "InputWord"], "." }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["example (ii)", "Subsection"], Cell[TextData[{ "The following system is a bit tricky. The user is interested in positive \ solutions, should any exist. It looks like the ", StyleBox["FindRoot", "InputWord"], " method from example (i) above might work for it, but this proves not to \ be the case." }], "Text"], Cell[BoxData[ \(polys = {369664\/981 - 1\/\(x2\ \((x3 + x4)\)\), \(-\(6513786578938559\/9223372036854775808\)\) + x1\ x4 + x1\ x5 + x6\ x7, \(-\(3858337547701687\/9444732965739290427392\)\) + x1\ x2\ x4\ x5 + x1\ x4\ x6\ x7 + x1\ x5\ x6\ x7, \(-\(1\/97280000000\)\) + x1\ x2\ x4\ x5\ x6\ x7, 981\/369664 - x2\ x3 - x2\ x4, 77\/924160000 - x1\ x2\ x3\ x4 - x1\ x2\ x3\ x5 - x2\ x3\ x4\ x6 - x2\ x3\ x6\ x7 - x2\ x4\ x6\ x7, 1\/1848320000000 - x1\ x2\ x3\ x4\ x6\ x7 - x1\ x2\ x3\ x5\ x6\ x7}; vars = {x1, x2, x3, x4, x5, x6, x7}; \)], "Input"], Cell[TextData[{ StyleBox["FindRoot", "InputWord"], " gives failure-to-converge warning and a bad residual. When the\n ", StyleBox["MaxIterations", "InputWord"], " option is upped considerably we still have this problem. We will see why \ presently. First we prepare to use exact solving methods, by clearing \ denominators, extracting numerators, and forming a Gr\[ODoubleDot]bner \ basis." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(p2\ = \ Numerator[Together[polys]]; \n gb\ = \ GroebnerBasis[p2, \ vars]; \nLength[gb]\)], "Input"], Cell[BoxData[ \(6\)], "Output"] }, Open ]], Cell[TextData[{ "This reveals the source of the difficulty in using ", StyleBox["FindRoot", "InputWord"], ". We have an underdetermined system. The solution set is one dimensional, \ and Newton's method fails because the Jacobian is singular. All the same, for \ this particular system we can do alot more." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(gb[\([1]\)]\)], "Input"], Cell[BoxData[ \(\(-144115188075855872\) + 5727219797369691640625\ x6\ x7 - 9900955599986609680000000\ x6\^2\ x7\^2 + 14019525496019259228160000000\ x6\^3\ x7\^3\)], "Output"] }, Open ]], Cell[TextData[{ "We see that the first polynomial can be made univariate by substituting ", StyleBox["z", "InputWord"], " for ", StyleBox["x6*x7", "InputWord"], "." }], "Text"], Cell[BoxData[ \(\(pol1 = Last[PolynomialReduce[gb\[LeftDoubleBracket]1\[RightDoubleBracket], x6\ x7 - z, {x6, x7, z}]]; \)\)], "Input"], Cell["We now find the roots of this polynomial.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(rz\ = \ NRoots[pol1 == 0, \ z, \ 50]\)], "Input"], Cell[BoxData[ \(z == 0.00002631578947368421257295093734440182212051317541593`49.3587 || z == 0.0003399551832627632631436772994454357857827081508994`49.4544 - 0.0005244573132036400673608051786757841450315497819155`49.6427\ \[ImaginaryI] || z == 0.0003399551832627632631436772994454357857827081508994`49.4544 + 0.0005244573132036400673608051786757841450315497819155`49.6427\ \[ImaginaryI]\)], "Output"] }, Open ]], Cell[TextData[{ "We have a positive root, which means we might have solutions for the \ original system for which ", StyleBox["x6", "InputWord"], " and ", StyleBox["x7", "InputWord"], " are positive, and their product must then be approximately 0.0000263158. \ We can now play with ", StyleBox["FindRoot", "InputWord"], " a bit more, giving these new polynomials and adjoining a specific value \ for ", StyleBox["x7", "InputWord"], ", say, to have #equations = #unknowns." }], "Text"], Cell[TextData[{ "I chose to set ", StyleBox["x7", "InputWord"], " to one. By trial and error I found I had bad luck with ", StyleBox["MaxIterations", "InputWord"], " set to 100, but better results at 500. Caveat: this seems to depend \ heavily on having \"lucky\" random starting values." }], "Text"], Cell[BoxData[{ \(max\ = \ 50; \n start\ := \ Table[Random[Real, max, 100], \ {Length[vars]}]\), \(\(rt\ = \ FindRoot[Evaluate[Thread[Prepend[gb, x7 - 1] == 0]], \n \ \ \ \ \ \ \ \ \ \ \ Evaluate[Sequence\ @@\ Thread[{vars, start}]], \n\ \ \ \ \ \ \ \ \ \ \ WorkingPrecision -> 100, \ AccuracyGoal -> 20, \n\ \ \ \ \ \ \ \ \ \ \ MaxIterations -> 400]; \)\)}], "Input"], Cell[CellGroupData[{ Cell[BoxData[ \(polys\ /. \ rt\)], "Input"], Cell[BoxData[ \({\(-0.`-6.4554*^-103\), \(-0.`-6.8121*^-109\), \(-0.`-6.5848*^-112\), \(-1.`-6.6741*^-117\), 2.`-6.4346*^-109, 1.`-6.702*^-113, 1.`-6.4861*^-118}\)], "Output"] }, Open ]], Cell[TextData[{ " We got real roots, and small residuals in the bargain. But the roots are \ not all positive. By looking hard at ", StyleBox["gb", "InputWord"], ", and keeping in mind what the product ", StyleBox["x6*x7", "InputWord"], " must be, we can prove that there is no nonnegative solution to the \ system." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Last/@ PolynomialReduce[gb, x6\ x7 - rz\[LeftDoubleBracket]1, 2\[RightDoubleBracket]]\)], "Input"], Cell[BoxData[ \({3.239236523077941139396279002864633272546781779982`49.3587*^-33, 1.0672319074126148445599036240762780763974738580124`49.3587*^86\ x5 + 2.661030840495747972280200538958840019865272745528`49.3587*^86\ x7, 1.329227995784915872903807060280344576`49.3587*^36\ x4 + 1.1820175769042802462402839996427728924163754699203`49.3587*^37\ x7, 3.483354311655665952710048388609092358440802231132`49.3587*^87\ x3 + 3.570195340839940700543429000179020127358523417341`49.3587*^86\ x7, 7.714912756920962485048802864841746175066733934288`49.3587*^124\ x2 + 8.649182463653030159385948370295392422188602313057`49.3587*^125\ x6, 2.466352649960385217966927145432296886685259963593`49.3587*^100\ x1 + 5.596581083779066501874325814280057485830651652433`49.3587*^100\ x6} \)], "Output"] }, Open ]], Cell[TextData[{ "As expected, we get a small value for the first polynomial, because it is \ supposed to vanish for that value of ", StyleBox["x6*x7", "InputWord"], ". The rest give polynomials that are each linear in ", StyleBox["x7", "InputWord"], " and in one other variable, in effect solving for that variable in terms \ of ", StyleBox["x7", "InputWord"], ". We see, moreover, that all coefficients are positive. So after dividing \ each polymonial by its ", StyleBox["x7", "InputWord"], " coefficient we have eqns of the form ", StyleBox["positive*xj+x7==0", "InputWord"], ". This gives a negative solution for each ", StyleBox["xj", "InputWord"], " for ", StyleBox["1\[LessEqual]j\[LessEqual]5", "InputWord"], ". Conclusion as stated above: there is no root of the original system with \ positive-only values. Which agrees with my experience using ", StyleBox["FindRoot", "InputWord"], " on ", StyleBox["gb", "InputWord"], " several times in the manner shown above." }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["example (iii)", "Subsection"], Cell["\<\ Below is a difficult problem with many parameters that was posed in \ the news group. We show explicitly the various tactics, discussed above, that \ were attempted by the user and others to make it tractable for solving.\ \>", "Text"], Cell[BoxData[ \(us = \(u\ \((1 + 2\ v + h\ t\ \((\(-1\) + \[Theta])\))\) + v\ \((1 + h\ t\ \((\(-1\) + \[Theta])\) - t\ \[Theta])\)\)\/\(2 + u + v + t\ \((\(-2\) + h\ \((u + v)\)\ \((\(-1\) + \[Theta])\) - v\ \[Theta]) \)\); vs = \(u\ \((1 + 2\ v + k\ s\ \((\(-1\) + \[Theta])\))\) + v\ \((1 + k\ s\ \((\(-1\) + \[Theta])\) - s\ \[Theta])\)\)\/\(2 + u + v + s\ \((\(-2\) + k\ \((u + v)\)\ \((\(-1\) + \[Theta])\) - v\ \[Theta]) \)\); \)], "Input"], Cell[TextData[{ "The variables of interest are ", StyleBox["u", "InputWord"], " and ", StyleBox["v", "InputWord"], ". The rest are constants such that\n", StyleBox[ "(0 \[LessEqual] k \[LessEqual] 1, 0 \[LessEqual] h \[LessEqual] 1, -1 < s \ < 1, -1 < t < 1)", "InputWord"], ". \nIf need be we can just handle the case of most interest, where ", StyleBox["h==k", "InputWord"], "." }], "Text"], Cell["\<\ The poster first tried one of the recommendations above, that is, \ to clear denominators.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(equations\ = {us == u, vs == v}; \n polys = Map[#[\([1]\)] - #[\([2]\)]&, equations]; \n newpolys\ = \ Map[Numerator[Together[#]]&, polys]\)], "Input"], Cell[BoxData[ \({\(-u\) + 2\ t\ u - h\ t\ u - u\^2 + h\ t\ u\^2 + v - h\ t\ v + u\ v + h\ t\ u\ v + h\ t\ u\ \[Theta] - h\ t\ u\^2\ \[Theta] - t\ v\ \[Theta] + h\ t\ v\ \[Theta] + t\ u\ v\ \[Theta] - h\ t\ u\ v\ \[Theta], u - k\ s\ u - v + 2\ s\ v - k\ s\ v + u\ v + k\ s\ u\ v - v\^2 + k\ s\ v\^2 + k\ s\ u\ \[Theta] - s\ v\ \[Theta] + k\ s\ v\ \[Theta] - k\ s\ u\ v\ \[Theta] + s\ v\^2\ \[Theta] - k\ s\ v\^2\ \[Theta]}\)], "Output"] }, Open ]], Cell[TextData[{ "As it happens, this was not sufficient to yield a system tractable to ", StyleBox["Solve", "InputWord"], ". We will explicitly compute a Gr\[ODoubleDot]bner basis, setting the ", StyleBox["CoefficientDomain", "InputWord"], " option so that we treat the parameter variables as coefficients rahter \ than as variables." }], "Text"], Cell[BoxData[ \(vars\ = \ {u, v}; \n gb\ = \ GroebnerBasis[newpolys, \ vars, \n\t CoefficientDomain -> RationalFunctions]; \)], "Input"], Cell["We now check the result to see if it is usable.", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(Length[gb]\), \(LeafCount[gb]\), \(Map[Exponent[#, u]&, \ gb]\), \(Map[Exponent[#, v]&, \ gb]\)}], "Input"], Cell[BoxData[ \(2\)], "Output"], Cell[BoxData[ \(3017\)], "Output"], Cell[BoxData[ \({0, 1}\)], "Output"], Cell[BoxData[ \({4, 3}\)], "Output"] }, Open ]], Cell[TextData[{ "We have a univariate quartic polynomial in ", StyleBox["v", "InputWord"], ", and a linear polynomial in ", StyleBox["u", "InputWord"], " with coefficients that are at worst cubics in ", StyleBox["v", "InputWord"], ". This means in principle we can solve for ", StyleBox["v", "InputWord"], " using radicals or ", StyleBox["Root", "InputWord"], " objects, then back substitute to solve for ", StyleBox["u", "InputWord"], ". Now with polynomials of this size you do not want to attempt radical \ solutions. But even if we inhibit ", StyleBox["Roots", "InputWord"], " from using the complicated radical formulas, it still appears to hang. So \ what can we do? We might substitute values for the parameters to reduce the \ complexity of the coefficients. First we will simplify the polynomials. The \ best result I obtained was as below." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(collectedgb\ = \ Map[Collect[#, vars, Simplify]&, \ gb]; \n LeafCount[collectedgb]\)], "Input"], Cell[BoxData[ \(795\)], "Output"] }, Open ]], Cell[TextData[{ "This may still be too complicated to handle in ", StyleBox["Solve", "InputWord"], " or ", StyleBox["Roots", "InputWord"], ". It is now at least in a form where one can look at the polynomials, look \ for reasonable substitutions, parameter specializations, and the like." }], "Text"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Reasons and tactics for numeric solving", "Section"], Cell[TextData[{ "Often ", StyleBox["Solve", "InputWord"], " either cannot handle a problem due to transcendental dependencies, or \ else there are numeric methods that might be preferable. In the previous \ section the exact solution tactics were emphasized. Here we work primarily \ with numeric methods e.g. ", StyleBox["FindRoot", FontWeight->"Bold"], " and ", StyleBox["NSolve", FontWeight->"Bold"], "." }], "Text"], Cell[CellGroupData[{ Cell["example (i)", "Subsection"], Cell[TextData[{ "For example, a question that came to the Usenet news group \ comp.soft-sys.math.mathematica was as follows. \"I need to plot the root of a \ transcendental equation", StyleBox[" Sin[x]==x/a", "InputWord"], ", for ", StyleBox["a", "InputWord"], " from 2 to ", StyleBox["3", "InlineFormula"], ". How might this be done?\" A simple answer uses ", StyleBox["FindRoot", "InputWord"], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(f[a_]\ := \ FindRoot[Sin[x] == x/a, \ {x, 2}]\), \(\ \ \ \(Plot[x\ /. f[a], \ {a, 2, 3}]; \)\)}], "Input"], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations -1.88095 0.952381 -2.89553 1.53535 [ [.21429 .16267 -9 -9 ] [.21429 .16267 9 0 ] [.40476 .16267 -9 -9 ] [.40476 .16267 9 0 ] [.59524 .16267 -9 -9 ] [.59524 .16267 9 0 ] [.78571 .16267 -9 -9 ] [.78571 .16267 9 0 ] [.97619 .16267 -3 -9 ] [.97619 .16267 3 0 ] [.01131 .02163 -18 -4.5 ] [.01131 .02163 0 4.5 ] [.01131 .3287 -18 -4.5 ] [.01131 .3287 0 4.5 ] [.01131 .48224 -18 -4.5 ] [.01131 .48224 0 4.5 ] [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 g .25 Mabswid [ ] 0 setdash .21429 .17517 m .21429 .18142 L s [(2.2)] .21429 .16267 0 1 Mshowa .40476 .17517 m .40476 .18142 L s [(2.4)] .40476 .16267 0 1 Mshowa .59524 .17517 m .59524 .18142 L s [(2.6)] .59524 .16267 0 1 Mshowa .78571 .17517 m .78571 .18142 L s [(2.8)] .78571 .16267 0 1 Mshowa .97619 .17517 m .97619 .18142 L s [(3)] .97619 .16267 0 1 Mshowa .125 Mabswid .07143 .17517 m .07143 .17892 L s .11905 .17517 m .11905 .17892 L s .16667 .17517 m .16667 .17892 L s .2619 .17517 m .2619 .17892 L s .30952 .17517 m .30952 .17892 L s .35714 .17517 m .35714 .17892 L s .45238 .17517 m .45238 .17892 L s .5 .17517 m .5 .17892 L s .54762 .17517 m .54762 .17892 L s .64286 .17517 m .64286 .17892 L s .69048 .17517 m .69048 .17892 L s .7381 .17517 m .7381 .17892 L s .83333 .17517 m .83333 .17892 L s .88095 .17517 m .88095 .17892 L s .92857 .17517 m .92857 .17892 L s .25 Mabswid 0 .17517 m 1 .17517 L s .02381 .02163 m .03006 .02163 L s [(1.9)] .01131 .02163 1 0 Mshowa .02381 .3287 m .03006 .3287 L s [(2.1)] .01131 .3287 1 0 Mshowa .02381 .48224 m .03006 .48224 L s [(2.2)] .01131 .48224 1 0 Mshowa .125 Mabswid .02381 .05234 m .02756 .05234 L s .02381 .08305 m .02756 .08305 L s .02381 .11375 m .02756 .11375 L s .02381 .14446 m .02756 .14446 L s .02381 .20587 m .02756 .20587 L s .02381 .23658 m .02756 .23658 L s .02381 .26729 m .02756 .26729 L s .02381 .298 m .02756 .298 L s .02381 .35941 m .02756 .35941 L s .02381 .39012 m .02756 .39012 L s .02381 .42082 m .02756 .42082 L s .02381 .45153 m .02756 .45153 L s .02381 .51294 m .02756 .51294 L s .02381 .54365 m .02756 .54365 L s .02381 .57436 m .02756 .57436 L s .02381 .60506 m .02756 .60506 L s .25 Mabswid .02381 0 m .02381 .61803 L s 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath .5 Mabswid .02381 .01472 m .06244 .05 L .10458 .08683 L .14415 .11997 L .18221 .1506 L .22272 .18196 L .26171 .21099 L .30316 .2407 L .34309 .26826 L .3815 .29386 L .42237 .32015 L .46172 .3446 L .49955 .36735 L .53984 .3908 L .57861 .41266 L .61984 .43517 L .65954 .45617 L .69774 .47578 L .73838 .49603 L .77751 .51496 L .81909 .53449 L .85916 .55276 L .89771 .56987 L .93871 .58757 L .97619 .60332 L s % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 177.938}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg00000c/h0cP3>c_[ZeT10@?XD@3cj=?oo051@n_l0o`3oolKFh^kF]XVI][jn_W61TEeMGB@T SG4LD10@A4A4aSP<:9e4LHTLH@2AoonA003o05D0ZZX005FAE@3oZZZAoj[o0?lTE@00oeGooj[oZ_nA Z_ooE@18EEE805E8ojY8ZP2A05GoE@2fEEFf05FfZZZfE@0TZUDTEJXTojY]0?m]o`2AZZX0EJ[oool0 0?l0Z_nAEOooZP3oEEE]ZUFAoeGo05GoZZY]EJZAZZZf0:[oEOnfo`00E@180018oeD005D0ojX0Z_m8 0?m8ZP1]E@2f002fZP2foeE8ZUE]05FfEEFfojY80:Y8EJZfZZZfoom8oonf0?nfEOnfZP00ZP0T000T E@0To`18ZP1]001]ZP1]o`2AE@3J003JE@3JZP3JoeD0EEDT05DTZUDToeE8EEE]EEE]oeFA05FAZUGJ 05GJEEGJZUGJojX0ojXT0:XTEJXTZZY8ojY]ZZY]ojZA0:ZAEJ[J0:[JEJ[JZZ[Jool0EOlT0?lTZ_lT oom8EOm]0?m]EOm]Z_nAoooJ0?oJEOoJZ_oJom[JfYVIVGemOO[jnZFUYK8`H@P82861POo29<;2`/hT 933><>;Rh/K6aP00kTB1]Z4PlXDl9YIFEUHf=L@00PFD00840042IYKZQY@0d?0210021PAQMIBamRH40PH6105DH ROooc^[Zj]:f]P00_W5aLFEUINkViWUYJFVf]P1E001EE@1EZP1Eo`2Z0?;VdP2ZE@2ZZP2ZoeEE05EE EGUUD5EEZUEEoeFZ05FZEEFZZUFZojYE0:YEEJYEZZYEojZZ0:ZZEJZZZZZZoomE0?mEEOmEZ_mEoonZ 0?nZEOnZZ_nZomkNg[jQONKVi_KfmXF5QL;Rh/k>cWEeMMQ3003H@`00f4<0011300<0@d<0aD<00113 00<0@d<0aD<0011300<0@d<0aD<0011300<0@d<0aD<00004@`0000=300@0@d=30P03@`80aT<00093 00<0@d<024<00`13@`030@`0304=30;A3000@@`0304=300m300<0@d<0/d<0011300<0@d<044<00`13@`2b@`00 44<00`13@`0A@`80/T<0011300<0@d<04d<00`13@`2_@`0044<00`13@`0D@`0304=30:i3000@@`03 04=301E300<0@d<0[D<0011300<0@d<05T<00`13@`2/@`0044<00`13@`0G@`80[4<0011300<0@d<0 6D<00`13@`2Y@`0044<00`13@`0J@`0304=30:Q3000@@`0304=301]31P03@`0304=300@064<400=3 00<0@d<00T<201U31003@`0404=3@`<06D<400=300@0@d=30`0N@`801T<0011300<0@d<07D<200U3 00<0@d<06D<00`13@`06@`@06T<00`13@`07@`0304<001Y300<0@d<01d<00`13000P@`0304=300=3 000@@`0304=301i30`08@`806T<200M30P0L@`801d<201a30P07@`8084<200E3000@@`0304=301m3 0P09@`0304=301U300<0@d<01D<201e300<0@d<01D<00`13@`0L@`0304=300E300<0@`007d<00`13 @`04@`0044<00`13@`0N@`8000=304<01D<201Y30P09@`0304=301U30P09@`806T<200Q30P0O@`80 1T<0011300<0@d<08T<00`13@`2P@`002d?=000044<00`13@`06@`0304=300M300<0@d<01d<00`13 @`06@`0304<000M300<0@d<01d<00`13@`06@`0304=300M300<0@d<01d<00`13@`07@`0304=300I3 00<0@d<01d<00`13@`07@`0304=300I300<0@d<01d<00`13@`07@`0304=300M300<0@d<01T<00`13 @`07@`0304=300M300<0@d<00d<0011300<0@d<09T<00`13@`2L@`0044<00`13@`0W@`80W4<00113 00<0@d<0:D<00`13@`2I@`0044<00`13@`0Z@`0304=309Q3000@@`0304=302]30P2H@`0044<00`13 @`0]@`0304=309E3000@@`0304=302i300<0@d<0U4<0011300<0@d<0;d<209A3000@@`0304=30353 00<0@d<0TD<0011300<0@d<04<00`13@`2:@`0044<00`13@`0i@`80RT<00113 00<0@d<0>d<00`13@`27@`0044<00`13@`0l@`80Qd<0011300<0@d<0?T<00`13@`24@`0044<00`13 @`0o@`80Q4<0011300<0@d<0@D<00`13@`21@`0044<00`13@`12@`0304=30813000@@`0304=304=3 0P20@`0044<00`13@`15@`0304=307e3000@@`0304=304I30P1m@`0044<00`13@`18@`0304=307Y3 000@@`0304=304U30P1j@`0044<00`13@`1;@`0304=307M3000@@`0304=304a30P1g@`0044<00`13 @`1>@`0304=307A3000400=300@0@d=30`02@`80D4<207A300000d<0@`09@`0504=3@`00Dd<00`13 @`1a@`000T<200Q300D0@d=3001D@`80LD<000=300<0@d<01T<01@13@d<005I30P1_@`0000=30000 24<200=300<0@d<0ET<00`13@`1/@`0044<00`13@`1G@`80K4<0011300<0@d<0FD<206Y3000@@`03 04=305]30P1X@`0044<00`13@`1M@`80IT<0011300<0@d<0Gd<206A3000@@`0304=3065300<0@d<0 HD<0011300<0@d<0HT<20653000@@`0304=306A30P1O@`0044<00`13@`1V@`0304=305a3000@@`03 04=306M30P1L@`0044<00`13@`1Y@`80FT<0011300<0@d<0Jd<205Q3000@@`0304=306e30P1F@`00 44<00`13@`1_@`80E4<0011300<0@d<0LD<00`13@`1A@`0044<00`13@`1b@`80DD<0011300<0@d<0 M4<204m3000@@`0304=307I300<0@d<0C4<0011300<0@d<0Md<204a3000@@`0304=307U30P1:@`00 44<00`13@`1k@`80B4<0011300<0@d<0OD<204I3000@@`0304=307m30P14@`0044<00`13@`21@`80 @T<0011300<0@d<0Pd<20413000@@`0304=308E30P0n@`001003@`0304=300@00T<00`13@`27@`80 ?4<00003@`1300Q300<0@d<00T<208Y30P0j@`000T<200Q30P02@`0304=308]30P0h@`000d<00`13 @`07@`0404=308m30P0f@`0000=3000024<200=300<0@d<0Sd<203A3000@@`0304=309530P0b@`00 44<00`13@`2C@`80<4<0011300<0@d<0UD<302e3000@@`0304=309Q30P0[@`0044<00`13@`2J@`80 :D<0011300<0@d<0W4<202M3000@@`0304=309i30P0U@`0044<00`13@`2P@`808d<0011300<0@d<0 XT<20253000@@`0304=30:A30P0O@`0044<00`13@`2V@`<074<0011300<0@d<0ZD<201Y3000@@`03 04=30:]30`0G@`0044<00`13@`2^@`805D<0011300<0@d<0/4<201=3000@@`0304=30;930P0A@`00 44<00`13@`2d@`803d<0011300<0@d<0]T<300a3000@@`0304=30;U30P0:@`0044<00`13@`2k@`<0 1d<0011300<0@d<0_T<200E3000@@`0304=30"], ImageRangeCache->{{{0, 215}, {132.438, 0}} -> {1.91732, 1.87555, 0.00386403, 0.00239686}}] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["example (ii)", "Subsection"], Cell[TextData[{ "Another reason to prefer a numeric solver might be when one particular \ solution is desired. Below is an example, also from \ comp.soft-sys.math.mathematica. The user wants only positive solutions for ", StyleBox["a", "InputWord"], " given that ", StyleBox["c", "InputWord"], " is an integer around, say, 100." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(P[c_, a_] := a\^c\/\(\(c!\)\ \(\[Sum]\+\(i = 0\)\%c a\^i\/\(i!\)\)\)\), \(FindRoot[P[100, a] == 1\/50, {a, 10}, WorkingPrecision \[Rule] 50]\)}], "Input"], Cell[BoxData[ \({a \[Rule] 87.9719828958742872263749982624851267895269882878474441`50} \)], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["example (iii)", "Subsection"], Cell[TextData[{ "A related question, also posed to the ", StyleBox["Mathematica", FontSlant->"Italic"], " users' news group, was as follows. I have a family of functions ", StyleBox["vv[m]:[0,1]-->R", "InputWord"], ", parametrized by ", StyleBox["m", "InputWord"], ", which may take any real value in the interval from one to infinity. For \ each ", StyleBox["m", "InputWord"], ", ", StyleBox["vv[m]", "InputWord"], " is defined to be", StyleBox["(1-b-Exp[-b*m])/b", "InputWord"], " for ", StyleBox["0"Italic"], "?\"" }], "Text"], Cell[TextData[{ "One can do this directly in ", StyleBox["Mathematica", FontSlant->"Italic"], ", but as we show below the result may not be quite what is wanted." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(eq = vv == \(1 - b - \[ExponentialE]\^\(m\ b\)\)\/b; inv = Solve[eq, b]\)], "Input"], Cell[BoxData[ \(InverseFunction::"ifun" \( : \ \) "Inverse functions are being used. Values may be lost for multivalued \ inverses."\)], "Message"], Cell[BoxData[ \({{b \[Rule] \(m\/\(1 + vv\) - ProductLog[ \(\[ExponentialE]\^\(m\/\(1 + vv\)\)\ m\)\/\(1 + vv\)]\)\/m}} \)], "Output"] }, Open ]], Cell[TextData[{ "The ", StyleBox["ProductLog", "InputWord"], " is the multi-valued function that inverts ", StyleBox["y==x*Exp[x]", "InputWord"], " to obtain ", StyleBox["x", "InputWord"], " as a function of ", StyleBox["y", "InputWord"], " (it is sometimes called Lambert's W function in the literature). We \ actually have a family of solutions of the form\n", StyleBox[ "{{b \[Rule] (m/(1 + vv) - ProductLog[k, (E^(m/(1 + vv))*m)/(1 + vv)])/m}}", "InputWord"], "\nindexed by integers ", StyleBox["k", "InputWord"], ". Graphing the ", StyleBox["ProductLog", "InputWord"], " function for the zero (default) and minus one branches shows real values \ near the origin. One can see this as below." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Off[Plot::plnr]; \nPlot[ProductLog[x], \ {x, \(-1\), 1}]\ ; \n Plot[ProductLog[\(-1\), x], \ {x, \(-1\), 1}]; \)], "Input"], Cell[CellGroupData[{ Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.279731 0.696459 0.383728 0.387188 [ [.00115 .37123 -12 -9 ] [.00115 .37123 12 0 ] [.14044 .37123 -12 -9 ] [.14044 .37123 12 0 ] [.41902 .37123 -9 -9 ] [.41902 .37123 9 0 ] [.55831 .37123 -9 -9 ] [.55831 .37123 9 0 ] [.69761 .37123 -9 -9 ] [.69761 .37123 9 0 ] [.8369 .37123 -9 -9 ] [.8369 .37123 9 0 ] [.97619 .37123 -3 -9 ] [.97619 .37123 3 0 ] [.26723 .07398 -24 -4.5 ] [.26723 .07398 0 4.5 ] [.26723 .15142 -24 -4.5 ] [.26723 .15142 0 4.5 ] [.26723 .22885 -24 -4.5 ] [.26723 .22885 0 4.5 ] [.26723 .30629 -24 -4.5 ] [.26723 .30629 0 4.5 ] [.26723 .46117 -18 -4.5 ] [.26723 .46117 0 4.5 ] [.26723 .5386 -18 -4.5 ] [.26723 .5386 0 4.5 ] [.26723 .61604 -18 -4.5 ] [.26723 .61604 0 4.5 ] [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 g .25 Mabswid [ ] 0 setdash .00115 .38373 m .00115 .38998 L s [(-0.4)] .00115 .37123 0 1 Mshowa .14044 .38373 m .14044 .38998 L s [(-0.2)] .14044 .37123 0 1 Mshowa .41902 .38373 m .41902 .38998 L s [(0.2)] .41902 .37123 0 1 Mshowa .55831 .38373 m .55831 .38998 L s [(0.4)] .55831 .37123 0 1 Mshowa .69761 .38373 m .69761 .38998 L s [(0.6)] .69761 .37123 0 1 Mshowa .8369 .38373 m .8369 .38998 L s [(0.8)] .8369 .37123 0 1 Mshowa .97619 .38373 m .97619 .38998 L s [(1)] .97619 .37123 0 1 Mshowa .125 Mabswid .03597 .38373 m .03597 .38748 L s .07079 .38373 m .07079 .38748 L s .10562 .38373 m .10562 .38748 L s .17526 .38373 m .17526 .38748 L s .21009 .38373 m .21009 .38748 L s .24491 .38373 m .24491 .38748 L s .31455 .38373 m .31455 .38748 L s .34938 .38373 m .34938 .38748 L s .3842 .38373 m .3842 .38748 L s .45385 .38373 m .45385 .38748 L s .48867 .38373 m .48867 .38748 L s .52349 .38373 m .52349 .38748 L s .59314 .38373 m .59314 .38748 L s .62796 .38373 m .62796 .38748 L s .66278 .38373 m .66278 .38748 L s .73243 .38373 m .73243 .38748 L s .76725 .38373 m .76725 .38748 L s .80208 .38373 m .80208 .38748 L s .87172 .38373 m .87172 .38748 L s .90654 .38373 m .90654 .38748 L s .94137 .38373 m .94137 .38748 L s .25 Mabswid 0 .38373 m 1 .38373 L s .27973 .07398 m .28598 .07398 L s [(-0.8)] .26723 .07398 1 0 Mshowa .27973 .15142 m .28598 .15142 L s [(-0.6)] .26723 .15142 1 0 Mshowa .27973 .22885 m .28598 .22885 L s [(-0.4)] .26723 .22885 1 0 Mshowa .27973 .30629 m .28598 .30629 L s [(-0.2)] .26723 .30629 1 0 Mshowa .27973 .46117 m .28598 .46117 L s [(0.2)] .26723 .46117 1 0 Mshowa .27973 .5386 m .28598 .5386 L s [(0.4)] .26723 .5386 1 0 Mshowa .27973 .61604 m .28598 .61604 L s [(0.6)] .26723 .61604 1 0 Mshowa .125 Mabswid .27973 .0159 m .28348 .0159 L s .27973 .03526 m .28348 .03526 L s .27973 .05462 m .28348 .05462 L s .27973 .09334 m .28348 .09334 L s .27973 .1127 m .28348 .1127 L s .27973 .13206 m .28348 .13206 L s .27973 .17077 m .28348 .17077 L s .27973 .19013 m .28348 .19013 L s .27973 .20949 m .28348 .20949 L s .27973 .24821 m .28348 .24821 L s .27973 .26757 m .28348 .26757 L s .27973 .28693 m .28348 .28693 L s .27973 .32565 m .28348 .32565 L s .27973 .34501 m .28348 .34501 L s .27973 .36437 m .28348 .36437 L s .27973 .40309 m .28348 .40309 L s .27973 .42245 m .28348 .42245 L s .27973 .44181 m .28348 .44181 L s .27973 .48052 m .28348 .48052 L s .27973 .49988 m .28348 .49988 L s .27973 .51924 m .28348 .51924 L s .27973 .55796 m .28348 .55796 L s .27973 .57732 m .28348 .57732 L s .27973 .59668 m .28348 .59668 L s .25 Mabswid .27973 0 m .27973 .61803 L s 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath .5 Mabswid .02381 .01472 m .02554 .04328 L .02718 .05856 L .02867 .06946 L .03233 .09015 L .03581 .10559 L .05023 .151 L .06416 .18189 L .0771 .20498 L .10642 .24633 L .16365 .30455 L .22446 .35022 L .28306 .38557 L .33945 .4144 L .39942 .4411 L .45717 .46392 L .5127 .48376 L .57183 .50305 L .62873 .52014 L .68923 .53697 L .7475 .55208 L .80356 .56573 L .86321 .57941 L .92064 .59187 L .97585 .60325 L .97619 .60332 L s % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 177.938}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg00000c/h0cP3>c_[ZeT10@?XD@3cj=?oo051@n_l0o`3oolKFh^kF]XVI][jn_W61TEeMGB@T SG4LD10@A4A4aSP<:9e4LHTLH@2AoonA003o05D0ZZX005FAE@3oZZZAoj[o0?lTE@00oeGooj[oZ_nA Z_ooE@18EEE805E8ojY8ZP2A05GoE@2fEEFf05FfZZZfE@0TZUDTEJXTojY]0?m]o`2AZZX0EJ[oool0 0?l0Z_nAEOooZP3oEEE]ZUFAoeGo05GoZZY]EJZAZZZf0:[oEOnfo`00E@180018oeD005D0ojX0Z_m8 0?m8ZP1]E@2f002fZP2foeE8ZUE]05FfEEFfojY80:Y8EJZfZZZfoom8oonf0?nfEOnfZP00ZP0T000T E@0To`18ZP1]001]ZP1]o`2AE@3J003JE@3JZP3JoeD0EEDT05DTZUDToeE8EEE]EEE]oeFA05FAZUGJ 05GJEEGJZUGJojX0ojXT0:XTEJXTZZY8ojY]ZZY]ojZA0:ZAEJ[J0:[JEJ[JZZ[Jool0EOlT0?lTZ_lT oom8EOm]0?m]EOm]Z_nAoooJ0?oJEOoJZ_oJom[JfYVIVGemOO[jnZFUYK8`H@P82861POo29<;2`/hT 933><>;Rh/K6aP00kTB1]Z4PlXDl9YIFEUHf=L@00PFD00840042IYKZQY@0d?0210021PAQMIBamRH40PH6105DH ROooc^[Zj]:f]P00_W5aLFEUINkViWUYJFVf]P1E001EE@1EZP1Eo`2Z0?;VdP2ZE@2ZZP2ZoeEE05EE EGUUD5EEZUEEoeFZ05FZEEFZZUFZojYE0:YEEJYEZZYEojZZ0:ZZEJZZZZZZoomE0?mEEOmEZ_mEoonZ 0?nZEOnZZ_nZomkNg[jQONKVi_KfmXF5QL;Rh/k>cWEeMMQ30012@`0304=309=30012@`0304=309=3 0012@`0304=309=3000=@`0304=303930P2D@`003D<00`13@`0b@`0304=309=3000=@`0304=30393 00<0@d<0Td<000e300<0@d<0@`0304=3035300<0@d<0Td<000i300<0@d<0@`0304=3035300<0@d<0Td<000i300<0@d<0@`0304=302930P04@`0404=3@`<00T<209A3000>@`0304=3029300<0@`001d<00`130002@`03 04=309=3000?@`0304=301]31002@`0304<000M30P03@`0304=309=3000?@`0304=3025300<0@`00 1d<00`130002@`0304=309=3000?@`0304=302530P08@`800d<209A3000?@`0304=3031300<0@d<0 Td<0011300<0@d<0;d<00`13@`2C@`0044<00`13@`0_@`0304=309=3000@@`0304=302m30P2D@`00 4D<00`13@`0^@`0304=309=3000A@`0304=302i300<0@d<0Td<0015300<0@d<0;T<00`13@`2C@`00 4T<00`13@`0]@`80U4<0019300<0@d<0;D<00`13@`2C@`004T<00`13@`0]@`0304=309=3000C@`03 04=302a300<0@d<0Td<001=300<0@d<07D<200A300@0@d=30`02@`80U4<001=300<0@d<07D<00`13 0007@`0304<0009300<0@d<0Td<001A300<0@d<05T<4009300<0@`001d<200=300<0@d<0Td<001A3 00<0@d<074<00`130007@`0304=3009300<0@d<0Td<001A300<0@d<074<200U30P02@`80U4<001A3 00<0@d<0:d<00`13@`2C@`005D<00`13@`0Z@`0304=309=3000E@`0304=302Y300<0@d<0Td<001I3 00<0@d<0:D<209A3000F@`0304=302U300<0@d<0Td<001M300<0@d<0:4<00`13@`2C@`0064<00`13 @`0W@`0304=309=3000I@`0304=302I30P2D@`006D<00`13@`0V@`0304=309=3000J@`0304=302E3 00<0@d<0Td<001]300<0@d<094<00`13@`2C@`006d<00`13@`0E@`8014<00`13@`02@`800T<209A3 000L@`0304=301A300<0@`001T<4009300<0@d<0Td<001e300<0@d<03D<4009300<0@`001d<200=3 00<0@d<0Td<001e300<0@d<04d<00`130007@`800d<00`13@`2C@`007T<00`13@`0B@`802D<01013 @d<209A3000O@`0304=3021300<0@d<0Td<0021300<0@d<07d<00`13@`2C@`008D<00`13@`0N@`03 04=309=3000R@`0304=301e30P2D@`008d<00`13@`0L@`0304=309=3000T@`0304=301]300<0@d<0 Td<002E300<0@d<06T<00`13@`2C@`009T<00`13@`0I@`80U4<002M300<0@d<064<00`13@`2C@`00 :4<00`13@`0G@`0304=309=3000Y@`0304=300M30P04@`0304=300@00T<00`13@`2C@`00:T<00`13 @`06@`0304<000M300<0@d<00T<209A3000[@`H00T<00`130008@`800T<00`13@`2C@`00;D<00`13 @`03@`0304<000U300@0@d<0UD<002i30P03@`8024<200=300<0@d<0Td<0031300<0@d<03d<209A3 000a@`0304=300i300<0@d<0Td<003930P0>@`0304=309=3000d@`0304=300]300<0@d<0Td<003E3 0P0;@`80U4<003M300<0@d<024<00`13@`2C@`001T<200A300<0@d<00T<200m30P04@`0304=300@0 2D<200Q300<0@d<054<200A300<0@d<0100@@`8014<00`13@`02@`803d<200A300@0@d=30`0@@`80 14<01013@d<301A30`05@`001T<00`130006@`@03d<00`130007@`0304=300]300<0@d<01D<00`13 @`0D@`0304<000M300<0@d<044<00`130006@`@03d<00`130007@`0304<0011300<0@`001d<00`13 000E@`0304=300A30004009300<0@`001d<200Y31002@`0304<000Q30P0<@`801D<201E300<0@`00 24<2011300<0@`001d<2011300<0@`001d<2015300<0@`001d<201I300<0@d<014<000I300<0@`00 1d<2011300<0@`002D<00`13@`0<@`0304=3009300<0@d<054<00`130009@`0304=300i300<0@`00 1d<2011300<0@`001d<00`13@`0@@`0304<000M300<0@`005D<00`13@`04@`001T<200U300<0@d<0 3T<200Q30P0@@`800T<00`13@`0D@`8024<201530P09@`0304=300i30P09@`8044<200Q30P0E@`80 1T<0041300<0@`00UD<000Q3d00000U300<0@d<014<00`13@`04@`0304=300A300<0@d<014<00`13 @`04@`0304=300E300<0@d<014<00`13@`04@`801D<00`13@`04@`0304=300E300<0@d<014<00`13 @`04@`0304=300A300<0@d<014<00`13@`04@`0304=300E300<0@d<014<00`13@`04@`0304=300A3 00<0@d<014<00`13@`04@`0304=300E300<0@d<014<00`13@`04@`0304=300A300<0@d<014<00`13 @`05@`0304=300=30012@`0404<009930012@`0404=3@`80T4<004930P04@`80ST<0049300<0@d<0 1D<208a30012@`0304=300M30P2:@`00@T<00`13@`09@`80R4<004930P0<@`80QT<0049300<0@d<0 3D<308=30012@`0304=301130`20@`00@T<00`13@`0C@`80OT<004930P0F@`<0Nd<0049300<0@d<0 64<207U30012@`0304=301Y30P1g@`00"], ImageRangeCache->{{{0, 215}, {132.438, 0}} -> {-0.462663, -1.00367, 0.00522159, 0.0093924}}], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.97619 2.59179 0.603319 0.0609069 [ [.06907 .59082 -15 -9 ] [.06907 .59082 15 0 ] [.19865 .59082 -12 -9 ] [.19865 .59082 12 0 ] [.32824 .59082 -15 -9 ] [.32824 .59082 15 0 ] [.45783 .59082 -12 -9 ] [.45783 .59082 12 0 ] [.58742 .59082 -15 -9 ] [.58742 .59082 15 0 ] [.71701 .59082 -12 -9 ] [.71701 .59082 12 0 ] [.8466 .59082 -15 -9 ] [.8466 .59082 15 0 ] [.96369 .11606 -12 -4.5 ] [.96369 .11606 0 4.5 ] [.96369 .23788 -12 -4.5 ] [.96369 .23788 0 4.5 ] [.96369 .35969 -12 -4.5 ] [.96369 .35969 0 4.5 ] [.96369 .48151 -12 -4.5 ] [.96369 .48151 0 4.5 ] [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 g .25 Mabswid [ ] 0 setdash .06907 .60332 m .06907 .60957 L s [(-0.35)] .06907 .59082 0 1 Mshowa .19865 .60332 m .19865 .60957 L s [(-0.3)] .19865 .59082 0 1 Mshowa .32824 .60332 m .32824 .60957 L s [(-0.25)] .32824 .59082 0 1 Mshowa .45783 .60332 m .45783 .60957 L s [(-0.2)] .45783 .59082 0 1 Mshowa .58742 .60332 m .58742 .60957 L s [(-0.15)] .58742 .59082 0 1 Mshowa .71701 .60332 m .71701 .60957 L s [(-0.1)] .71701 .59082 0 1 Mshowa .8466 .60332 m .8466 .60957 L s [(-0.05)] .8466 .59082 0 1 Mshowa .125 Mabswid .09498 .60332 m .09498 .60707 L s .1209 .60332 m .1209 .60707 L s .14682 .60332 m .14682 .60707 L s .17274 .60332 m .17274 .60707 L s .22457 .60332 m .22457 .60707 L s .25049 .60332 m .25049 .60707 L s .27641 .60332 m .27641 .60707 L s .30233 .60332 m .30233 .60707 L s .35416 .60332 m .35416 .60707 L s .38008 .60332 m .38008 .60707 L s .406 .60332 m .406 .60707 L s .43192 .60332 m .43192 .60707 L s .48375 .60332 m .48375 .60707 L s .50967 .60332 m .50967 .60707 L s .53559 .60332 m .53559 .60707 L s .5615 .60332 m .5615 .60707 L s .61334 .60332 m .61334 .60707 L s .63926 .60332 m .63926 .60707 L s .66518 .60332 m .66518 .60707 L s .69109 .60332 m .69109 .60707 L s .74293 .60332 m .74293 .60707 L s .76885 .60332 m .76885 .60707 L s .79477 .60332 m .79477 .60707 L s .82068 .60332 m .82068 .60707 L s .87252 .60332 m .87252 .60707 L s .89844 .60332 m .89844 .60707 L s .92435 .60332 m .92435 .60707 L s .95027 .60332 m .95027 .60707 L s .04315 .60332 m .04315 .60707 L s .01723 .60332 m .01723 .60707 L s .25 Mabswid 0 .60332 m 1 .60332 L s .97619 .11606 m .98244 .11606 L s [(-8)] .96369 .11606 1 0 Mshowa .97619 .23788 m .98244 .23788 L s [(-6)] .96369 .23788 1 0 Mshowa .97619 .35969 m .98244 .35969 L s [(-4)] .96369 .35969 1 0 Mshowa .97619 .48151 m .98244 .48151 L s [(-2)] .96369 .48151 1 0 Mshowa .125 Mabswid .97619 .0247 m .97994 .0247 L s .97619 .05516 m .97994 .05516 L s .97619 .08561 m .97994 .08561 L s .97619 .14652 m .97994 .14652 L s .97619 .17697 m .97994 .17697 L s .97619 .20742 m .97994 .20742 L s .97619 .26833 m .97994 .26833 L s .97619 .29878 m .97994 .29878 L s .97619 .32924 m .97994 .32924 L s .97619 .39014 m .97994 .39014 L s .97619 .4206 m .97994 .4206 L s .97619 .45105 m .97994 .45105 L s .97619 .51196 m .97994 .51196 L s .97619 .54241 m .97994 .54241 L s .97619 .57287 m .97994 .57287 L s .25 Mabswid .97619 0 m .97619 .61803 L s 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath .5 Mabswid .02381 .53946 m .03026 .53442 L .03634 .53149 L .04191 .52929 L .06846 .52127 L .12214 .50919 L .33122 .47165 L .44329 .45125 L .54734 .43008 L .65438 .40407 L .75522 .37211 L .80887 .34949 L .8371 .33481 L .86692 .31599 L .89206 .29596 L .90538 .28293 L .91966 .26609 L .93279 .24657 L .94476 .22302 L .95052 .20838 L .95679 .1883 L .96271 .16244 L .96819 .12581 L .9746 .01472 L s % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 177.938}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg00000c/h0cP3>c_[ZeT10@?XD@3cj=?oo051@n_l0o`3oolKFh^kF]XVI][jn_W61TEeMGB@T SG4LD10@A4A4aSP<:9e4LHTLH@2AoonA003o05D0ZZX005FAE@3oZZZAoj[o0?lTE@00oeGooj[oZ_nA Z_ooE@18EEE805E8ojY8ZP2A05GoE@2fEEFf05FfZZZfE@0TZUDTEJXTojY]0?m]o`2AZZX0EJ[oool0 0?l0Z_nAEOooZP3oEEE]ZUFAoeGo05GoZZY]EJZAZZZf0:[oEOnfo`00E@180018oeD005D0ojX0Z_m8 0?m8ZP1]E@2f002fZP2foeE8ZUE]05FfEEFfojY80:Y8EJZfZZZfoom8oonf0?nfEOnfZP00ZP0T000T E@0To`18ZP1]001]ZP1]o`2AE@3J003JE@3JZP3JoeD0EEDT05DTZUDToeE8EEE]EEE]oeFA05FAZUGJ 05GJEEGJZUGJojX0ojXT0:XTEJXTZZY8ojY]ZZY]ojZA0:ZAEJ[J0:[JEJ[JZZ[Jool0EOlT0?lTZ_lT oom8EOm]0?m]EOm]Z_nAoooJ0?oJEOoJZ_oJom[JfYVIVGemOO[jnZFUYK8`H@P82861POo29<;2`/hT 933><>;Rh/K6aP00kTB1]Z4PlXDl9YIFEUHf=L@00PFD00840042IYKZQY@0d?0210021PAQMIBamRH40PH6105DH ROooc^[Zj]:f]P00_W5aLFEUINkViWUYJFVf]P1E001EE@1EZP1Eo`2Z0?;VdP2ZE@2ZZP2ZoeEE05EE EGUUD5EEZUEEoeFZ05FZEEFZZUFZojYE0:YEEJYEZZYEojZZ0:ZZEJZZZZZZoomE0?mEEOmEZ_mEoonZ 0?nZEOnZZ_nZomkNg[jQONKVi_KfmXF5QL;Rh/k>cWEeMM5300<0@d<014<00=5300<0@d<014<00=53 00<0@d<014<00=5300<0@d<014<00=5300<0@d<014<00=530P05@`00dD<00`13@`04@`00dD<00`13 @`04@`00dD<00`13@`04@`00dD<00`13@`04@`00d4<200I3003@@`801T<00=130`05@`00d4<200I3 003@@`801T<00=130P06@`00d4<200I3003@@`801T<00=130`05@`00d4<200I3003@@`801T<00=13 0P06@`00cd<00`130006@`00cd<00`130006@`00bd<30004@`1300I3003;@`0604<0@`130P05@`00 aD<400930P02@`0304<000I3003;@`0704<0@`130006@`00bd<2009300<0@`001T<00T<200E3002A@`<0?D<00`13 @`04@`00ST<3041300<0@d<014<008Y31013@`0304=300A30026@`@0Ad<00`13@`04@`00PD<504]3 00<0@d<014<007a31@1@@`801D<007Q3101E@`0304=300A3001c@`D0FD<00`13@`04@`00Kd<405i3 00<0@d<014<006Y31@1R@`0304=300A3001V@`@0Id<00`13@`04@`00HT<406]300<0@d<014<005a3 1P1_@`801D<005I31P1e@`0304=300A3001@@`H0Nd<00`13@`04@`00BT<6085300<0@d<014<004E3 1@27@`0304=300A3000o@`H0QD<400=300<0@d<014<003U31P2<@`0304=300=30P05@`00=4<508a3 1003@`800d<00`13@`04@`00;T<609U300D0@d=30006@`00:D<509e30P04@`0304=300A3000S@`H0 Z4<00`13@`04@`007D<60:i300<0@d<014<001U3102d@`0304=300A3000E@`@0^4<200E3000A@`@0 _4<00`13@`04@`0034<50<1300<0@d<014<000U30`35@`0304=300A30007@`80b4<00`13@`04@`00 1T<00`13@`38@`0304=300A30005@`0304=30@`8014<00`13@`0400930`0<@`8014<00`13@`0400a30P04@`04 04=3@`<00T<300e30P04@`0404=3@`<034<200A300@0@d=30P03@`<03d<200E30009@`0304<000U3 00<0@d<00T<00`13@`0:@`0304<000U300<0@d<02d<00`130007@`0304=300A300<0@d<02T<00`13 0007@`0304=300a300<0@`0024<00`13@`03@`0304=300]300<0@`0024<00`13@`0;@`0304<000M3 00<0@`0014<00`13@`0=@`0304=300A30003@`@00T<00`130008@`800T<300I31002@`0304<000Q3 0P07@`@00T<00`130008@`800T<300I31002@`0304<000Q30P06@`@00T<00`130008@`0404=3@`<0 1d<4009300<0@`0024<00`13@`05@`@00T<00`130007@`0304<000930`0?@`0304=300A30009@`03 04<000Q300D0@d=3000>@`0304<000Q300<0@d<034<00`130009@`0404=300i300<0@`002D<00`13 @`0:@`0304<000Q300D0@d=3000?@`0304<000Q300<0@d<02d<00`130007@`0304<0009300<0@d<0 3d<00`13@`04@`002D<200Q30P03@`803D<200Q30P0>@`8024<200=30P0=@`8024<200e30P08@`80 0d<200i30P08@`803D<200Q30P03@`8044<00`13@`04@`00dD<00`13@`04@`00e`01@`0014<00`13 @`02@`0304=300=300<0@d<00T<00`13@`03@`0304=3009300<0@d<00d<00`13@`02@`0304=300=3 00<0@d<00d<00`13@`02@`0304=300=300<0@d<00T<00`13@`03@`0304=3009300<0@d<00d<00`13 @`02@`0304=300=300<0@d<00d<00`13@`02@`0304=300=300<0@d<00T<00`13@`03@`0304=30093 00<0@d<00d<00`13@`02@`0304=300=300<0@d<00d<00`13@`02@`0304=300=300<0@d<00T<00`13 @`03@`0304=3009300<0@d<00d<00`13@`02@`0304=300=300<0@d<00T<00`13@`03@`0304=300A3 000?@`0304=301Q300<0@d<06D<00`13@`0I@`0304=301U300<0@d<06D<00`13@`0H@`0304=301U3 00<0@d<014<00=5300<0@d<014<00001\ \>"], ImageRangeCache->{{{0, 215}, {132.438, 0}} -> {-0.377288, -9.90564, 0.00135041, 0.0574642}}] }, Open ]] }, Open ]], Cell["\<\ Warning messages (which I supressed) and the plots themselves \ indicate where each branch runs into trouble.\ \>", "Text"], Cell["\<\ We now redo this numerically, and later we will compare \ results.\ \>", "Text"], Cell[BoxData[{ \(invert[m_] := FindRoot[#1 == \(1 - x - \[ExponentialE]\^\(m\ x\)\)\/x, {x, .7}]&\), \(v[m_] := \(1 - b - \[ExponentialE]\^\(m\ b\)\)\/b\)}], "Input"], Cell["\<\ Now let's try to see what might be a reasonable value to \ invert.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\(\(Plot[v[3. ], \ {b, .1, \ 1}]; \)\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \)\)], "Input"], Cell[GraphicsData["PostScript", "\<\ %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart /Mabs { Mgmatrix idtransform Mtmatrix dtransform } bind def /Mabsadd { Mabs 3 -1 roll add 3 1 roll add exch } bind def %% Graphics %%IncludeResource: font Courier %%IncludeFont: Courier /Courier findfont 10 scalefont setfont % Scaling calculations 0.0238095 0.952381 0.773197 0.0377626 [ [.21429 .57188 -9 -9 ] [.21429 .57188 9 0 ] [.40476 .57188 -9 -9 ] [.40476 .57188 9 0 ] [.59524 .57188 -9 -9 ] [.59524 .57188 9 0 ] [.78571 .57188 -9 -9 ] [.78571 .57188 9 0 ] [.97619 .57188 -3 -9 ] [.97619 .57188 3 0 ] [.01131 .01795 -18 -4.5 ] [.01131 .01795 0 4.5 ] [.01131 .11235 -30 -4.5 ] [.01131 .11235 0 4.5 ] [.01131 .20676 -18 -4.5 ] [.01131 .20676 0 4.5 ] [.01131 .30116 -30 -4.5 ] [.01131 .30116 0 4.5 ] [.01131 .39557 -18 -4.5 ] [.01131 .39557 0 4.5 ] [.01131 .48998 -24 -4.5 ] [.01131 .48998 0 4.5 ] [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath 0 g .25 Mabswid [ ] 0 setdash .21429 .58438 m .21429 .59063 L s [(0.2)] .21429 .57188 0 1 Mshowa .40476 .58438 m .40476 .59063 L s [(0.4)] .40476 .57188 0 1 Mshowa .59524 .58438 m .59524 .59063 L s [(0.6)] .59524 .57188 0 1 Mshowa .78571 .58438 m .78571 .59063 L s [(0.8)] .78571 .57188 0 1 Mshowa .97619 .58438 m .97619 .59063 L s [(1)] .97619 .57188 0 1 Mshowa .125 Mabswid .07143 .58438 m .07143 .58813 L s .11905 .58438 m .11905 .58813 L s .16667 .58438 m .16667 .58813 L s .2619 .58438 m .2619 .58813 L s .30952 .58438 m .30952 .58813 L s .35714 .58438 m .35714 .58813 L s .45238 .58438 m .45238 .58813 L s .5 .58438 m .5 .58813 L s .54762 .58438 m .54762 .58813 L s .64286 .58438 m .64286 .58813 L s .69048 .58438 m .69048 .58813 L s .7381 .58438 m .7381 .58813 L s .83333 .58438 m .83333 .58813 L s .88095 .58438 m .88095 .58813 L s .92857 .58438 m .92857 .58813 L s .25 Mabswid 0 .58438 m 1 .58438 L s .02381 .01795 m .03006 .01795 L s [(-20)] .01131 .01795 1 0 Mshowa .02381 .11235 m .03006 .11235 L s [(-17.5)] .01131 .11235 1 0 Mshowa .02381 .20676 m .03006 .20676 L s [(-15)] .01131 .20676 1 0 Mshowa .02381 .30116 m .03006 .30116 L s [(-12.5)] .01131 .30116 1 0 Mshowa .02381 .39557 m .03006 .39557 L s [(-10)] .01131 .39557 1 0 Mshowa .02381 .48998 m .03006 .48998 L s [(-7.5)] .01131 .48998 1 0 Mshowa .125 Mabswid .02381 .03683 m .02756 .03683 L s .02381 .05571 m .02756 .05571 L s .02381 .07459 m .02756 .07459 L s .02381 .09347 m .02756 .09347 L s .02381 .13123 m .02756 .13123 L s .02381 .15011 m .02756 .15011 L s .02381 .169 m .02756 .169 L s .02381 .18788 m .02756 .18788 L s .02381 .22564 m .02756 .22564 L s .02381 .24452 m .02756 .24452 L s .02381 .2634 m .02756 .2634 L s .02381 .28228 m .02756 .28228 L s .02381 .32005 m .02756 .32005 L s .02381 .33893 m .02756 .33893 L s .02381 .35781 m .02756 .35781 L s .02381 .37669 m .02756 .37669 L s .02381 .41445 m .02756 .41445 L s .02381 .43333 m .02756 .43333 L s .02381 .45222 m .02756 .45222 L s .02381 .4711 m .02756 .4711 L s .02381 .50886 m .02756 .50886 L s .02381 .52774 m .02756 .52774 L s .02381 .54662 m .02756 .54662 L s .02381 .5655 m .02756 .5655 L s .02381 .60327 m .02756 .60327 L s .25 Mabswid .02381 0 m .02381 .61803 L s 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath .5 Mabswid .11905 .60332 m .15382 .59543 L .19174 .58612 L .22736 .57664 L .26161 .5668 L .29806 .55547 L .33316 .54364 L .37046 .53001 L .4064 .51573 L .44097 .50083 L .47775 .48363 L .51316 .46561 L .54722 .44682 L .58347 .42508 L .61837 .40233 L .65547 .37596 L .69121 .34825 L .72558 .31925 L .76216 .28561 L .79738 .25026 L .8348 .2092 L .87086 .16589 L .90556 .1204 L .94246 .06751 L .97619 .01472 L s % End of Graphics MathPictureEnd \ \>"], "Graphics", ImageSize->{288, 177.938}, ImageMargins->{{43, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, ImageCache->GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg00000c/h0cP3>c_[ZeT10@?XD@3cj=?oo051@n_l0o`3oolKFh^kF]XVI][jn_W61TEeMGB@T SG4LD10@A4A4aSP<:9e4LHTLH@2AoonA003o05D0ZZX005FAE@3oZZZAoj[o0?lTE@00oeGooj[oZ_nA Z_ooE@18EEE805E8ojY8ZP2A05GoE@2fEEFf05FfZZZfE@0TZUDTEJXTojY]0?m]o`2AZZX0EJ[oool0 0?l0Z_nAEOooZP3oEEE]ZUFAoeGo05GoZZY]EJZAZZZf0:[oEOnfo`00E@180018oeD005D0ojX0Z_m8 0?m8ZP1]E@2f002fZP2foeE8ZUE]05FfEEFfojY80:Y8EJZfZZZfoom8oonf0?nfEOnfZP00ZP0T000T E@0To`18ZP1]001]ZP1]o`2AE@3J003JE@3JZP3JoeD0EEDT05DTZUDToeE8EEE]EEE]oeFA05FAZUGJ 05GJEEGJZUGJojX0ojXT0:XTEJXTZZY8ojY]ZZY]ojZA0:ZAEJ[J0:[JEJ[JZZ[Jool0EOlT0?lTZ_lT oom8EOm]0?m]EOm]Z_nAoooJ0?oJEOoJZ_oJom[JfYVIVGemOO[jnZFUYK8`H@P82861POo29<;2`/hT 933><>;Rh/K6aP00kTB1]Z4PlXDl9YIFEUHf=L@00PFD00840042IYKZQY@0d?0210021PAQMIBamRH40PH6105DH ROooc^[Zj]:f]P00_W5aLFEUINkViWUYJFVf]P1E001EE@1EZP1Eo`2Z0?;VdP2ZE@2ZZP2ZoeEE05EE EGUUD5EEZUEEoeFZ05FZEEFZZUFZojYE0:YEEJYEZZYEojZZ0:ZZEJZZZZZZoomE0?mEEOmEZ_mEoonZ 0?nZEOnZZ_nZomkNg[jQONKVi_KfmXF5QL;Rh/k>cWEeMMQ3003H@`00f4<00=Q3003H@`00f4<001Q3 00<0@d<0_D<001Q300<0@d<0_D<001Q300<0@d<0_D<000i31002@`800T<00`13@`2g@`0304=300=3 000?@`0304=3009300@0@`130`2f@`0304=300A30009@`@00d<2009300D0@`13002h@`0304=300A3 000A@`0804=304<0@`2g@`0304=300E3000?@`800d<200930P2e@`0304=300I3000H@`0304=30;A3 00<0@d<01T<001Q300<0@d<0/d<00`13@`07@`0064<00`13@`2b@`0304=300Q3000H@`80/T<00`13 @`09@`0064<00`13@`2a@`0304=300U3000H@`0304=30;1300<0@d<02T<001Q300<0@d<0[d<00`13 @`0;@`0064<20;1300<0@d<02d<001Q300<0@d<0[T<00`13@`0<@`0064<00`13@`2]@`0304=300e3 000H@`80[T<00`13@`0=@`0064<00`13@`2/@`0304=300i3000H@`0304=30:a300<0@d<03T<000I3 0`03@`0304=3009300@0@d=3102]@`0304=300m30007@`0304=3009300<0@d<024<40:Y300<0@d<0 44<000@00d<00`13@`02@`0304=300I3102/@`0304=301130007@`0304=300=300<0@d<01D<01013 @`2[@`0304=301530006@`800T<400M30P000d<0@`2Y@`0304=30193000H@`80Z4<00`13@`0C@`00 64<00`13@`2V@`0304=301A3000H@`0304=30:I300<0@d<054<001Q30P2V@`0304=301E3000H@`03 04=30:A300<0@d<05T<001Q300<0@d<0Xd<00`13@`0G@`0064<00`13@`2R@`0304=301Q3000H@`80 XT<00`13@`0I@`0064<00`13@`2P@`0304=301Y3000H@`0304=30:1300<0@d<06T<001Q300<0@d<0 Wd<00`13@`0K@`0064<209m300<0@d<074<001Q300<0@d<0WD<00`13@`0M@`0064<00`13@`2M@`03 04=301e3000?@`<00T<30004@`0009a300<0@d<07T<0011300<0@d<00d<00`13002M@`0304=301m3 0009@`@00d<01013@d<30003@`1309]300<0@d<084<0011300D0@d=30003@`0304=309U300<0@d<0 8D<000m30P03@`800T<209U300<0@d<08T<001Q300<0@d<0V4<00`13@`0R@`0064<00`13@`2G@`03 04=302=3000H@`0304=309I300<0@d<094<001Q30P2F@`0304=302E3000H@`0304=309A300<0@d<0 9T<001Q300<0@d<0Td<00`13@`0W@`0064<209=300<0@d<0:4<001Q300<0@d<0TD<00`13@`0Y@`00 64<00`13@`2@@`0304=302Y3000H@`0304=308m300<0@d<0:d<001Q30P2?@`0304=302a3000H@`03 04=308e300<0@d<0;D<001Q300<0@d<0S4<00`13@`0^@`001T<30003@`0000800d<01013@d<408e3 00<0@d<0;d<000M300D0@d=3000;@`@0RD<20393000400=300<0@d<00T<200M3102:@`0304=30393 0007@`0304=300=300<0@d<01D<01013@`29@`0304=303=30006@`800d<200Q30P000d<00027@`03 04=303A3000H@`0304=308E300<0@d<0=D<001Q300<0@d<0Q4<00`13@`0f@`0064<00`13@`22@`80 >D<001Q30P22@`0304=303U3000H@`0304=3081300<0@d<0>T<001Q300<0@d<0Od<00`13@`0k@`00 64<00`13@`1m@`80?T<001Q30P1m@`0304=303i3000H@`0304=307]300<0@d<0?d<001Q300<0@d<0 ND<20493000H@`80ND<00`13@`12@`0064<00`13@`1f@`80AD<001Q300<0@d<0MD<00`13@`15@`00 3d<300930P02@`0304=307A300<0@d<0AT<0011300P0@d=304<0@`<0LT<204U30009@`@00d<02@13 @d<0@`13001c@`0304=304U3000@@`0904=3@`1304<007530P1<@`003d<200=30P02@`0304=306i3 00<0@d<0C4<001Q30P1^@`0304=304e3000H@`0304=306]30P1@@`0064<00`13@`1Z@`0304=30513 000H@`80JD<205=3000H@`0304=306I30P1E@`0064<00`13@`1T@`80Ed<001Q300<0@d<0Hd<00`13 @`1G@`0064<206930P1J@`0064<00`13@`1P@`0304=305Y3000H@`0304=305i30P1M@`0064<00`13 @`1L@`80Gd<001Q30P1K@`80HD<001Q300<0@d<0F4<206=3000H@`0304=305I30P1U@`002d<00`13 @`02@`0404=3@`<000=304<0ED<206M3000;@`0304=300Q300<0@`000P1B@`80JD<000A31003@`03 04=300I30`000d<0@`1A@`80Jd<000a300<0@d<01D<01@13@d<005130P1]@`002D<400M30P02@`80 CD<206m3000H@`0304=304Y30P1a@`0064<00`13@`17@`<0Ld<001Q300<0@d<0@d<407I3000H@`80 @D<307Y3000H@`0304=303i30P1m@`0064<00`13@`0l@`80Od<001Q300<0@d<0>D<30853000H@`80 =T<408A3000H@`0304=301e30P04@`0304=300@024<300e30P04@`0304=300930P0H@`8014<01013 @d<301Q30P04@`0404=3@`<07D<300A3000H@`0304=301e300<0@`001d<00`13@`04@`@044<00`13 0006@`@064<00`130007@`0304<001Q300<0@`001d<00`13000N@`0304=300=3000H@`807T<00`13 0008@`8000A3000054<00`130007@`806D<00`130007@`806D<00`130007@`807d<00`13@`03@`00 64<00`13@`0M@`0304<000M3100G@`0304<000M30P0I@`0304<000M300<0@d<064<00`130007@`03 04<001i300<0@d<00d<001Q300<0@d<07D<200E31@0I@`802D<00`13@`0G@`802D<201Q30P08@`80 7T<200E3000H@`0304=30213102I@`0054?4000064<00`13@`07@`0304=300I300<0@d<01T<400I3 00<0@d<01T<00`13@`06@`0304=300I300<0@d<01d<00`13@`06@`0304=300I300<0@d<01T<00`13 @`07@`0304=300I300<0@d<01T<00`13@`07@`0304=300I300<0@d<01T<00`13@`06@`0304=300M3 00<0@d<01T<00`13@`03@`0064<00`13@`0F@`<0Y4<001Q300<0@d<04T<40:M3000H@`804D<20:]3 000H@`0304=30;e3000H@`0304=30;e3003H@`00f4<00=Q3003H@`00f4<00=Q30000\ \>"], ImageRangeCache->{{{0, 215}, {132.438, 0}} -> {-0.13447, -21.2985, 0.00404468, 0.102008}}] }, Open ]], Cell[TextData[{ "A look at the plot reveals that in the relevant range ", StyleBox["0 3. , \ vv -> \(-10. \)}\)], "Input"], Cell[BoxData[ \({{b \[Rule] 0.`}}\)], "Output"] }, Open ]], Cell[TextData[{ "Not even close. We will change the ", StyleBox["Solve", "InputWord"], " result by hand, using the minus one (rather than default, zero) branch of \ ", StyleBox["ProductLog", "InputWord"], ", and see if this helps." }], "Text"], Cell[BoxData[ \(\(inv2 = { b \[Rule] \(m\/\(1 + vv\) - ProductLog[\(-1\), \(\[ExponentialE]\^\(m\/\(1 + vv\)\)\ m\)\/\(1 + vv\)]\)\/m}; \)\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ \(inv2\ /. \ \ {m -> 3. , \ vv -> \(-10. \)}\)], "Input"], Cell[BoxData[ \({b \[Rule] 0.6346045648134612`}\)], "Output"] }, Open ]], Cell[TextData[{ "So the branch used by ", StyleBox["Solve", "InputWord"], " was not the one we really wanted after all. Really it was just luck (good \ or bad is for you to determine) that ", StyleBox["Solve", "InputWord"], " could give a result at all. The root-finding method seems to be the \ better way to go for this sort of problem." }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell[TextData[StyleBox["example (iv)", FontFamily->"Courier"]], "Subsection", FormatType->TextForm], Cell["\<\ Frequently one has a system of polynomial equations with finitely \ many solutions. In such cases it is often most efficient to use NSolve rather \ than Solve. Below are some examples from our tests.\ \>", "Text", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[{ \(polys = {15\ b\^2\ c\ d\^2 + 6\ b\^2\ c\^3 + 21\ b\^2\ c\^2\ d - 144\ b\ c - 8\ b\ c\^2\ e - 28\ b\ c\ d\ e - 648\ b\ d + b\ d\^2\ e + 9\ b\^2\ d\^3 - 120, 30\ b\^2\ c\^3\ d - 32\ c\ d\ e\^2 - 720\ b\ c\ d - 24\ b\ c\^3\ e - 432\ b\ c\^2 + 576\ c\ e - 576\ d\ e + 16\ b\ c\ d\^2\ e + 16\ d\^2\ e\^2 + 16\ c\^2\ e\^2 + 9\ b\^2\ c\^4 + 5184 + 39\ b\^2\ c\^2\ d\^2 + 18\ b\^2\ c\ d\^3 - 432\ b\ d\^2 + 24\ b\ d\^3\ e - 16\ b\ c\^2\ d\ e - 240\ c, 216\ b\ c\ d - 162\ b\ d\^2 - 81\ b\ c\^2 + 5184 + 1008\ c\ e - 1008\ d\ e + 15\ b\ c\^2\ d\ e - 15\ b\ c\^3\ e - 80\ c\ d\ e\^2 + 40\ d\^2\ e\^2 + 40\ c\^2\ e\^2, 261 + 4\ b\ c\ d - 3\ b\ d\^2 - 4\ b\ c\^2 + 22\ c\ e - 22\ d\ e}; \), "\n", \(vars = {b, c, d, e}; \), "\n", \(Timing[ solns200 = NSolve[polys == 0, vars, WorkingPrecision \[Rule] 200]; ]\)}], "Input"], Cell[BoxData[ \({5.58`\ Second, Null}\)], "Output"] }, Open ]], Cell["Now we check that the residuals are small.", "Rule", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[ \(Apply[Plus, Abs[polys /. solns200]]\)], "Input"], Cell[BoxData[ \({5.0991387187`0*^-57, 4.176704649`0*^-53, 9.9568244445782`0*^-59, 6.223015277861`0*^-60}\)], "Output"] }, Open ]], Cell[TextData[{ "One can also eliminate variables with ", StyleBox["NSolve", FontWeight->"Bold"], ", for example to find intersection points. In the example below we have to \ algebraically parametrized curves and we use ", StyleBox["NSolve", FontWeight->"Bold"], " to obtain their intersections." }], "Rule", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[{ \(c1 = {x - \@\(t\^2 - 1\), y - \((t\^3 + t - 4)\)}; \), "\n", \(c2 = {x - \((s\^2 + s + 5)\), y - \@\(s\^2 + 7\ s - 2\)}; \), "\n", \(NSolve[Join[c1, c2], {x, y}, {s, t}]\)}], "Input"], Cell[BoxData[ \({{x \[Rule] \(\(0.5500091249037548`\)\(\[InvisibleSpace]\)\) + 2.1831233203797757`\ \[ImaginaryI], y \[Rule] \(\(2.2150420611596204`\)\(\[InvisibleSpace]\)\) + 3.355223818035166`\ \[ImaginaryI]}, {x \[Rule] \ \(\(0.5500091249037548`\)\(\[InvisibleSpace]\)\) - 2.1831233203797757`\ \[ImaginaryI], y \[Rule] \(\(2.2150420611596204`\)\(\[InvisibleSpace]\)\) - 3.355223818035166`\ \[ImaginaryI]}, {x \[Rule] \ \(\(0.9806964263308998`\)\(\[InvisibleSpace]\)\) - 1.750564651967536`\ \[ImaginaryI], y \[Rule] \(\(1.38346920757478`\)\(\[InvisibleSpace]\)\) + 3.6839499400113582`\ \[ImaginaryI]}, {x \[Rule] \ \(\(0.9806964263308998`\)\(\[InvisibleSpace]\)\) + 1.750564651967536`\ \[ImaginaryI], y \[Rule] \(\(1.38346920757478`\)\(\[InvisibleSpace]\)\) - 3.6839499400113582`\ \[ImaginaryI]}, {x \[Rule] \ \(\(1.367178420360089`\)\(\[InvisibleSpace]\)\) + 0.436221860306329`\ \[ImaginaryI], y \[Rule] \(\(1.7374806309025765`\)\(\[InvisibleSpace]\)\) + 3.30780977574096`\ \[ImaginaryI]}, {x \[Rule] \ \(\(1.367178420360089`\)\(\[InvisibleSpace]\)\) - 0.436221860306329`\ \[ImaginaryI], y \[Rule] \(\(1.7374806309025765`\)\(\[InvisibleSpace]\)\) - 3.30780977574096`\ \[ImaginaryI]}}\)], "Output"] }, Open ]], Cell["\<\ One can see that all intersections are complex-valued for this \ example.\ \>", "Rule", FormatType->TextForm] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Comparison of methods for solving linear systems", "Section"], Cell[TextData[{ "Much of this section may be found in the further examples of the on-line \ documentation. All the same perhaps it bears repeating in a basic notebook \ about equation solving in ", StyleBox["Mathematica", FontSlant->"Italic"], "." }], "Text"], Cell[TextData[{ "Here is a simple ", StyleBox["LinearSolve", "InputWord"], " example." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(LinearSolve[{{1, 2}, {1, 3}}, {5, 8}]\)], "Input"], Cell[BoxData[ \({\(-1\), 3}\)], "Output"] }, Open ]], Cell[TextData[{ "You can also use ", StyleBox["Solve", "InputWord"], " on the system." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[{x + 2\ y \[Equal] 5, x + 3\ y \[Equal] 8}, {x, y}]\)], "Input"], Cell[BoxData[ \({{x \[Rule] \(-1\), y \[Rule] 3}}\)], "Output"] }, Open ]], Cell[TextData[{ "You get a similar result from ", StyleBox["RowReduce", "InputWord"], " by creating an augmented matrix. Interpret the result by noting that the \ first column corresponds to the \[IndentingNewLine]variable x and the second \ to the variable y; the solution is in the last \[IndentingNewLine]column." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(RowReduce[{{1, 2, 5}, {1, 3, 8}}]\)], "Input"], Cell[BoxData[ \({{1, 0, \(-1\)}, {0, 1, 3}}\)], "Output"] }, Open ]], Cell[TextData[{ "For underdetermined systems ", StyleBox["Solve", "InputWord"], " turns the excess variables into \"\[IndentingNewLine]parameters\" and \ gives general solutions in terms of those parameters." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[{x + 3\ y + z \[Equal] 1, 2\ x + y - 5\ z \[Equal] \(-2\)}, {x, y, z}]\)], "Input"], Cell[BoxData[ \(Solve::"svars" \( : \ \) "Equations may not give solutions for all \"solve\" variables."\)], "Message"], Cell[BoxData[ \({{x \[Rule] \(-\(7\/5\)\) + \(16\ z\)\/5, y \[Rule] 4\/5 - \(7\ z\)\/5}} \)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["LinearSolve", "InputWord"], ", on the other hand, gives a particular solution." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(LinearSolve[{{1, 3, 1}, {2, 1, \(-5\)}}, {1, \(-2\)}]\)], "Input"], Cell[BoxData[ \({\(-\(7\/5\)\), 4\/5, 0}\)], "Output"] }, Open ]], Cell[TextData[{ StyleBox["RowReduce", "InputWord"], " gives a similar result to Solve. " }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(RowReduce[{{1, 3, 1, 1}, {2, 1, \(-5\), \(-2\)}}]\)], "Input"], Cell[BoxData[ \({{1, 0, \(-\(16\/5\)\), \(-\(7\/5\)\)}, {0, 1, 7\/5, 4\/5}}\)], "Output"] }, Open ]], Cell[TextData[{ "This is interpreted as ", StyleBox["{x-16/5*z\[Equal]-7/5,y+7/5*z\[Equal]4/5}", "InputWord"], " which indeed agrees with the solution from ", StyleBox["Solve", "InputWord"], ". About the only way it might not agree is if we did not specify our \ variables to ", StyleBox["Solve", "InputWord"], " and it ordered them in such a way that a different one was selected as \ the parameter." }], "Text"], Cell[TextData[{ "This is a good place to mention ", StyleBox["LUDecomposition", "InputWord"], ". For systems that are exactly determined (that is, ", Cell[BoxData[ \(TraditionalForm\`n\)]], " equations in ", Cell[BoxData[ \(TraditionalForm\`n\)]], " unknowns with exactly one solution), this can be a useful tool. Here is \ an example. We use an asymmetric variation of a ", Cell[BoxData[ \(TraditionalForm\`15\[Times]15\)]], " Hilbert matrix, with approximate entries." }], "Text"], Cell[BoxData[ \(\(h = N[Table[1/\((2*i + j - 1)\), {i, 15}, {j, 15}], 30];\)\)], "Input"], Cell["\<\ For our right-hand-side we will use a unit vector along the first \ coordinate.\ \>", "Text"], Cell[BoxData[ \(\(e1 = Table[If[j \[Equal] 1, 1, 0], {j, 15}]; \)\)], "Input"], Cell[TextData[{ "We solve the system ", StyleBox["h.x\[Equal]e1", "InputWord"], ", first via ", Cell[BoxData[ \(TraditionalForm\`LU\)]], " techniques and then with \[IndentingNewLine]", StyleBox["LinearSolve", "InputWord"], "." }], "Text"], Cell[BoxData[ \(\(lud = LUDecomposition[h]; \)\)], "Input"], Cell[TextData[{ "As an aside I note that the third element returned is an approximation of \ the matrix condition number. Its logarithm (that is, scale) gives an \ indication of how many digits of precision one might expect to lose in \ solving linear equations with that matrix on the left-hand-side. Since \ machine arithmetic usually has about 16 places, something larger than, say, ", Cell[BoxData[ \(TraditionalForm\`10\^15\)]], " indicates strong likelihood that machine arithmetic will return \ completely bogus results. The condition number of ", StyleBox["h", "InputWord"], " is around ", Cell[BoxData[ \(TraditionalForm\`10\^22\)]], ", hence we must use bignum arithmetic." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Last[lud]\)], "Input"], Cell[BoxData[ \(8.92064756171512735344908623013`30*^21\)], "Output"] }, Open ]], Cell["Back to solving.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(sol1\ = \ LUBackSubstitution[lud, e1]\)], "Input"], Cell[BoxData[ \({3600.00000000000000000004710548`30, \(-150474.169135093688964846550671`30\), 2.62080000000000000000006181847`30*^6, \(-2.58213674235820770263679127147`30*^7\), 1.63363200000000000000005255374`30*^8, \(-7.10087604148507118225123143205`30*^8\), 2.20540320000000000000008666997`30*^9, \(-5.00442692447519302368185294479`30*^9\), 8.38053216000000000000037969924`30*^9, \(-1.03500647756191492080693441401`30*^10\), 9.31170240000000000000046964156`30*^9, \(-5.93500217902636528015168012322`30*^9\), 2.53955520000000000000013932361`30*^9, \(-6.54372035123419761657752047349`30*^8\), 7.67448000000000000000045063066`30*^7}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(sol2\ = \ LinearSolve[h, e1]\)], "Input"], Cell[BoxData[ \({3600.00000000000000000000396161`30, \(-150474.169135093688964844000347`30\), 2.62080000000000000000000580582`30*^6, \(-2.58213674235820770263672584666`30*^7\), 1.63363200000000000000000532507`30*^8, \(-7.10087604148507118225100317511`30*^8\), 2.20540320000000000000000929051`30*^9, \(-5.00442692447519302368166391852`30*^9\), 8.38053216000000000000004252746`30*^9, \(-1.03500647756191492080689043079`30*^10\), 9.31170240000000000000005449874`30*^9, \(-5.93500217902636528015140406268`30*^9\), 2.53955520000000000000001664944`30*^9, \(-6.54372035123419761657719347417`30*^8\), 7.67448000000000000000005520512`30*^7}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(sol1\ - \ sol2\)], "Input"], Cell[BoxData[ \({4.314386`6.7776*^-20, \(-2.550324`6.9281*^-18\), 5.601265`7.0288*^-17, \(-6.542481`7.1027*^-16\), 4.722867`7.16*^-15, \(-2.282569`7.2061*^-14\), 7.737946`7.2441*^-14, \(-1.890263`7.2761*^-13\), 3.371718`7.3035*^-13, \(-4.398322`7.3273*^-13\), 4.151428`7.3481*^-13, \(-2.760605`7.3666*^-13\), 1.2267416`7.383*^-13, \(-3.269993`7.3977*^-14\), 3.954255`7.411*^-15}\)], "Output"] }, Open ]], Cell["\<\ Note that the solutions agree to at least 15 significant places in \ all coordinates.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell[TextData["Series solutions\[IndentingNewLine]"], "Section"], Cell[TextData[{ "Sometimes symbolic solving is not possible. In such cases a series \ solution might be attempted. In the example below, also from a benchmark test \ suite in the literature, we use a series \"ansatz\" to obtain a full \ solution. We wish to find constants ", StyleBox["{a,b,c,d}", "InputWord"], " such that\n", StyleBox["a*Exp[b*x] - c*Exp[d*x]", "InputWord"], " is equal to ", StyleBox["Sin[x]", "InputWord"], ". We expand the difference as a power series to get polynomial equations, \ solve them, and this gives the correct result." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(sols = Solve[Series[ Sin[x] - a\ \[ExponentialE]\^\(b\ x\) - c\ \[ExponentialE]\^\(d\ x\), {x, 0, 10}] == 0, {a, b, c, d}] \)], "Input"], Cell[BoxData[ \({{a \[Rule] \(-\(\[ImaginaryI]\/2\)\), c \[Rule] \[ImaginaryI]\/2, d \[Rule] \(-\[ImaginaryI]\), b \[Rule] \[ImaginaryI]}, {a \[Rule] \[ImaginaryI]\/2, c \[Rule] \(-\(\[ImaginaryI]\/2\)\), d \[Rule] \[ImaginaryI], b \[Rule] \(-\[ImaginaryI]\)}}\)], "Output"] }, Open ]], Cell["Now check the result.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(MapAll[ExpandAll[TrigToExp[#]] &, Sin[x] \[Equal] a\ Exp[b\ x] + c\ Exp[d\ x] /. sols]\)], "Input"], Cell[BoxData[ \({True, True}\)], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Obtaining \"full\" solution sets to certain transcendental \ equations\ \>", "Section"], Cell[TextData[{ "We are asked from time to time whether ", StyleBox["Solve", "InputWord"], " can find ALL solutions to e.g. ", StyleBox["Cos[x]==1", "InputWord"], ". That is, users sometimes want a convenient way to denote solution sets \ that involve multi-valued inverses. ", StyleBox["Mathematica", FontSlant->"Italic"], " only gives principle inverses to e.g. trigonometric functions, so some \ work needs to be done to get at other potential solutions." }], "Text"], Cell[TextData[{ "Something along these lines can often be done in the manner indicated \ below. For each solution we will generate a unique string prefixed by the \ character ", StyleBox["K", "InputWord"], ". It is meant to stand for \"any integer.\"" }], "Text"], Cell["\<\ When we do this it pays to remove the Solve::ifun message. Moreover \ there are several caveats that are demonstrated in later examples.\ \>", "Text"], Cell[BoxData[{ \(\(arctrigs = {{ArcSin, 2}, {ArcCos, 2}, {ArcCsc, 2}, {ArcSec, 2}, {ArcTan, 1}, {ArcCot, 1}, {ArcSinh, 2*I}, {ArcCosh, 2*I}, {ArcCsch, 2*I}, {ArcSech, 2*I}, {ArcTanh, I}, {ArcCoth, I}};\)\), "\[IndentingNewLine]", \(\(Do[arcTrigQ[arctrigs[\([j, 1]\)]] = True; \ mult[arctrigs[\([j, 1]\)]] = arctrigs[\([j, 2]\)], {j, Length[arctrigs]}];\)\), "\[IndentingNewLine]", \(generalize[\((f_)\)[x_]] /; TrueQ[arcTrigQ[f]] := f[x] + mult[f]*Pi*Unique[K]\), "\[IndentingNewLine]", \(generalize[Log[x_]] := Log[x] + 2*Pi*I*Unique[K]\), "\[IndentingNewLine]", \(generalize[ProductLog[x_]] := ProductLog[Unique[K], x]\), "\[IndentingNewLine]", \(generalize[x___] := x\), "\[IndentingNewLine]", \(Off[Solve::ifun]\)}], "Input"], Cell["Here are some examples.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(soln = generalize //@ Solve[\[ExponentialE]\^\(2\ x\) - 2\ \[ExponentialE]\^x + 2 == 0, x]\)], "Input"], Cell[BoxData[ \({{x \[Rule] 2\ \[ImaginaryI]\ K$20\ \[Pi] + Log[1 - \[ImaginaryI]]}, {x \[Rule] 2\ \[ImaginaryI]\ K$21\ \[Pi] + Log[1 + \[ImaginaryI]]}}\)], "Output"] }, Open ]], Cell["We check the results.", "Rule", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[ \(Simplify[\[ExponentialE]\^\(2\ x\) - 2\ \[ExponentialE]\^x + 2 == 0 /. soln, Element[Variables[x /. soln], Integers]]\)], "Input"], Cell[BoxData[ \({True, True}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(eqns = {tt + aa == 46, tt + aa\ \[ExponentialE]\^\(10\ x\) == 39, tt + aa\ \[ExponentialE]\^\(20\ x\) == 33}; First[generalize//@Solve[eqns, {x, tt, aa}]]\)], "Input"], Cell[BoxData[ \({tt \[Rule] \(-3\), aa \[Rule] 49, x \[Rule] \[ImaginaryI]\ \[Pi] + 1\/10\ \((\(-2\)\ K$18\ \[Pi] - Log[7\/6])\)}\)], "Output"] }, Open ]], Cell["\<\ Be warned that we still may not get all solutions in this manner. \ We will not get any if, for example, the non-generalized solution set is \ empty.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(generalize//@ Solve[{\[ExponentialE]\^\(\[ImaginaryI]\ x\) == \[ImaginaryI], y\/\(x - \[Pi]\/2\) == 3}, {x, y}]\)], "Input"], Cell[BoxData[ \({}\)], "Output"] }, Open ]], Cell["\<\ Moreover we fail to obtain generalized solutions in cases where an \ inverse trig evaluates to something numeric.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(generalize //@ Solve[Cos[x] == 1, \ x]\)], "Input"], Cell[BoxData[ \({{x \[Rule] 0}}\)], "Output"] }, Open ]], Cell["\<\ This is in contrast to the case where the inverse trig remains \ unevaluated.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(generalize//@Solve[Cos[x] == 2, \ x]\)], "Input"], Cell[BoxData[ \({{x \[Rule] \(-2\)\ K$30\ \[Pi] - ArcCos[2]}, { x \[Rule] 2\ K$31\ \[Pi] + ArcCos[2]}}\)], "Output"] }, Open ]], Cell["\<\ A simple way to obtain solutions for the first case is to keep it \ symbolic and substitute a numeric value after-the-fact. In this simple \ example we get two equivalent families of solutions.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(\((generalize //@ Solve[Cos[x] \[Equal] a, \ x])\)\ /. \ a \[Rule] 1\)], "Input"], Cell[BoxData[ \({{x \[Rule] \(-2\)\ K$23\ \[Pi]}, {x \[Rule] 2\ K$24\ \[Pi]}}\)], "Output"] }, Open ]], Cell[TextData[{ "We can also get spurious solutions. In the example below, the \"solution\" \ for ", StyleBox["x", "InputWord"], " is bad when the integer parameter ", StyleBox["K$xx", "InputWord"], " is 1." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(generalize//@ Solve[{Cos[x] == 2, \ y/\((x - 2*Pi - ArcCos[2])\) == 3}, \ {x, y}]\)], "Input"], Cell[BoxData[ \({{y \[Rule] \(-6\)\ \[Pi], x \[Rule] 2\ K$32\ \[Pi] + ArcCos[2]}}\)], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Elimination of variables", "Section"], Cell[TextData[{ "A fairly common problem in computational math is to eliminate some \ variables from a set of equations. A frequently effective method is to use ", StyleBox["GroebnerBasis", "InputWord"], " with a special monomial ordering. \.18A common application is to the \ problem of finding implicit equations that define an algebraic variety given \ parametrically. For example, suppose we have the surface, given\n\ parametrically by ", StyleBox["s", "InputWord"], " and ", StyleBox["t", "InputWord"], ", as" }], "Text"], Cell[BoxData[ \(\(surf = {\(s\^2 - 1 - t\^2\)\/\(s\^2 + t\^2 + 1\), \(2\ s\)\/\(s\^2 + t\^2 + 1\), \(2\ s\ t\)\/\(s\^2 + t\^2 + 1\)}; \)\)], "Input"], Cell[TextData[ "(You may recognize this as a common parametrization of a sphere). We clear \ denominators and add an auxiliary equation to prevent the \ \[IndentingNewLine]denominator from vanishing. We then form a \ Gr\[ODoubleDot]bner basis with an ordering \[IndentingNewLine]that eliminates \ the parameters and the auxiliary variable."], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(polys = {x\ \((s\^2 + t\^2 + 1)\) - \((s\^2 - 1 - t\^2)\), y\ \((s\^2 + t\^2 + 1)\) - 2\ s, z\ \((s\^2 + t\^2 + 1)\) - 2\ s\ t, w\ \((s\^2 + t\^2 + 1)\) - 1}\), \(GroebnerBasis[polys, {x, y, z}, {s, t, w}, MonomialOrder \[Rule] EliminationOrder]\)}], "Input"], Cell[BoxData[ \({1 - s\^2 + t\^2 + \((1 + s\^2 + t\^2)\)\ x, \(-2\)\ s + \((1 + s\^2 + t\^2)\)\ y, \(-2\)\ s\ t + \((1 + s\^2 + t\^2)\)\ z, \(-1\) + \((1 + s\^2 + t\^2)\)\ w}\)], "Output"], Cell[BoxData[ \({\(-1\) + x\^2 + y\^2 + z\^2}\)], "Output"] }, Open ]], Cell["\<\ Here is a problem that is significantly more strenuous. It came \ from a Usenet news group question, from sci.math.symbolic, about a year ago. \ I was only able to handle it by finding an approximate Gr\[ODoubleDot]bner \ basis.\ \>", "Text"], Cell[BoxData[ \(\(polys = { x - \((110\ t\^2 - 495\ t\^3 + 1320\ t\^4 - 2772\ t\^5 + 5082\ t\^6 - 7590\ t\^7 + 8085\ t\^8 - 5555\ t\^9 + 2189\ t\^10 - 374\ t\^11) \), y - \(( 22\ t - 110\ t\^2 + 330\ t\^3 - 1848\ t\^5 + 3696\ t\^6 - 3300\ t\^7 + 1650\ t\^8 - 550\ t\^9 + 88\ t\^10 + 22\ t\^11) \)}; \)\)], "Input"], Cell[CellGroupData[{ Cell[BoxData[ \(Timing[ Short[poly250 = First[GroebnerBasis[polys, {x, y}, t, MonomialOrder \[Rule] EliminationOrder, CoefficientDomain \[Rule] InexactNumbers[250]]]]]\)], "Input"], Cell[BoxData[ RowBox[{"{", RowBox[{\(20.439999999999998`\ Second\), ",", TagBox[ \(\[LeftSkeleton]105\[RightSkeleton] + 3.4271896307633`56.832*^13\ y\^11\), Short]}], "}"}]], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["\<\ Radical solutions vs. Root objects. vs. trigs for cubic equations\ \ \>", "Section"], Cell[TextData[{ "We are occasionally asked why ", StyleBox["Solve", "InputWord"], " for cubic equations with real coefficients returns results that contain \ ", StyleBox["I", "InputWord"], " (that is, ", StyleBox["Sqrt[-1]", "InputWord"], ") when all solutions for a given equation are real-valued. The short \ answer is that if the cubic is irreducible (does not factor) over the \ rationals then there is a theorem to the effect that two of the radical \ solutions will explicitly contain ", StyleBox["I", "InputWord"], "; if all solutions are real these will manage to exactly cancel. All the \ same it is often nice to get solutions that do not have radicals at all. \ Below is an example." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(rutes1 = Roots[x\^3 - 11\ x + 2 == 0, x]\)], "Input"], Cell[BoxData[ \(x == \((\(-9\) + 2\ \[ImaginaryI]\ \@978)\)\^\(1/3\)\/3\^\(2/3\) + 11\/\((3\ \((\(-9\) + 2\ \[ImaginaryI]\ \@978)\))\)\^\(1/3\) || x == \(-\(\(\((1 + \[ImaginaryI]\ \@3)\)\ \((\(-9\) + 2\ \[ImaginaryI]\ \ \@978)\)\^\(1/3\)\)\/\(2\ 3\^\(2/3\)\)\)\) - \(11\ \((1 - \[ImaginaryI]\ \@3)\)\)\/\(2\ \((3\ \((\(-9\) + 2\ \ \[ImaginaryI]\ \@978)\))\)\^\(1/3\)\) || x == \(-\(\(\((1 - \[ImaginaryI]\ \@3)\)\ \((\(-9\) + 2\ \[ImaginaryI]\ \ \@978)\)\^\(1/3\)\)\/\(2\ 3\^\(2/3\)\)\)\) - \(11\ \((1 + \[ImaginaryI]\ \@3)\)\)\/\(2\ \((3\ \((\(-9\) + 2\ \ \[ImaginaryI]\ \@978)\))\)\^\(1/3\)\)\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(N[rutes1]\)], "Input"], Cell[BoxData[ \(x == \(3.2216774175165135`\[InvisibleSpace]\) + 0.`\ \[ImaginaryI] || x == \(0.18236957894791483`\[InvisibleSpace]\) + 0.`\ \[ImaginaryI] || x == \(-3.4040469964644284`\) + 0.`\ \[ImaginaryI]\)], "Output"] }, Open ]], Cell["One can instead use algebraic numbers.", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(rutes2 = Roots[x\^3 - 11\ x + 2 == 0, x, Cubics \[Rule] False]\)], "Input"], Cell[BoxData[ \(x == Root[2 - 11\ #1 + #1\^3 &, 1] || x == Root[2 - 11\ #1 + #1\^3 &, 2] || x == Root[2 - 11\ #1 + #1\^3 &, 3]\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(N[rutes2]\)], "Input"], Cell[BoxData[ \(x == \(-3.404046996464428`\) || x == 0.18236957894791522` || x == 3.2216774175165126`\)], "Output"] }, Open ]], Cell["\<\ Notice the ordering is not the same (no reason it ought to be, but \ sometimes we are asked about this).\ \>", "Text"], Cell["\<\ You can even express the solution in terms of trigs and arctrigs. \ If you are into that sort of thing. It seems to work for the cubics I have \ tried; I am not sure if it works for cubics I have not tried (read: \"caveat \ emptor\"). Be warned that it is not a pretty sight.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(rutes3\ = \ Apply[List, \ Map[Last, rutes1\ ]]\ // \ ComplexExpand\)], "Input"], Cell[BoxData[ \({\@\(11\/3\)\ Cos[1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + \@\(11\/3\)\ Cos[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + \[ImaginaryI]\ \((\@\(11\/3\)\ Sin[ 1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + \@\(11\/3\)\ Sin[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)])\), \(-\(1\/2\)\)\ \@\(11\/3\)\ Cos[ 1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@\(11\/3\)\ Cos[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + 1\/2\ \@11\ Sin[1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@11\ Sin[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + \[ImaginaryI]\ \((\(-\(1\/2\)\)\ \@11\ Cos[ 1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + 1\/2\ \@11\ Cos[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@\(11\/3\)\ Sin[ 1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@\(11\/3\)\ Sin[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)])\), \(-\(1\/2\)\)\ \@\(11\/3\)\ Cos[ 1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@\(11\/3\)\ Cos[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@11\ Sin[1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + 1\/2\ \@11\ Sin[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] + \[ImaginaryI]\ \((1\/2\ \@11\ Cos[ 1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@11\ Cos[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@\(11\/3\)\ Sin[ 1\/3\ \((\[Pi] - ArcTan[\(2\ \@\(326\/3\)\)\/3])\)] - 1\/2\ \@\(11\/3\)\ Sin[ 1\/3\ \((\(-\[Pi]\) + ArcTan[\(2\ \@\(326\/3\)\)\/3])\)])\)} \)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(N[rutes3]\)], "Input"], Cell[BoxData[ \({\(3.2216774175165126`\[InvisibleSpace]\) + 0.`\ \[ImaginaryI], \(0.18236957894791495`\[InvisibleSpace]\) + 0.`\ \[ImaginaryI], \(-3.4040469964644275`\) + 0.`\ \[ImaginaryI]}\)], "Output"] }, Open ]], Cell[TextData[{ "It is encouraging to note that ", StyleBox["Simplify", "InputWord"], " can restore some flavor of radical result to this mess." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Simplify[Map[TrigToExp, rutes3]]\)], "Input"], Cell[BoxData[ \({\(-\((\(-1\))\)\^\(2/3\)\)\ \((\((\(-1\))\)\^\(2/3\)\ \((1 - 2\/3\ \ \[ImaginaryI]\ \@\(326\/3\))\)\^\(1/3\) + \((1 + 2\/3\ \[ImaginaryI]\ \@\(326\/3\))\)\^\(1/3\))\), \(-\(1\/\(6\ \@3\)\((\((\(-1\))\)\^\(2/3\)\ \((2\ 3\^\(5/6\)\ \((9 - 2\ \ \[ImaginaryI]\ \@978)\)\^\(1/3\) - 3\^\(5/6\)\ \((9 + 2\ \[ImaginaryI]\ \@978)\)\^\(1/3\) + 3\ \[ImaginaryI]\ \((27 + 6\ \[ImaginaryI]\ \ \@978)\)\^\(1/3\))\))\)\)\), \(1\/\(2\ \@3\)\((\((\(-1\))\)\^\(2/3\)\ \((\((9 - 2\ \[ImaginaryI]\ \ \@978)\)\^\(1/3\)\/3\^\(1/6\) + \((9 + 2\ \[ImaginaryI]\ \@978)\)\^\(1/3\)\/3\^\(1/6\) + \[ImaginaryI]\ \((\((27 - 6\ \[ImaginaryI]\ \@978)\)\^\(1/3\) + \((27 + 6\ \[ImaginaryI]\ \@978)\)\^\(1/3\))\))\))\)\)} \)], "Output"] }, Open ]], Cell[TextData[{ "It is further encouraging to note that we can go from radicals to ", StyleBox["Root", "InputWord"], StyleBox["[...]", "InputWord"], " results." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(rutes1\ /. \ a_ \[Equal] b_\ \[RuleDelayed] \ a\ \[Equal] \ RootReduce[b]\)], "Input"], Cell[BoxData[ \(x == Root[2 - 11\ #1 + #1\^3 &, 3] || x == Root[2 - 11\ #1 + #1\^3 &, 2] || x == Root[2 - 11\ #1 + #1\^3 &, 1]\)], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Finding approximate roots to polynomial equations", "Section"], Cell[TextData[{ "At the heart of ", StyleBox["Solve", "InputWord"], " lies ", StyleBox["Roots", "InputWord"], ". For numeric root finding there is the (undocumented) ", StyleBox["NRoots", "InputWord"], " which in fact is called from ", StyleBox["Roots", "InputWord"], " and elsewhere when needed. It uses the Jenkins-Traub algorithm. At times \ it can be a bit flaky. Whenever I suspect that it is misbehaving I will \ compare to the result of extracting eigenvalues of the polynomial's companion \ matrix. Below is code to do just this." }], "Text"], Cell[BoxData[ \(companionMatrix[poly_?PolynomialQ] := Module[{vars, coeffs, newcoeffs, n, m}, vars = Variables[poly]; \[IndentingNewLine]If[ \(! ListQ[vars]\) || Length[vars] \[NotEqual] 1, Return[]]; \[IndentingNewLine]coeffs = CoefficientList[poly, vars]; \[IndentingNewLine]newcoeffs = Drop[coeffs/\((\(-Last[coeffs]\))\), \(-1\)]; \[IndentingNewLine]n = Exponent[poly, First[vars]] - 1; \[IndentingNewLine]m = Prepend[IdentityMatrix[n], Table[0, {n}]]; \[IndentingNewLine]Transpose[ Append[Transpose[m], newcoeffs]]]\)], "Input"], Cell["Here is an example.", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(poly = .7 + 3.2\ x - .3\ x\^2 + .9\ x\^4 - 7.1\ x\^5 + 1.3\ x\^6 - x\^7; \)\), \(MatrixForm[mat = companionMatrix[poly]]\)}], "Input"], Cell[BoxData[ TagBox[ RowBox[{"(", GridBox[{ {"0", "0", "0", "0", "0", "0", "0.7`"}, {"1", "0", "0", "0", "0", "0", "3.2`"}, {"0", "1", "0", "0", "0", "0", \(-0.3`\)}, {"0", "0", "1", "0", "0", "0", "0"}, {"0", "0", "0", "1", "0", "0", "0.9`"}, {"0", "0", "0", "0", "1", "0", \(-7.1`\)}, {"0", "0", "0", "0", "0", "1", "1.3`"} }], ")"}], (MatrixForm[ #]&)]], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(Sort[Eigenvalues[companionMatrix[poly]]]\)], "Input"], Cell[BoxData[ \({\(-0.7050082521398193`\), \(-0.21607926941956224`\), \(0.06992604799443577`\[InvisibleSpace]\) - 0.8589999523651449`\ \[ImaginaryI], \(0.06992604799443577`\[InvisibleSpace]\) + 0.8589999523651449`\ \[ImaginaryI], \(0.5921614429317361`\[InvisibleSpace]\) - 2.558662424703721`\ \[ImaginaryI], \(0.5921614429317361`\[InvisibleSpace]\) + 2.558662424703721`\ \[ImaginaryI], 0.8969125397070378`}\)], "Output"] }, Open ]], Cell["\<\ Here is the comparison with the built-in polynomial \ root-finder.\ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Sort[x /. Solve[poly \[Equal] 0, x]]\)], "Input"], Cell[BoxData[ \({\(-0.7050082521398193`\), \(-0.21607926941956238`\), \(0.0699260479944358`\[InvisibleSpace]\) - 0.8589999523651456`\ \[ImaginaryI], \(0.0699260479944358`\[InvisibleSpace]\) + 0.8589999523651456`\ \[ImaginaryI], \(0.5921614429317363`\[InvisibleSpace]\) - 2.5586624247037206`\ \[ImaginaryI], \(0.5921614429317363`\[InvisibleSpace]\) + 2.5586624247037206`\ \[ImaginaryI], 0.8969125397070374`}\)], "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Solving the cubic ...", "Section"], Cell[TextData[{ "Well, perhaps you've seen our excellent poster, \"Solving the Quintic.\" \ The cubic is a classical result of the early sixteenth century (maybe \ fifteenth, my rustory is histy). Here we show how it is solved by radicals. \ Using ", StyleBox["Mathematica", FontSlant->"Italic"], " to simplify computational effort we will derive the general formula, the \ one you are told exists, but never wanted to look up in a reference. This \ method of derivation was explained to me by John D'Angelo. We begin with a \ generic cubic polynomial in ", StyleBox["x", "InputWord"], "." }], "Text"], Cell[BoxData[ \(\(cubic = x\^3 + a\ x\^2 + b\ x + c;\)\)], "Input"], Cell[TextData[{ "We can get rid of the ", Cell[BoxData[ FormBox[ StyleBox[\(x\^2\), "InputWord"], TraditionalForm]]], " term by a simple change of coordinates.When we \[IndentingNewLine]finish, \ we then compensate by adding ", StyleBox["a/3", "InputWord"], " to each solution." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Collect[cubic /. x \[Rule] x - a/3 // Expand, x]\)], "Input"], Cell[BoxData[ \(\(2\ a\^3\)\/27 - \(a\ b\)\/3 + c + \((\(-\(a\^2\/3\)\) + b)\)\ x + x\^3\)], "Output"] }, Open ]], Cell[TextData[{ "It thus suffices to find a formula for the cubic polynomial ", StyleBox[Cell[BoxData[ \(TraditionalForm\`x\^3\)], "InputWord"], "InputWord"], StyleBox["+p*x+q", "InputWord"], ". If \[IndentingNewLine]you like (I do not), you can use what you saw \ above (that ", StyleBox["p", "InputWord"], " is ", StyleBox[Cell[BoxData[ \(TraditionalForm\`b - a\^2\)], "InputWord"], "InputWord"], StyleBox["/2", "InputWord"], " and ", StyleBox["q", "InputWord"], " is ", StyleBox[Cell[BoxData[ \(TraditionalForm\`c - a*b/3 + 2*a\^3\)], "InputWord"], "InputWord"], StyleBox["/27", "InputWord"], ") to rewrite the final result in terms of ", StyleBox["a", "InputWord"], ", ", StyleBox["b", "InputWord"], ", and ", StyleBox["\[IndentingNewLine]c", "InputWord"], " rather than ", StyleBox["p", "InputWord"], " and ", StyleBox["q", "InputWord"], "." }], "Text"], Cell[BoxData[ \(\(newcubic = x\^3 + p\ x + q; \)\)], "Input"], Cell[TextData[{ "We now form a rational expression in ", StyleBox["t", "InputWord"], " by the substitution ", StyleBox["x\[Rule](t+k/t)", "InputWord"], ".We will \[IndentingNewLine]then clear denominators to get a degree six \ polynomial in ", StyleBox["t", "InputWord"], ". After that we \[IndentingNewLine]choose a \"good\" value for ", StyleBox["k", "InputWord"], ", one that makes our polynomial essentially \[IndentingNewLine]quadratic." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(rat = Expand[newcubic /. \[InvisibleSpace]x \[Rule] t + k\/t]\), \(deg6poly = Collect[Expand[rat\ t\^3], t]\)}], "Input"], Cell[BoxData[ \(q + k\^3\/t\^3 + \(3\ k\^2\)\/t + \(k\ p\)\/t + 3\ k\ t + p\ t + t\^3\)], "Output"], Cell[BoxData[ \(k\^3 + \((3\ k\^2 + k\ p)\)\ t\^2 + q\ t\^3 + \((3\ k + p)\)\ t\^4 + t\^6\)], "Output"] }, Open ]], Cell[TextData[{ "We get the coefficient list,note that the degree four term has a \ coefficient \[IndentingNewLine]linear in the new variable ", StyleBox["k", "InputWord"], ", set it to zero and solve for", StyleBox[" k", "InputWord"], ". We then check \[IndentingNewLine]that this value also makes the degree \ two term vanish.We thus have a quadratic \[IndentingNewLine]polynomial in ", Cell[BoxData[ FormBox[ StyleBox[\(t\^3\), "InputWord"], TraditionalForm]]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(coeffs = CoefficientList[deg6poly, t]\), \(newk = k /. \[InvisibleSpace]First[ Solve[coeffs\[LeftDoubleBracket]5\[RightDoubleBracket] == 0, k]] \), \(quad = Expand[deg6poly /. \[InvisibleSpace]k \[Rule] newk] /. \[InvisibleSpace]t \[Rule] y\^\(1/3\)\)}], "Input"], Cell[BoxData[ \({k\^3, 0, 3\ k\^2 + k\ p, q, 3\ k + p, 0, 1}\)], "Output"], Cell[BoxData[ \(\(-\(p\/3\)\)\)], "Output"], Cell[BoxData[ \(\(-\(p\^3\/27\)\) + q\ y + y\^2\)], "Output"] }, Open ]], Cell[TextData[{ "Now take a solution for ", StyleBox["y", "InputWord"], ", using the quadratic formula. This gives rise to \[IndentingNewLine]three \ solutions for ", StyleBox["t", "InputWord"], " (take any cube root of it, and then multiply that one \ \[IndentingNewLine]by either ", StyleBox[Cell[BoxData[ \(TraditionalForm\`\((\(-1\))\)\^\(2/3\)\)], "InlineFormula"], "InlineFormula"], "or ", Cell[BoxData[ FormBox[ StyleBox[\(\((\(-1\))\)\^\(4/3\)\), "InlineFormula"], TraditionalForm]]], ")." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(ysol = y /. \[InvisibleSpace]\(Solve[quad == 0, y]\)\[LeftDoubleBracket]1\[RightDoubleBracket]\), \(tsols = {ysol\^\(1/3\), \((\(-1\))\)\^\(2/3\)\ ysol\^\(1/3\), \((\(-1\))\)\^\(4/3\)\ ysol\^\(1/3\)}\)}], "Input"], Cell[BoxData[ \(1\/54\ \((\(-27\)\ q - \@\(108\ p\^3 + 729\ q\^2\))\)\)], "Output"], Cell[BoxData[ \({\((\(-27\)\ q - \@\(108\ p\^3 + 729\ q\^2\))\)\^\(1/3\)\/\(3\ 2\^\(1/3\ \)\), \(\((\(-1\))\)\^\(2/3\)\ \((\(-27\)\ q - \@\(108\ p\^3 + 729\ q\^2\))\)\ \^\(1/3\)\)\/\(3\ 2\^\(1/3\)\), \(-\(1\/3\)\)\ \((\(-\(1\/2\)\))\)\^\(1/3\)\ \((\(-27\)\ q - \@\(108\ p\ \^3 + 729\ q\^2\))\)\^\(1/3\)}\)], "Output"] }, Open ]], Cell[TextData[{ "We can now solve for ", StyleBox["x", "InputWord"], " in terms of ", StyleBox["t", "InputWord"], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(xsols = \((t + k/t)\) /. {k \[Rule] newk, t \[Rule] tsols}\)], "Input"], Cell[BoxData[ \({\(-\(\(2\^\(1/3\)\ p \)\/\((\(-27\)\ q - \@\(108\ p\^3 + 729\ q\^2\))\)\^\(1/3\)\)\ \) + \((\(-27\)\ q - \@\(108\ p\^3 + 729\ q\^2\))\)\^\(1/3\)\/\(3\ 2\^\(1/3\)\ \), \(\((\(-2\))\)\^\(1/3\)\ p\)\/\((\(-27\)\ q - \@\(108\ p\^3 + 729\ \ q\^2\))\)\^\(1/3\) + \(\((\(-1\))\)\^\(2/3\)\ \((\(-27\)\ q - \@\(108\ p\^3 + 729\ q\^2\))\ \)\^\(1/3\)\)\/\(3\ 2\^\(1/3\)\), \(-\(\(\((\(-1\))\)\^\(2/3\)\ 2\^\(1/3\)\ p \)\/\((\(-27\)\ q - \@\(108\ p\^3 + 729\ q\^2\))\)\^\(1/3\)\)\ \) - 1\/3\ \((\(-\(1\/2\)\))\)\^\(1/3\)\ \((\(-27\)\ q - \@\(108\ p\^3 + 729\ \ q\^2\))\)\^\(1/3\)}\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(newcubic /. x \[Rule] xsols // Together\)], "Input"], Cell[BoxData[ \({0, 0, 0}\)], "Output"] }, Open ]], Cell[TextData[{ "Note that the solution will fail when one plugs in particular values for \ ", StyleBox["p", "InputWord"], " \[IndentingNewLine]and ", StyleBox["q", "InputWord"], " that cause ", StyleBox["t", "InputWord"], " to be zero (because we divide by ", StyleBox["t", "InputWord"], "). This happens exactly \[IndentingNewLine]when ", StyleBox["y", "InputWord"], " is zero, which in turn happens when ", StyleBox["p", "InputWord"], " is zero and ", StyleBox["Sqrt[q^2]\[Equal]-q", "InputWord"], ". This \[IndentingNewLine]situation can only arise when polynomial has the \ (trivial) form ", StyleBox[Cell[BoxData[ \(TraditionalForm\`x\^3\)], "InputWord"], "InputWord"], StyleBox["-q", "InputWord"], "." }], "Text"] }, Open ]], Cell[CellGroupData[{ Cell["...and the quartic", "Section"], Cell[TextData[{ "If we begin with a monic quartic polynomial that has cubic term ", Cell[BoxData[ \(j\ x\^3\)], FontWeight->"Bold"], " we can make the cubic term vanish by the change of variables ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["x", FontSlant->"Plain"], "->", RowBox[{"(", RowBox[{ StyleBox["x", FontSlant->"Plain"], "-", RowBox[{ StyleBox["j", FontSlant->"Plain"], "/", "4"}]}], ")"}]}], TraditionalForm]], FontWeight->"Bold"], ". Thus we will simply begin with" }], "Text"], Cell[BoxData[ \(\(quartic\ = \ x^4 + p*x^2 + q*x + r;\)\)], "Input"], Cell[TextData[{ "We next write it as a product of symbolic quadratics, that is, as ", Cell[BoxData[ FormBox[ RowBox[{ RowBox[{ StyleBox["(", FontWeight->"Bold"], RowBox[{ StyleBox[\(x\^2\), FontWeight->"Bold", FontSlant->"Plain"], StyleBox[" ", FontWeight->"Bold"], StyleBox["+", FontWeight->"Bold"], StyleBox[" ", FontWeight->"Bold"], StyleBox[\(a\ x\), FontWeight->"Bold", FontSlant->"Plain"], StyleBox[" ", FontWeight->"Bold"], StyleBox["+", FontWeight->"Bold"], StyleBox[" ", FontWeight->"Bold"], StyleBox["b", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox[")", FontWeight->"Bold"]}], StyleBox["*", FontWeight->"Bold"], RowBox[{ StyleBox["(", FontWeight->"Bold"], RowBox[{ StyleBox[\(x\^2\), FontWeight->"Bold", FontSlant->"Plain"], StyleBox[" ", FontWeight->"Bold"], StyleBox["-", FontWeight->"Bold"], StyleBox[" ", FontWeight->"Bold"], StyleBox[\(a\ x\), FontWeight->"Bold", FontSlant->"Plain"], StyleBox[" ", FontWeight->"Bold"], StyleBox["+", FontWeight->"Bold"], StyleBox[" ", FontWeight->"Bold"], StyleBox["c", FontWeight->"Bold"]}], StyleBox[")", FontWeight->"Bold"]}]}], TraditionalForm]]], ". If we can find ", Cell[BoxData[ FormBox[ RowBox[{"{", RowBox[{ StyleBox["a", FontSlant->"Plain"], ",", StyleBox["b", FontSlant->"Plain"], ",", StyleBox["c", FontSlant->"Plain"]}], "}"}], TraditionalForm]], FontWeight->"Bold"], " ", "in terms of ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["{", FontWeight->"Bold"], RowBox[{ StyleBox["p", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["q", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["r", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox["}", FontWeight->"Bold"]}], TraditionalForm]]], " then we can extract all four roots simply by two applications of the \ quadratic formula. We will first do the reverse, solving for ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["{", FontWeight->"Bold", FontSlant->"Italic"], RowBox[{ StyleBox["p", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["q", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold", FontSlant->"Italic"], StyleBox["r", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox["}", FontWeight->"Bold", FontSlant->"Italic"]}], TraditionalForm]]], " interms of ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["{", FontWeight->"Bold"], RowBox[{ StyleBox["a", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["b", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["c", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox["}", FontWeight->"Bold"]}], TraditionalForm]]], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(coeffs = CoefficientList[ x^4 + p*x^2 + q*x + r - \((x^2 + a*x + b)\)*\((x^2 - a*x + c)\), x];\)\), "\[IndentingNewLine]", \(soln1 = \(Solve[coeffs \[Equal] 0, {p, q, r}]\)[\([1]\)]\)}], "Input"], Cell[BoxData[ \({r \[Rule] b\ c, q \[Rule] \(-a\)\ b + a\ c, p \[Rule] \(-a\^2\) + b + c}\)], "Output"] }, Open ]], Cell[TextData[{ "By inspection we observe that if we add", StyleBox[" ", FontWeight->"Bold"], Cell[BoxData[ FormBox[ SuperscriptBox[ StyleBox["a", FontSlant->"Plain"], "2"], TraditionalForm]], FontWeight->"Bold"], " to ", StyleBox["p", FontWeight->"Bold"], ",and divide ", StyleBox["q", FontWeight->"Bold"], " by ", StyleBox["a", FontWeight->"Bold"], ", we get ", StyleBox["c+b", FontWeight->"Bold"], " and ", StyleBox["c-b", FontWeight->"Bold"], "." }], "Text", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[ \(Expand[{p + a^2, q/a} /. soln1]\)], "Input"], Cell[BoxData[ \({b + c, \(-b\) + c}\)], "Output"] }, Open ]], Cell[TextData[{ "Moreover,the difference of the squares of these is ", StyleBox["4 b c", FontWeight->"Bold"], ", which is ", StyleBox["r", FontWeight->"Bold"], ". In other words, ", StyleBox["neweqn", FontWeight->"Bold"], " (defined below) is zero once the values for ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["{", FontWeight->"Bold"], RowBox[{ StyleBox["p", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["q", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["r", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox["}", FontWeight->"Bold"]}], TraditionalForm]]], " are plugged into it." }], "Text", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[{ \(neweqn = \((p + a^2)\)^2 - \((q/a)\)^2 - 4*r\), "\[IndentingNewLine]", \(Expand[neweqn /. soln1]\)}], "Input"], Cell[BoxData[ \(\((a\^2 + p)\)\^2 - q\^2\/a\^2 - 4\ r\)], "Output"], Cell[BoxData[ \(0\)], "Output"] }, Open ]], Cell[TextData[{ "We clear the denominator, expand, and replace ", Cell[BoxData[ FormBox[ StyleBox[ SuperscriptBox[ StyleBox["a", FontSlant->"Plain"], "2"], FontWeight->"Bold", FontSlant->"Italic"], TraditionalForm]]], " by a new variable, ", StyleBox["asqr", FontWeight->"Bold"], ".\nThis gives a cubic polynomial in ", StyleBox["asqr", FontWeight->"Bold"], ", with coefficients that are polynomials\nin ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["{", FontWeight->"Bold"], RowBox[{ StyleBox["p", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["q", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["r", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox["}", FontWeight->"Bold"]}], TraditionalForm]]], ". We solve it (we will use ", Cell[BoxData[ FormBox[ StyleBox["Solve", FontWeight->"Bold"], TraditionalForm]]], ", but one could use the cubic\nsolver outlined above). Note that one is \ free to choose any of the three\nsolutions for ", StyleBox["asqr", FontWeight->"Bold"], " (and also free to take either square root thereof down\nbelow), so long \ as the choice is followed consistently." }], "Text", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[{ \(cubic = Expand[a^2*neweqn] /. a^j_ \[Rule] asqr^\((j/2)\)\), "\[IndentingNewLine]", \(asqrsol = asqr /. \(Solve[cubic \[Equal] 0, asqr]\)[\([1]\)]\)}], "Input"], Cell[BoxData[ \(asqr\^3 + 2\ asqr\^2\ p + asqr\ p\^2 - q\^2 - 4\ asqr\ r\)], "Output"], Cell[BoxData[ \(\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ p\^3 + \ 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ p\^3 + 27\ \ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\)\)], "Output"] }, Open ]], Cell[TextData[{ "We can now solve for ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["{", FontWeight->"Bold"], RowBox[{ StyleBox["a", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["b", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["c", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox["}", FontWeight->"Bold"]}], TraditionalForm]]], " in terms of ", Cell[BoxData[ FormBox[ RowBox[{ StyleBox["{", FontWeight->"Bold"], RowBox[{ StyleBox["p", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["q", FontWeight->"Bold", FontSlant->"Plain"], StyleBox[",", FontWeight->"Bold"], StyleBox["r", FontWeight->"Bold", FontSlant->"Plain"]}], StyleBox["}", FontWeight->"Bold"]}], TraditionalForm]]], "." }], "Text", FormatType->TextForm], Cell[BoxData[ \(\({a, b, c} = {Sqrt[asqrsol], 1/2*\((p + asqrsol - q/Sqrt[asqrsol])\), 1/2*\((p + asqrsol + q/Sqrt[asqrsol])\)};\)\)], "Input"], Cell[TextData[{ "We then extract our four solutions for ", StyleBox["x", FontWeight->"Bold"], "." }], "Text", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[{ \(\(disc1 = Sqrt[a^2 - 4*b];\)\), "\[IndentingNewLine]", \(\(disc2 = Sqrt[a^2 - 4*c];\)\), "\[IndentingNewLine]", \(solns = 1/2*{\(-a\) + disc1, \(-a\) - disc1, a + disc2, a - disc2}\)}], "Input"], Cell[BoxData[ \({1\/2\ \((\(-\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \((\(-p\^2\ \) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 \ + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\)\) + \[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \ \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) - 2\ \((p\/3 - \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\ \^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 \ + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) - q/\((\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\))\))\))\))\), 1\/2\ \((\(-\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 \ + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\)\) - \[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \ \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) - 2\ \((p\/3 - \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\ \^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 \ + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) - q/\((\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\))\))\))\))\), 1\/2\ \((\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\) + \[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \ \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) - 2\ \((p\/3 - \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\ \^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 \ + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) + q/\((\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\))\))\))\))\), 1\/2\ \((\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\) - \[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \ \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ 2\^\(1/3\)\)\)\((\((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 + \((2\ \ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) - 2\ \((p\/3 - \((2\^\(1/3\)\ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\ \^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ r)\)\^3 \ + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/3)\))\)\) + q/\((\[Sqrt]\((\(-\(\(2\ p\)\/3\)\) - \((2\^\(1/3\)\ \ \((\(-p\^2\) - 12\ r)\))\)/\((3\ \((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\) + \(\(1\/\(3\ \ 2\^\(1/3\)\)\)\((\((2\ p\^3 + 27\ q\^2 - 72\ p\ r + \@\(4\ \((\(-p\^2\) - 12\ \ r)\)\^3 + \((2\ p\^3 + 27\ q\^2 - 72\ p\ r)\)\^2\))\)^\((1/ 3)\))\)\))\))\))\))\))\)}\)], "Output"] }, Open ]], Cell[TextData[{ "We will check these solutions by comparing with Solve. We also compare ", Cell[BoxData[ FormBox[ StyleBox["LeafCount", FontWeight->"Bold"], TraditionalForm]]], " values." }], "Text", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[{ \(\(soln2 = x /. Solve[x^4 + p*x^2 + q*x + r \[Equal] 0, x];\)\), "\[IndentingNewLine]", \(LeafCount[solns]\), "\[IndentingNewLine]", \(LeafCount[soln2]\)}], "Input"], Cell[BoxData[ \(2351\)], "Output"], Cell[BoxData[ \(1717\)], "Output"] }, Open ]], Cell["\<\ We compare numerical results for these and two other methods.\ \>", \ "Text", FormatType->TextForm], Cell[CellGroupData[{ Cell[BoxData[{ \(\(solns /. {p \[Rule] 3, q \[Rule] \(-5\), r \[Rule] 11} // N\) // Sort\), "\[IndentingNewLine]", \(\(soln2 /. {p \[Rule] 3, q \[Rule] \(-5\), r \[Rule] 11} // N\) // Sort\), "\[IndentingNewLine]", \(\(x /. Solve[x^4 + 3*x^2 - 5*x + 11 \[Equal] 0, x] // N\) // Sort\), "\[IndentingNewLine]", \(x /. {ToRules[NRoots[x^4 + 3*x^2 - 5*x + 11 \[Equal] 0, x]]} // Sort\)}], "Input"], Cell[BoxData[ \({\(-1.0099587992099086`\) - 1.9384764705180246`\ \[ImaginaryI], \(-1.0099587992099082`\) + 1.9384764705180246`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) - 1.132405636444389`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) + 1.132405636444389`\ \[ImaginaryI]}\)], "Output"], Cell[BoxData[ \({\(-1.0099587992099086`\) - 1.9384764705180246`\ \[ImaginaryI], \(-1.0099587992099082`\) + 1.9384764705180246`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) - 1.132405636444389`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) + 1.132405636444389`\ \[ImaginaryI]}\)], "Output"], Cell[BoxData[ \({\(-1.0099587992099086`\) + 1.9384764705180246`\ \[ImaginaryI], \(-1.0099587992099082`\) - 1.9384764705180246`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) - 1.132405636444389`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) + 1.132405636444389`\ \[ImaginaryI]}\)], "Output"], Cell[BoxData[ \({\(-1.0099587992099084`\) - 1.9384764705180246`\ \[ImaginaryI], \(-1.0099587992099084`\) + 1.9384764705180246`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) - 1.1324056364443893`\ \[ImaginaryI], \(\(1.0099587992099084`\)\(\ \[InvisibleSpace]\)\) + 1.1324056364443893`\ \[ImaginaryI]}\)], "Output"] }, Open ]], Cell[TextData[{ "Note that the method will fail when the parameter ", StyleBox["a", FontWeight->"Bold"], " is zero. This happens\nprecisely when our quartic factors as ", Cell[BoxData[ FormBox[ StyleBox[\(\((x\^2\ + \ b)\)*\((x\^2\ + \ c)\)\), FontWeight->"Bold"], TraditionalForm]]], ". In this case we\nhave a bi-quadratic equation, that is, an equation that \ is quadratic in ", Cell[BoxData[ FormBox[ StyleBox[ SuperscriptBox[ StyleBox["x", FontWeight->"Bold"], "2"], FontWeight->"Bold"], TraditionalForm]]], ". Of course in this instance there is no need to use the heavier \ machinery above to extract the roots.\n" }], "Text", FormatType->TextForm] }, Open ]], Cell[CellGroupData[{ Cell["A tricky Solve example", "Section"], Cell[TextData[{ "This problem was suggested to me by Michael Trott. Given the infinite \ exponential \"ladder\" ", StyleBox["x^(x^(x^...)) \[Equal] k", "InputWord"], ", solve for ", StyleBox["x", "InputWord"], " in terms of ", StyleBox["k", "InputWord"], ". Noticing that the exponent of the first x is also just the infinite \ ladder we can rewrite this as the system ", StyleBox[Cell[BoxData[ \(TraditionalForm\`{y == x\^y\)], "InputWord"], "InputWord"], StyleBox[", y==k}", "InputWord"], " (or, mentally substituting for ", StyleBox["y", "InputWord"], ", we get ", StyleBox[Cell[BoxData[ \(TraditionalForm\`x\^k\)], "InputWord"], "InputWord"], StyleBox["==k", "InputWord"], "). We will solve the first system for ", StyleBox["x", "InputWord"], ", eliminating ", StyleBox["y", "InputWord"], ". It is a perversity of ", StyleBox["Solve", "InputWord"], " that it can sometimes do this sort of thing; elimination of variables in \ a transcendental setting is an oddity. perhaps more unusual is that we must \ eliminate ", StyleBox["y", "InputWord"], "; if we try to solve for both ", StyleBox["x", "InputWord"], " and ", StyleBox["y", "InputWord"], " we get a transcendental dependency." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(Solve[{y == x\^y, y == k}, x, y]\)], "Input"], Cell[BoxData[ \({{x \[Rule] 0}, {x \[Rule] 1}, {x \[Rule] k\^\(1\/k\)}}\)], "Output"] }, Open ]], Cell[TextData[{ "Let us try this out for explicit values of ", StyleBox["k", "InputWord"], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(sol = x /. \[InvisibleSpace]First[Solve[{y == x\^y, y == \[ExponentialE]}, x]] \)], "Input"], Cell[BoxData[ \(\[ExponentialE]\^\(1\/\[ExponentialE]\)\)], "Output"] }, Open ]], Cell["We will check this the old-fashioned way.", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(nsol = N[sol, 111]\), \(pow = nsol; Do[pow = nsol\^pow, {1000}]\), \(pow\)}], "Input"], Cell[BoxData[ \(1.4446678610097661336583391085964302230585954532422531658205226643038549\ 3771861450557358292304709885114295231845`111\)], "Output"], Cell[BoxData[ \(2.7128782418435284016864293971961583718962187158322066791427968912176662\ 9486966922169740536628380882188414575`107.7939\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[ \(pow\ - \ E\)], "Input"], Cell[BoxData[ \(\(-0.\ 005403586615516833673858074156504125861028377867752895824170736506410335483878\ 37287397681224135760554332064`105.0931\)\)], "Output"] }, Open ]], Cell[TextData[{ "Not too bad. Some experimentation will indicate logarithmic convergence \ (iterate ten times as far, get one more digit correct). Now we try it for ", StyleBox["Pi", "InputWord"], "." }], "Text"], Cell[CellGroupData[{ Cell[BoxData[ \(sol = x /. \[InvisibleSpace]First[ Solve[{y == x\^y, y == \[Pi]}, x]]\)], "Input"], Cell[BoxData[ \(\[Pi]\^\(1\/\[Pi]\)\)], "Output"] }, Open ]], Cell[CellGroupData[{ Cell[BoxData[{ \(sol = x /. \[InvisibleSpace]First[ Solve[{y == x\^y, y == \[Pi]}, x]]\), "\n", \(nsol = N[sol, 111]\), "\n", \(pow = nsol; Do[pow = nsol\^pow, {1000}]\), "\n", \(pow - \[Pi]\)}], "Input"], Cell[BoxData[ \(\[ExponentialE]\^\(1\/\[ExponentialE]\)\)], "Output"], Cell[BoxData[ \(1.4446678610097661336583391085964302230585954532422531658205226643038549\ 3771861450557358292304709885114295231845`111\)], "Output"], Cell[BoxData[ \(\(-0.\ 428714411746264836776213986083344512300950683542899141832147701090150111416539\ 77693062945905830824609800234`106.9926\)\)], "Output"] }, Open ]], Cell["\<\ This time not so good. It turns out that further iteration will not \ help. So what went wrong? The problem lies in our assumption that the system \ has a solution. If it does not, then our \"equivalent\" system is really not \ equivalent at all.\ \>", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["More with LUDecomposition and linear equations", "Section"], Cell[TextData[{ StyleBox["LUDecomposition", "InputWord"], " of a square matrix is well used in the numeric linear algebra community. \ Perhaps less well known is that it can be applied in a modular setting. Below \ I show an implementation of a linear equation solver over the rationals that \ works as follows. We first renormalize to get a related system with integral \ solution. This is done simply by multiplying the right-hand-side by the \ determinant of the matrix. We will solve this new system modulo some prime, \ then iteratively \"lift\" the solution to be valid modulo increasing powers \ of that prime. In other words, we find a p-adic solution. As we go, we \ \"correct\" by symmetrizing with respect to these powers. Eventually we \ arrive at a solution that is correct over the integers. We then divide by the \ determinant to arrive at the solution for the original system.\nThe method is \ probabilistic in that we must choose a prime for which the matrix is \ non-singular. This will be true for all but at most finitely many primes \ (assuming it is nonsingular over the rationals). Note that\n\ Ceiling[Log[N[mod], 2*matrixNorm[mat]*vectorNorm[rhs]]]\nis an upper bound on \ the number of iterations through the main loop. In practice it will typically \ be less." }], "Text"], Cell[BoxData[{ \(vectorNorm[vec_] := Apply[Plus, Map[Abs, vec]]\), "\n", \(symmetrize[vec_, power_] := Module[{len = Length[vec], halfpow = N[power/2]}, Table[If[vec[\([j]\)] > halfpow, vec[\([j]\)] - power, vec[\([j]\)]], {j, len}]]\), "\n", \(pAdicSolve[mat_?MatrixQ, rhs_?VectorQ] := Module[{len = Length[mat], b, mod = Prime[2222], det, lud, sol, corr, power}, lud = LUDecomposition[mat, Modulus \[Rule] mod]; \[IndentingNewLine]det = Det[mat]; \[IndentingNewLine]b = det*rhs; \[IndentingNewLine]power = 1; \[IndentingNewLine]sol = Table[0, {len}]; \[IndentingNewLine]While[vectorNorm[b] > 0, corr = symmetrize[LUBackSubstitution[lud, b, Modulus \[Rule] mod], mod]; \[IndentingNewLine]b = 1/mod*\((b - mat . corr)\); \[IndentingNewLine]sol += power*corr; \[IndentingNewLine]power *= mod;\[IndentingNewLine]]; \[IndentingNewLine]\((1/det)\)* sol]\)}], "Input"], Cell["Here is an example.", "Text"], Cell[BoxData[{ \(\(mat = Table[Random[ Integer, {\(-10\^12\), 10\^12}], {10}, {10}];\)\), "\n", \(\(mod = Prime[2222];\)\), "\n", \(\(b = Table[Random[Integer, {\(-10\^12\), 10\^12}], {10}];\)\)}], "Input"], Cell[CellGroupData[{ Cell[BoxData[{ \(Timing[\(ls1 = pAdicSolve[mat, b];\)]\), "\n", \(Timing[\(ls2 = LinearSolve[mat, b];\)]\), "\n", \(ls1 === ls2\)}], "Input"], Cell[BoxData[ \({0.14999999999999544`\ Second, Null}\)], "Output"], Cell[BoxData[ \({0.0500000000000182`\ Second, Null}\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell[BoxData[{ \(\(mat = Table[Random[ Integer, {\(-10\^12\), 10\^12}], {100}, {100}];\)\), "\n", \(\(mod = Prime[2222];\)\), "\n", \(\(b = Table[Random[Integer, {\(-10\^12\), 10\^12}], {100}];\)\)}], "Input"], Cell[BoxData[{ \(Timing[\(ls1 = pAdicSolve[mat, b];\)]\), "\n", \(Timing[\(ls2 = NewLinearSolve[mat, b];\)]\), "\n", \(ls1 === ls2\)}], "Input"], Cell[CellGroupData[{ Cell[BoxData[{ \(Timing[\(ls1 = pAdicSolve[mat, b];\)]\), "\n", \(Timing[\(ls2 = LinearSolve[mat, b];\)]\), "\n", \(ls1 === ls2\)}], "Input"], Cell[BoxData[ \({104.27999999999996`\ Second, Null}\)], "Output"], Cell[BoxData[ \({321.59`\ Second, Null}\)], "Output"], Cell[BoxData[ \(True\)], "Output"] }, Open ]], Cell[BoxData[ \(LinearSolve[mat_, b_] := \ NewLinearSolve[mat, b]\)], "Input"] }, Open ]] }, Open ]] }, FrontEndVersion->"5.0 for X", ScreenRectangle->{{0, 1024}, {0, 768}}, ScreenStyleEnvironment->"Working", PrintingStyleEnvironment->"Printout", WindowSize->{633, 600}, WindowMargins->{{Automatic, 85}, {Automatic, 39}}, Magnification->1, StyleDefinitions -> Notebook[{ Cell[CellGroupData[{ Cell["Style Definitions", "Subtitle"], Cell["\<\ Modify the definitions below to change the default appearance of \ all cells in a given style. Make modifications to any definition using \ commands in the Format menu.\ \>", "Text"], Cell["\<\ Below is a PICT header for use with all WWMC notebooks. Copy and \ paste this cell at the top of your notebook. \ \>", "Text"], Cell[GraphicsData["Bitmap", "\<\ CF5dJ6E]HGAYHf4PAg9QL6QYHg05eMG@2l_;`0jn_[0>c/k031`L407QhN0000000L71`0QXJ60<[:bP3[jn/0gmoO0:^[ Z`1ADE420000000;06UYJ@3GemL0e=CD055AD@0000009BDU030080oooo00<0Hf=S0000002n_[h00`3oool01@0K6a/0O7al 0?ooo`3oool0WinO00<0000000<0QHF50?ooo`3oool00`3oool01P1IFET0F5QH0?ooo`3oool0/K6a 075aL@80oooo00<0h^;R01XJ6P1mOGd01@3oool01`1iNGT0>3Ph0?ooo`3oool0X:2P00000024Q8@0 0`3oool00`1SHf<01@D50;fm_@040?ooo`030=cLg00G5aL0m?Cd00@0oooo00<0nMOM0=L7;P3E02@0 1@3F02L01@3E0240f0/`0=L4:`3F02H0eP0W0080e`@Z00@0e`D/0=H1:03F02L0eP0W0P3G12X30=H0 9`090=D08@3H2c00e`@[0=H09P3F02L0e`L]0=D08P3G0bX0eP3P0oOgm0?ooo`3oool0alO7 09BDU037alL0=3@d09bLW0020?ooo`030>KViP2FUYH0^[Zj0080oooo00<0oOgm024Q8@1gMgL00P3o ool00`1EEED0H61P0?ooo`020?ooo`030?Shn00J6QX0N7Qh0080oooo00D0Z:RX01`L700L71`00000 07moO`020?ooo`050<30`01KFe/0GemO01XJ6P1NGUh00P3oool01`3Jf]X0k>c/0?ooo`3_knl0@d=3 00000021PH400P3oool01@30`<00Fe]K065QH@0V9RH0@T920080oooo00<0T92@034a<@3kno/00`3o ool04@1FEUH0GemO0?ooo`3oool0o_kn0;6a/@2HV9P0_Kfm01hN7P3/k>`0oooo0?[jnP1iNGT0FEUI 071?E@3A0R40eP0V00@0eP0W00`0e@0O0>=CK@3d^L@0fado0=D08`3D01d0iF1g0>ELM@3/QYP0fQTl 0=D08`3D01d20>IQN@0I0=@07@3F02L0e@0O0>=CK@3d^L@0fado0=D08`3D01d0jG>80>f>X03aZKL0 fADi0=D08`3E0200gRi>0?Fob@3YN8d0eP8T0=H09P3E0200gBm?0?G0bP3^UJH0ePDW0=H09@090=H0 9`0F0=H09@3G0bX0kYFU0=XH>`3E02<0eP0W0=D08@3M;dl0jWjB0=D08P3F02H0eP0W0=@07@3TFG80 iEae0=@07P3F02L0e00O0>AJL`3c]l80i5Yc0=@07`@0eP0W00<0/@0P000000000000oP0000000`0? 3`l000000000003J00000000200000003`2>SXh0oooo0?ooo`34a<@02`/;0000000<30`08R8R0>CT i03oool0o?cl04aCT0?oo o`3bl_80oooo0?Shn00J6QX0N7Qh0P3oool01@3inOT0k^k^0>7Qh@000000Ng]k0080oooo00D0k^k^ 0=;BdP35aLD00000061PH0050?ooo`040=?Cd`0d=3@000000820P080oooo00D0k^k^0=;BdP34a<@0 000004E5A@020?ooo`080:6QX@32`/80oooo0>c/k03kno/0oooo06EUI@2h^;P20?ooo`0<09:BTP00 0000000001XJ6P0F5QH0kno_0?ooo`3no_h0f][J0=;BdP24AE40`00E103F02L03@3F02@0e`d`0?G4 c@3O=eH0e@4T0=H09`3D01/0ifb20?6Y]P3d_LL0fQPk0=D08`3D01`00P3YL8H06@3D01`0eP0T0=L= <03eaAJL`3ieM`0lkG10=L4:@3F02D0e00L0>b8VP3_UjL0mKo90=TC =`3E02<0e00L0>fAXP3XLHL0l:Bb0>51G`3D01l02@3F02L05P3F02D0e`^1 U@3D01l40=H09`030;408000000000000?h0000000<03`l?000000000000fP00000000P0000000@0 Vi^K0?ooo`3oool0YJFU0`0000001@0@4100l?3`0?ooo`3jn_X03Ph02[Zj/0moOg0?oo o`3Zj^X04aS0?gm o@3oool0JFUY0IWO`3e`l`0m/SA0=TE>@3E02<0 e00L0080j6j301T0e00L0=D08`3I4cL0ml[B0=P=YmT@3D01`0 eP0V0=@07P3^UJH0jWfA0>MXOP3G22d0e@0U0=@07P3_VZX0he=]0>jFYP3SCf/0e00N00T0eP0W01H0 eP0U0=L1:03aY[@0fQ/n0=D08`3F02@0f0/`0?:/^@3b[k/0i5E_0=@07P3E0240gS1@0?>g`@3d^lD0 fQLl0=D08`3D01/0iEYd0?_Xk03UFg@0e00K103F02L00`2a020000000000003n0000000300l?3`00 000000000=X0000000080000000905IFEP3oool0oooo0?KfmP1eMGD0ATI608Z:RP0g=cL0^KVi0080 oooo00@0bl_;05YJFP2:RXX0n?Sh0P3oool00`0i>CT0M7Ad0?ooo`020?ooo`070?;blP0l?3`0a/K6 0?ooo`3hn?P06QXJ07QhN0020?ooo`050;Ng]`14A4@0ADE500X:2P1mOGd00P3oool01@2d];@0>c/k 03/k>`000000HV9R0080oooo00<0/[:b01hN7P3Shn<00P3oool01@0e=CD0M7Ad0?ooo`3oool0];Bd 0080>c/k00<00P8204I6AP3oool00`3oool01P1OGel0SHf=0?ooo`3oool0FEUI0861P@80oooo00d0 g]kN05YJFP1;Bd/0TY:B01lO7`3/k>`0oooo0?[jnP1OGel0>SXj04/]<`3=01/0eP0V00<0eP0W00d0 eP0V0=D18@3ZNi00lk>n0=TF>@3E02<0e00L0>M]P`3WJX40kiVX0=XL?`3E02<0e00L0080j6n401T0 e00L0=H09P3E0B40jW^@0?>c_P3I5ST0e@0S0=H0903G12X0n=3G0>AJM03D01`0eP0W0=@07@3RBfL0 mlWA0>YhS@3F0RD0eP0V0=@07P3QAV<0mlWB0?:_^`3H3S00e@0T00T0eP0W01H0e@0S0=XH?03fbM80 fQPk0=D08`3F02D0eP@W0>j@X@3c]l80gRi>0=D08@3E02<0fQTk0?:^^`3aYK<0e``^0=D0903D01`0 i5Uc0?O@f03TFG<0e00L103F02L00`2a020000000000003n0000000300l?3`00000000000=X00000 00080000000300H61P2k^k/0oooo00@0oooo00<08bSX04U9 B@1bLW800P3oool01@3^k^h0d];B0=CDe00_;bl0FUYJ0080oooo00L0mOGe0>KViP3oool0oooo0>7Q h@0=3@d0NWYj0080oooo00D0kno_0=;BdP3De=@0c/k03oool0o_kn0=_Kf`3AdM40f;Fl0=L5 ;03E02@40=H09`040=H09@3F02L0gS9A0=P:<080eP0U00H0fADh0=XF>@3K7T00e`D[0=H09P3F02D2 0=XE>@070=H09@3F02L0eP0U0=H09`3N0=XH?03E02<:0=H09`0:0=H09@3H3340gS1@ 0=L3:P3F02H0eP0W0=D08`3I53P0gBU:0=D08`80eP0W00X0e@0T0=`RA03J6ch0e@0T0=H09`3F02H0 e`@[0=dZB`3G12/0eP0V103F02L00`2a020000000000003n0000000300l?3`00000000000=X00000 00090000000;01`0UiNG00T92@000000NGUi0?gmo@3lo?`0`L7100d=3@030`<0f][J0?gmo@3emOD0410@07al O03oool0oOgm00<0oooo00@0BTY:06UYJ@3moOd0oOgm0`3oool0100b[ZjP02 0?gmo@80oooo00L0n=?J0=P1:03D01l0eP0Q0=L08`3G0280e@0R0080e`0R00`0e00I0=D0803G0280 e@0R0=D07P3F01h0e`0J0=P07`3G0280e@0R0=D07P3G01h20=D08P0?0=P08@3G0240eP0J0=D0803E 0280e`0R0=L08`3E01/0e@0O0=P08P3H0240e@0R0=D08@3D01X0e@0N0080e`0R00T0e@0R0=D08@3F 01P0e`0L0=D08P3H0240f00P0=L08P3E02800P3F02820=D08P80f00P00T0f00Q0=D0803D01T0e`0Q 0=H08P3E0280f00R0=H07`3F01X00P3E0280103H0240e`0S0=H06P3G01/30=D08P060=H0803D01X0 e@0P0=P08@3H0200f00Q0P3E02800`2b01`000000000003n0000000300l?3`00000000000=X00000 000;0000000<04E5A@2c/k<0_[jn071`L0061PH08R8R05IFEP1]KFd0K6a/05UIF@1=CDd09BDU0P00 00004`0n?Sh0SHf=0;jn_P2DU9@0>3Ph000000010@40>c/k09ZJVP2OWil0H61P01`L701`L700XZ:R 0:2PX02FUYH0N7Qh07IfMP1lO7`00P2PX:006`2NWYh0HF5Q09FEU@1_Kfl0MWIf0::RXP2CTi<0L71` 0451@@0_;bl03@d=000000051@D0MWIf0::RXP2?Shl0?clo04a1HL02X:401G>d00MeIK07=CF01PADT0Le=H07IIGP1F:340=@D<04dP:01eFEh0 M5QM04DL900e1@h0KdiD07MGG@1F=cd0DRP_07IHG@0307EDFP0/06I9CP1OA4P0MUEK079>E00f31<0 BB0W07ELH@1C9Bd0<`/B06]9C`1fEE/0L51F07EDF@1fEE/0Kd]B02l<4P0Z2@h0DBD]07IIGP1fEEX0 F3m306i?E01gEU/0HDA903D53P1;7RH0MEUN07IIGP1F:340=@D=02h83`1D5B00PeUQ08iVK@1_CeD0 KTmD07IEFP1dEe`0?A`R02X93@0o7B<0MEQM07IEFP1G?T;o00000040000000<03`l?000000000000 fP00000000/0000000H0N7Qh0?gmo@3moOd0]kNg0000002c/`00000000000000 000ag]k@3moOd0lo?c018B4P38b3P00<0oooo00@0o_kn0>_[j`2VYZH0 6QXJ0P0000002P18B4P0o_kn0?gmo@3YjNT000000492@P3lo?`0oooo0>o_k`0820P2000000030;no _`3oool0oooo0080C4a<103oool01P3moOd0fMWI07EeM@00000030`<0>k^kP80oOgm0P3oool08P39 bl/0KWEc0:ji]`2V];401PD505ADE02__;X0HV9R0000002LZ:H0[kZh0828Q`29TY00[kZh0:>]Z`17 BDP0S@2_^[P0Yk6`05QNG@2W/K00[kZh06E/JP000000:b/[0:jj^02_^kT0>SXj0000002? VYP0[kZh06ieL`0m@3l20:nj^080/;^i0180VZBR05eSHP2_^[P0[;Ne01LH600m@3l0[kZh07MnO@00 0000Qi2>0:nj^02=UY@0OXF40:nj^02Z]K<0AdY9030bSX0WJJU0:nj^02`^kT0Z[Fc08F=R`80[kZh00<0HFMV 02`^;P1NHf800P2_^[P00`1UK6/000000000003n0000000300l?3`00000000000=X00000000:0000 000700D51@3Fe]H0oooo0?ooo`3/k>`051@D0;Ng]`020?ooo`050?KfmP0X:2P0000000h>3P3De=@0 0`3oool02P3bl_80oooo0?ooo`3oool0FUYJ00@4103`l?00oooo0>SXj02:RXX20?ooo`030CT0?ooo`3no_h0lO7a00<0oooo00@0bSX0N7Qh0?ooo`020?ooo`0405mOG`00000000000;Rh^080oooo0P1EEED2 0?ooo`030?Win@3dm?@0oooo0080oooo01@0KFe]00820P3`l?00oooo0?knoP3SP2b/[80MgMg03dm?@H0/[:b0240Xj>S02DU 9@2XZ:P0/[:b08>3P`00000051@D0:b/[02b/[80FU]K0000001bLW80/[:b09>CT`0_;bl0[jn_0;:b /P2VYZH0QhN707emO@0j>SX0[Jf]0;:b/P1=CDd0FEUI0;:b/P2_[jl0:b/[07UiN@2b/[80S8b<034a <@2`/;001@2b/[80302][Jd092@T08J6QP2b/[80Z:RX00P92@0A4Q80[:b/0;:b/P1oOgl04aT Y080/[:b00@0[Zj^0:n_[`1VIVH0U9BD1P2b/[800`19BDT000000000003n0000000300l?3`000000 00000=X00000000:0000000703dm?@3no_h0oooo0?ooo`3moOd0E5AD0=cLg0030?ooo`0308Z:RP00 0000KVi^0080oooo00@0i>CT04Y:BP0_;bl0ZJVY0P3oool01@3:b/X04ac/k03oool0oOgm0080 oooo00@0l?3`0410@0000000PH610P3oool02P2e]KD0@41003lo?`0Q8B40kNg]0?ooo`3inOT0BTY: 05UIF@3_knl20?ooo`0303hn?P071`L0i>CT00<0oooo00<0Ng]k0:6QX@3oool00P3oool01035aLD0 0@410000002h^;P20?ooo`80EEEE0P3oool00`31`L40c/ 0?ooo`3kno/0P82006QXJ00_;bl020P80:2PX02b/[80Jf][08B4Q0020;:b/P0@06UYJ@23Ph<0/[:b 07inOP0410@0T92@0;:b/P2][Jd0LG5a0:ZZZP2b/[80Rh^;00P8202IVIT0/[:b09bLW0800`<30180 WIfM0;:b/P2CTi<0GUiN096AT@2b/[80YZJV02DU9@2VYZH0/[:b09BDU018B4P0@T9200P8202>SXh0 /[:b07YjNP1gMgL20;:b/P0F07MgM`1dM7@0/[:b09>CT`020P80OWin0;:b/P2a/K40MgMg0:6QX@2b /[80WinO00@4101`L700/[:b0;2`/00S8b<00@4109ZJVP2b/[80U9BD03Ti>@80/[:b00D0UiNG02XZ :P0[:b/0<30`05EEE@020;:b/P0508>3P`2>SXh0/[:b0;6a/@0[:b/0o`0000010000000300l?3`00 000000000=X00000000:0000000=0:RXZ03oool0i>CT0k^kP0P8200jn_[0?oo o`3no_h0oOgm0?ooo`3moOd0_Kfm01DE5@1jNWX00P3oool02P2GUiL000000000000<30`0lO7a0?oo o`3hn?P07QhN0000002j^[X20?ooo`0?06m_K`1JFUX0oooo0?KfmP2l_;`0oooo0@3Xj>P40?ooo`0K08F5Q@000000Lg=c0;:b/P2JVYX0YJFU0:n_[`2XZ:P0YJFU09>C T`2b/[80P82000000012@T80/[:b0:n_[`0g=cL0WYjN0;:b/P1^KVh0000008:2PP2b/[80[:b/01300D0/[:b00<0[jn_034a<@2@T900102b/[805@0J6QX0FEUI0;:b/P2UYJD0VYZJ0:n_ [`2XZ:P0ZZZZ08n?S`2b/[80Ti>C0000000];Bd0/[:b0;6a/@16ATH0QhN70;:b/P24Q8@0000005UI F@020;:b/P0903/k>`000000Ph>30;:b/P2SXj<0BDU90;2`/02b/[80KFe]00<0000000P04A4A0:>S X`2b/[80Hf=S069RHP2b/[80Z:RX00l?3ol000000@0000000`0?3`l000000000003J000000002@00 00001@0F5QH0k^k^0?ooo`2ZZZX0MGEe00<0oooo00H0Shn?08Z:RP3oool0o_kn03Xj>P1kNg/20?oo o`040=3@d00O7al02`/;08:2PP80oooo00L0g=cL01TI6@3/k>`0oooo0>o_k`0c7Qh@02 0?ooo`0605=CD`2a/K40oooo0>?Sh`1ADE40no_k0P3oool01`35aLD0HV9R0?ooo`3oool0PH610000 002g]kL00P3oool205EEE@80oooo00l0^KVi00`<301]KFd0o_kn0?ooo`3Kfm/08B4Q0>_[j`3oool0 o?cl0:BTY02DU9@0ATI600000010@4000`2b/[800`2@T900KVi^0;:b/P020;:b/P0D0820P0000000 1@D509FEU@2b/[80Q8B40:FUY@2b/[80D51@00820P1YJFT0/[:b0;6a/@0bC00<30`000000Q8B40;:b/P2;Rh/0W9bL0;:b/P1SHf<00`<304=3 @`2a/K40/[:b05QHF0020P80JFUY0;:b/P2^[Zh0@41009jNWP2b/[80VIVI01TI6@0000008B4Q0000 001IFET0/[:b0:6QX@28R8P0/[:b08Z:RP010@40o`0000010000000300l?3`00000000000=X00000 00090000000605eMG@3oool0oooo0820P00/;2`0o_kn0P3oool01`1HF5P0E5AD0?ooo`3oool0YZJV 01`L703bl_800P3oool00`3Vi^H0c/k>0?ooo`020?ooo`0708R8R0051@D0kno_0?ooo`3emOD0MgMg 0=GEe@020?ooo`05065QH@1_Kfl0oooo0?ooo`2LW9`00P0000001P0?3`l0l?3`0?ooo`3moOd0d=3@ 0>g]k@80oooo00L0fm_K03De=@3alO40oooo0;jn_P0>3Ph0hN7Q0080oooo00L0V9RH020P803inOT0 oooo0=oOg`0<30`0/k>c0080oooo0P1EEED20?ooo`030>k^kP3@d=00oooo0080oooo00/0RXZ:00<3 0`3_knl0oooo0?_kn`29RHT0Lg=c059BDP0000004Q8B0:JVYP020;:b/P030820P00S8b<0[Jf]0080 /[:b00@0P820000000000000B4Q80`2b/[80102`/;00?Cdm07MgM`2IVIT20;:b/P0;09ZJVP1aLG40 Fe]K0;:b/P2_[jl0;bl_02@T902][Jd0/[:b05ADE01LG5`00P2b/[801@1YJFT0D51@03Hf=P061PH0 V9RH0080/[:b00<0UYJF01TI6@2SXj<00P2b/[80102CTi<01@D50000000d=3@40;:b/P0804E5A@1J FUX0TI6A0;6a/@2b/[80XZ:R07emO@1fMWH20;:b/P0>0410@01ADE40/[:b0;:b/P2MWId0O7al0:2P X00E5AD03Ph>0:FUY@2b/[80/K6a0;:b/P1]KFgo00000080000000<03`l?000000000000fP000000 00P0000000L020P80=?Cd`3oool0oooo05YJFP010@40jNWY0080oooo00P0;Bd]02HV9P3oool0oooo 0?knoP0N7Qh0Fe]K0?7al@D0oooo00@0/;2`010@400;2`/0no_k1@3oool00`3Cdm<04Q8B0820P002 0?ooo`050:>SX`0000000000010@403kno/01@3oool00`3Lg=`0?clo092@T0020?ooo`0309NGU`00 0000[jn_0080oooo00<0K6a/0000003Ogml00P3oool0101LG5`0/k>c0?ooo`3oool205UIF@H0oooo 00@0];Bd01LG5`0:2PX0no_k103oool01038bSX`061PH00P8209JFUP2g]kL0^[Zj04=3@`00000000<30`0000002`/;0:ZZZP<0]KFe00D0^;Rh 08>3P`000000000003`l?0020820P00604aCT`20P8008B4Q0000000E5AD0Ng]k07moO`1n OWh09bLWo`0000020000000300/;2`00000000000=X00000001X0000000301hN7P0?3`l03`l?0?l0 3`l?@@0?3`l00`0N7Qh000000000003J00000000o`00003o000008X00000003o00000?l00000RP00 00000?l00000o`00002:00000000\ \>"], "WWMCHeader", ShowCellBracket->False, CellMargins->{{0, 0}, {0, 0}}, Evaluatable->False, CellFrameMargins->4, FormatType->StandardForm, ImageSize->{648, 25}, ImageMargins->{{0, 0}, {0, 0}}, ImageRegion->{{0, 1}, {0, 1}}, Background->GrayLevel[0]], Cell[CellGroupData[{ Cell["Style Environment Names", "Section"], Cell[StyleData[All, "Working"], PageWidth->WindowWidth, FormatType->StandardForm, ScriptMinSize->9], Cell[StyleData[All, "Presentation"], PageWidth->WindowWidth, FormatType->StandardForm, ScriptMinSize->12, FontSize->16], Cell[StyleData[All, "Condensed"], PageWidth->WindowWidth, FormatType->StandardForm, ScriptMinSize->8, FontSize->11], Cell[StyleData[All, "Printout"], PageWidth->PaperWidth, FormatType->StandardForm, ScriptMinSize->5, FontSize->10, PrivateFontOptions->{"FontType"->"Outline"}] }, Closed]], Cell[CellGroupData[{ Cell["Notebook Options", "Section"], Cell["\<\ The options defined for the style below will be used at the \ Notebook level.\ \>", "Text"], Cell[StyleData["Notebook", "Presentation"], PageHeaders->{{Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"], None, Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"]}, {Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"], None, Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"]}}, CellBracketOptions->{"Color"->RGBColor[0.66717, 0.187915, 0.232395]}, CellElementSpacings->{"ClosedGroupTopMargin"->20}, CellFrameLabelMargins->6, FormatType->StandardForm, StyleMenuListing->None, Background->RGBColor[0.924025, 0.891524, 0.771649]], Cell[StyleData["Notebook", "Printout"], PageHeaders->{{Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"], None, Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"]}, {Cell[ TextData[ { ValueBox[ "FileName"]}], "Header"], None, Cell[ TextData[ { CounterBox[ "Page"]}], "PageNumber"]}}, CellElementSpacings->{"ClosedGroupTopMargin"->20}, CellFrameLabelMargins->6, FormatType->StandardForm, StyleMenuListing->None, Background->None] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Headings", "Section"], Cell[CellGroupData[{ Cell[StyleData["Title"], CellMargins->{{40, Inherited}, {20, 40}}, CellGroupingRules->{"TitleGrouping", 0}, PageBreakBelow->False, FormatType->StandardForm, CounterIncrements->"Title", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}, { "Subtitle", 0}, {"Subsubtitle", 0}}, FontFamily->"Helvetica", FontSize->36, FontWeight->"Bold"], Cell[StyleData["Title", "Presentation"], ShowCellBracket->False, CellMargins->{{0, 100}, {0, 0}}, CellFrameMargins->{{30, 100}, {10, 20}}, AutoIndent->False, LineSpacing->{0, 44}, FormatType->StandardForm, FontSize->40, FontColor->GrayLevel[1], Background->RGBColor[0.812512, 0, 0]], Cell[StyleData["Title", "Condensed"], CellMargins->{{8, 10}, {4, 8}}, FormatType->StandardForm, FontSize->20], Cell[StyleData["Title", "Printout"], CellFrame->{{0, 0}, {0.25, 0}}, CellMargins->{{10, 10}, {12, 30}}, CellFrameMargins->2, FormatType->StandardForm, FontSize->26] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Subtitle"], CellMargins->{{40, Inherited}, {20, 15}}, CellGroupingRules->{"TitleGrouping", 10}, PageBreakBelow->False, FormatType->StandardForm, CounterIncrements->"Subtitle", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}, { "Subsubtitle", 0}}, FontFamily->"Helvetica", FontSize->24], Cell[StyleData["Subtitle", "Presentation"], ShowCellBracket->False, CellMargins->{{98, 0}, {20, 0}}, CellFrameMargins->{{10, 4}, {4, 6}}, AutoIndent->False, LineSpacing->{0, 34}, FormatType->StandardForm, FontSize->30, FontColor->GrayLevel[1], Background->GrayLevel[0]], Cell[StyleData["Subtitle", "Condensed"], CellMargins->{{8, 10}, {4, 4}}, FormatType->StandardForm, FontSize->14], Cell[StyleData["Subtitle", "Printout"], CellMargins->{{40, 10}, {1, 0}}, FormatType->StandardForm, FontSize->18] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Author"], CellMargins->{{100, Inherited}, {20, 0}}, CellGroupingRules->{"TitleGrouping", 20}, PageBreakBelow->False, FormatType->StandardForm, CounterIncrements->"Subsubtitle", CounterAssignments->{{"Section", 0}, {"Equation", 0}, {"Figure", 0}}, FontFamily->"Helvetica", FontSize->14, FontSlant->"Italic"], Cell[StyleData["Author", "Presentation"], CellFrame->{{0, 0}, {2, 0}}, ShowCellBracket->False, CellMargins->{{98, 0}, {60, 10}}, CellFrameMargins->{{4, 4}, {2, 8}}, LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->22, FontColor->GrayLevel[0]], Cell[StyleData["Author", "Condensed"], CellMargins->{{8, 10}, {8, 8}}, FormatType->StandardForm, FontSize->12], Cell[StyleData["Author", "Printout"], CellMargins->{{40, 10}, {60, 8}}, FormatType->StandardForm, FontSize->14] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Section"], CellDingbat->"\[FilledSquare]", CellMargins->{{25, Inherited}, {8, 24}}, CellGroupingRules->{"SectionGrouping", 30}, PageBreakBelow->False, FormatType->StandardForm, CounterIncrements->"Section", CounterAssignments->{{"Subsection", 0}, {"Subsubsection", 0}}, FontFamily->"Helvetica", FontSize->16, FontWeight->"Bold"], Cell[StyleData["Section", "Presentation"], CellFrame->{{0, 0}, {0, 2}}, CellDingbat->None, CellMargins->{{40, 22}, {0, 30}}, CellFrameMargins->{{99, 0}, {1, 4}}, CellFrameColor->RGBColor[0.708598, 0.00158694, 0.047715], CellFrameLabelMargins->{{4, 4}, {0, 2}}, LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->24], Cell[StyleData["Section", "Condensed"], CellMargins->{{18, Inherited}, {6, 12}}, FormatType->StandardForm, FontSize->12], Cell[StyleData["Section", "Printout"], CellFrame->{{0, 0}, {0, 0.5}}, CellDingbat->None, CellMargins->{{10, 0}, {4, 22}}, CellFrameMargins->3, FormatType->StandardForm, FontSize->14] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Subsection"], CellMargins->{{22, Inherited}, {8, 20}}, CellGroupingRules->{"SectionGrouping", 40}, PageBreakBelow->False, FormatType->StandardForm, CounterIncrements->"Subsection", CounterAssignments->{{"Subsubsection", 0}}, FontSize->14, FontWeight->"Bold"], Cell[StyleData["Subsection", "Presentation"], CellFrame->{{0, 0}, {0, 2}}, CellMargins->{{40, 22}, {0, 30}}, CellFrameMargins->{{0, 0}, {0, 2}}, CellFrameColor->GrayLevel[1], LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->22], Cell[StyleData["Subsection", "Condensed"], CellMargins->{{16, Inherited}, {6, 12}}, FormatType->StandardForm, FontSize->12], Cell[StyleData["Subsection", "Printout"], CellFrame->{{0, 0}, {0, 0.5}}, CellMargins->{{10, 0}, {0, 22}}, CellFrameMargins->3, FormatType->StandardForm, FontSize->12] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Subsubsection"], CellDingbat->"\[FilledSmallSquare]", CellMargins->{{22, Inherited}, {8, 18}}, CellGroupingRules->{"SectionGrouping", 50}, PageBreakBelow->False, FormatType->StandardForm, CounterIncrements->"Subsubsection", FontWeight->"Bold"], Cell[StyleData["Subsubsection", "Presentation"], CellMargins->{{99, 60}, {0, 26}}, LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->18], Cell[StyleData["Subsubsection", "Condensed"], CellMargins->{{17, Inherited}, {6, 12}}, FormatType->StandardForm, FontSize->10], Cell[StyleData["Subsubsection", "Printout"], CellMargins->{{40, 0}, {0, 25}}, FormatType->StandardForm, FontSize->11] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Rule"], CellMargins->{{10, Inherited}, {8, 18}}, PageBreakBelow->False, FormatType->StandardForm], Cell[StyleData["Rule", "Presentation"], CellFrame->{{0, 0}, {3, 0}}, CellMargins->{{99, 60}, {0, 40}}, CellFrameMargins->False, LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->18], Cell[StyleData["Rule", "Condensed"], CellMargins->{{17, Inherited}, {6, 12}}, FormatType->StandardForm, FontSize->10], Cell[StyleData["Rule", "Printout"], CellMargins->{{10, 0}, {7, 14}}, FormatType->StandardForm, FontSize->11] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Body Text", "Section"], Cell[CellGroupData[{ Cell[StyleData["Text"], CellMargins->{{12, 10}, {7, 7}}, LineSpacing->{1, 3}, FormatType->StandardForm, CounterIncrements->"Text"], Cell[StyleData["Text", "Presentation"], CellMargins->{{99, 22}, {10, 10}}, TextAlignment->Left, TextJustification->0, LineSpacing->{1, 3}, FormatType->StandardForm, FontSize->16], Cell[StyleData["Text", "Condensed"], CellMargins->{{8, 10}, {6, 6}}, LineSpacing->{1, 1}, FormatType->StandardForm], Cell[StyleData["Text", "Printout"], CellMargins->{{40, 2}, {6, 6}}, TextJustification->0.5, FormatType->StandardForm] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["SmallText"], CellMargins->{{12, 10}, {6, 6}}, LineSpacing->{1, 3}, FormatType->StandardForm, CounterIncrements->"SmallText", FontFamily->"Helvetica", FontSize->9], Cell[StyleData["SmallText", "Presentation"], CellMargins->{{119, 22}, {10, 10}}, LineSpacing->{1, 5}, FormatType->StandardForm, FontSize->12, FontColor->RGBColor[0.0899214, 0.182635, 0.460777]], Cell[StyleData["SmallText", "Condensed"], CellMargins->{{8, 10}, {5, 5}}, LineSpacing->{1, 2}, FormatType->StandardForm, FontSize->9], Cell[StyleData["SmallText", "Printout"], CellMargins->{{50, 2}, {5, 5}}, TextJustification->0.5, FormatType->StandardForm, FontSize->7] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Styles for Input/Output", "Section"], Cell["\<\ The cells in this section define styles used for input and output \ to the kernel. Be careful when modifying, renaming, or removing these \ styles, because the front end associates special meanings with these style \ names. Some attributes for these styles are actually set in FormatType Styles \ (in the last section of this stylesheet). \ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Input"], CellMargins->{{45, 10}, {5, 7}}, Evaluatable->True, CellGroupingRules->"InputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultInputFormatType, AutoItalicWords->{}, FormatType->InputForm, ShowStringCharacters->True, NumberMarks->True, LinebreakAdjustments->{0.85, 2, 10, 0, 1}, CounterIncrements->"Input", FontWeight->"Bold"], Cell[StyleData["Input", "Presentation"], CellMargins->{{99, 45}, {0, 10}}, CellFrameMargins->12, LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->16, FontColor->GrayLevel[1], Background->RGBColor[0.28748, 0.378042, 0.556527], ButtonBoxOptions->{ButtonMinHeight->0.125, ButtonMargins->9, Background->RGBColor[0.665293, 0.0723888, 0.101137]}], Cell[StyleData["Input", "Condensed"], CellMargins->{{40, 10}, {2, 3}}, FormatType->StandardForm], Cell[StyleData["Input", "Printout"], CellFrame->True, CellMargins->{{40, 0}, {0, 6}}, FormatType->StandardForm, LinebreakAdjustments->{0.85, 2, 10, 1, 1}, FontSize->9, Background->GrayLevel[0.849989]] }, Open ]], Cell[CellGroupData[{ Cell[StyleData["CodeComment"], CellMargins->{{45, 10}, {5, 7}}, Evaluatable->True, CellGroupingRules->"InputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, FormatType->StandardForm, ShowStringCharacters->True, NumberMarks->True, LinebreakAdjustments->{0.85, 2, 10, 0, 1}, CounterIncrements->"Input", FontFamily->"Times", FontWeight->"Plain", FontSlant->"Italic"], Cell[StyleData["CodeComment", "Presentation"], CellMargins->{{99, 45}, {0, 10}}, CellFrameMargins->12, LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->14, FontColor->GrayLevel[0.699992], Background->RGBColor[0.28748, 0.378042, 0.556527]] }, Open ]], Cell[StyleData["InputOnly"], CellMargins->{{99, Inherited}, {Inherited, Inherited}}, Evaluatable->True, CellGroupingRules->"InputGrouping", CellHorizontalScrolling->True, DefaultFormatType->DefaultInputFormatType, AutoItalicWords->{}, FormatType->InputForm, ShowStringCharacters->True, NumberMarks->True, LinebreakAdjustments->{0.85, 2, 10, 0, 1}, CounterIncrements->"Input", StyleMenuListing->None, FontWeight->"Bold"], Cell[StyleData["InputWord"], CellMargins->{{99, Inherited}, {Inherited, Inherited}}, CellGroupingRules->"InputGrouping", AutoItalicWords->{}, FormatType->InputForm, FontWeight->"Bold"], Cell[CellGroupData[{ Cell[StyleData["Output"], CellMargins->{{47, 10}, {7, 5}}, CellEditDuplicate->True, CellGroupingRules->"OutputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultOutputFormatType, AutoItalicWords->{}, FormatType->InputForm, CounterIncrements->"Output"], Cell[StyleData["Output", "Presentation"], CellMargins->{{99, 45}, {10, 0}}, CellFrameMargins->12, LineSpacing->{1, 0}, FormatType->StandardForm, FontSize->16, Background->RGBColor[0.978958, 0.959915, 0.622477]], Cell[StyleData["Output", "Condensed"], CellMargins->{{41, Inherited}, {3, 2}}, FormatType->StandardForm], Cell[StyleData["Output", "Printout"], CellFrame->True, CellMargins->{{40, 0}, {6, 0}}, FormatType->StandardForm, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Message"], CellMargins->{{45, Inherited}, {Inherited, Inherited}}, CellGroupingRules->"OutputGrouping", PageBreakWithin->False, GroupPageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, ShowCellLabel->False, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultOutputFormatType, AutoItalicWords->{}, FormatType->InputForm, CounterIncrements->"Message", StyleMenuListing->None, FontColor->RGBColor[0, 0, 1]], Cell[StyleData["Message", "Presentation"], CellMargins->{{99, 45}, {Inherited, Inherited}}, CellFrameMargins->12, LineSpacing->{1, 0}, FormatType->StandardForm, FontColor->RGBColor[0.694072, 0.204471, 0.227802], Background->RGBColor[0.963821, 0.948333, 0.891249]], Cell[StyleData["Message", "Condensed"], CellMargins->{{41, Inherited}, {Inherited, Inherited}}, FormatType->StandardForm], Cell[StyleData["Message", "Printout"], CellMargins->{{40, Inherited}, {Inherited, Inherited}}, FormatType->StandardForm, FontSize->8, FontColor->GrayLevel[0]] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Print"], CellMargins->{{45, Inherited}, {Inherited, Inherited}}, CellGroupingRules->"OutputGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GroupPageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, ShowCellLabel->False, CellLabelMargins->{{11, Inherited}, {Inherited, Inherited}}, DefaultFormatType->DefaultOutputFormatType, AutoItalicWords->{}, FormatType->InputForm, CounterIncrements->"Print", StyleMenuListing->None], Cell[StyleData["Print", "Presentation"], CellMargins->{{99, 45}, {0, 0}}, CellFrameMargins->{{12, 12}, {2, 2}}, LineSpacing->{1, 0}, FormatType->StandardForm, Background->GrayLevel[1]], Cell[StyleData["Print", "Condensed"], CellMargins->{{41, Inherited}, {Inherited, Inherited}}, FormatType->StandardForm], Cell[StyleData["Print", "Printout"], CellMargins->{{50, Inherited}, {Inherited, Inherited}}, FormatType->StandardForm, FontSize->8] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["Graphics"], CellMargins->{{4, Inherited}, {Inherited, Inherited}}, CellGroupingRules->"GraphicsGrouping", CellHorizontalScrolling->True, PageBreakWithin->False, GeneratedCell->True, CellAutoOverwrite->True, ShowCellLabel->False, DefaultFormatType->DefaultOutputFormatType, FormatType->InputForm, CounterIncrements->"Graphics", ImageMargins->{{43, Inherited}, {Inherited, 0}}, StyleMenuListing->None], Cell[StyleData["Graphics", "Presentation"], CellMargins->{{99, 45}, {10, 0}}, FormatType->StandardForm, Background->RGBColor[0.978958, 0.959915, 0.622477]], Cell[StyleData["Graphics", "Condensed"], FormatType->StandardForm, ImageMargins->{{38, Inherited}, {Inherited, 0}}, Magnification->0.6], Cell[StyleData["Graphics", "Printout"], CellFrame->True, CellMargins->{{40, 0}, {0, -1}}, FormatType->StandardForm, ImageMargins->{{40, Inherited}, {Inherited, 0}}, FontSize->9] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["CellLabel"], FormatType->StandardForm, StyleMenuListing->None, FontFamily->"Helvetica", FontSize->9, FontColor->RGBColor[0, 0, 1]], Cell[StyleData["CellLabel", "Presentation"], FormatType->StandardForm, FontSize->12, FontColor->GrayLevel[0]], Cell[StyleData["CellLabel", "Condensed"], FormatType->StandardForm, FontSize->9], Cell[StyleData["CellLabel", "Printout"], FormatType->StandardForm, FontSize->7, FontSlant->"Italic", FontColor->GrayLevel[0]] }, Closed]] }, Open ]], Cell[CellGroupData[{ Cell["Formulas and Programming", "Section"], Cell[CellGroupData[{ Cell[StyleData["InlineFormula"], CellMargins->{{10, 4}, {0, 8}}, CellHorizontalScrolling->True, FormatType->StandardForm, ScriptLevel->1, SingleLetterItalics->True], Cell[StyleData["InlineFormula", "Presentation"], CellMargins->{{99, 10}, {10, 10}}, LineSpacing->{1, 5}, FormatType->StandardForm], Cell[StyleData["InlineFormula", "Condensed"], CellMargins->{{8, 10}, {6, 6}}, LineSpacing->{1, 1}, FormatType->StandardForm], Cell[StyleData["InlineFormula", "Printout"], CellMargins->{{10, 0}, {6, 6}}, FormatType->StandardForm] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["DisplayFormula"], CellMargins->{{42, Inherited}, {Inherited, Inherited}}, CellHorizontalScrolling->True, DefaultFormatType->DefaultInputFormatType, FormatType->StandardForm, ScriptLevel->0, SingleLetterItalics->True, UnderoverscriptBoxOptions->{LimitsPositioning->True}], Cell[StyleData["DisplayFormula", "Presentation"], CellMargins->{{99, Inherited}, {Inherited, 10}}, LineSpacing->{1, 5}, FormatType->StandardForm], Cell[StyleData["DisplayFormula", "Condensed"], LineSpacing->{1, 1}, FormatType->StandardForm], Cell[StyleData["DisplayFormula", "Printout"], CellMargins->{{10, Inherited}, {Inherited, Inherited}}, FormatType->StandardForm] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Hyperlink Styles", "Section"], Cell["\<\ The cells below define styles useful for making hypertext \ ButtonBoxes. The \"Hyperlink\" style is for links within the same Notebook, \ or between Notebooks.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Hyperlink"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookLocate[ #2]}]&), Active->True, ButtonNote->ButtonData}], Cell[StyleData["Hyperlink", "Presentation"], FormatType->StandardForm], Cell[StyleData["Hyperlink", "Condensed"], FormatType->StandardForm], Cell[StyleData["Hyperlink", "Printout"], FormatType->StandardForm, FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell["\<\ The following styles are for linking automatically to the on-line \ help system.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["MainBookLink"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "MainBook", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["MainBookLink", "Presentation"], FormatType->StandardForm], Cell[StyleData["MainBookLink", "Condensed"], FormatType->StandardForm], Cell[StyleData["MainBookLink", "Printout"], FormatType->StandardForm, FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["AddOnsLink"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontFamily->"Courier", FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "AddOns", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["AddOnsLink", "Presentation"], FormatType->StandardForm], Cell[StyleData["AddOnsLink", "Condensed"], FormatType->StandardForm], Cell[StyleData["AddOnsLink", "Printout"], FormatType->StandardForm, FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["RefGuideLink"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontFamily->"Courier", FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "RefGuide", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["RefGuideLink", "Presentation"], FormatType->StandardForm], Cell[StyleData["RefGuideLink", "Condensed"], FormatType->StandardForm], Cell[StyleData["RefGuideLink", "Printout"], FormatType->StandardForm, FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["GettingStartedLink"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "GettingStarted", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["GettingStartedLink", "Presentation"], FormatType->StandardForm], Cell[StyleData["GettingStartedLink", "Condensed"], FormatType->StandardForm], Cell[StyleData["GettingStartedLink", "Printout"], FormatType->StandardForm, FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["OtherInformationLink"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, FontColor->RGBColor[0, 0, 1], FontVariations->{"Underline"->True}, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`HelpBrowserLookup[ "OtherInformation", #]}]&), Active->True, ButtonFrame->"None"}], Cell[StyleData["OtherInformationLink", "Presentation"], FormatType->StandardForm], Cell[StyleData["OtherInformationLink", "Condensed"], FormatType->StandardForm], Cell[StyleData["OtherInformationLink", "Printout"], FormatType->StandardForm, FontColor->GrayLevel[0], FontVariations->{"Underline"->False}] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Styles for Headers and Footers", "Section"], Cell[StyleData["Header"], CellMargins->{{0, 0}, {4, 1}}, FormatType->StandardForm, StyleMenuListing->None, FontSize->10, FontSlant->"Italic"], Cell[StyleData["Footer"], CellMargins->{{0, 0}, {0, 4}}, FormatType->StandardForm, StyleMenuListing->None, FontSize->9, FontSlant->"Italic"], Cell[StyleData["PageNumber"], CellMargins->{{0, 0}, {4, 1}}, FormatType->StandardForm, StyleMenuListing->None, FontFamily->"Times", FontSize->10] }, Closed]], Cell[CellGroupData[{ Cell["Palette Styles", "Section"], Cell["\<\ The cells below define styles that define standard \ ButtonFunctions, for use in palette buttons.\ \>", "Text"], Cell[StyleData["Paste"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, After]}]&)}], Cell[StyleData["Evaluate"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], SelectionEvaluate[ FrontEnd`InputNotebook[ ], All]}]&)}], Cell[StyleData["EvaluateCell"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], FrontEnd`SelectionMove[ FrontEnd`InputNotebook[ ], All, Cell, 1], FrontEnd`SelectionEvaluateCreateCell[ FrontEnd`InputNotebook[ ], All]}]&)}], Cell[StyleData["CopyEvaluate"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`SelectionCreateCell[ FrontEnd`InputNotebook[ ], All], FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], FrontEnd`SelectionEvaluate[ FrontEnd`InputNotebook[ ], All]}]&)}], Cell[StyleData["CopyEvaluateCell"], FormatType->StandardForm, StyleMenuListing->None, ButtonStyleMenuListing->Automatic, ButtonBoxOptions->{ButtonFunction:>(FrontEndExecute[ { FrontEnd`SelectionCreateCell[ FrontEnd`InputNotebook[ ], All], FrontEnd`NotebookApply[ FrontEnd`InputNotebook[ ], #, All], FrontEnd`SelectionEvaluateCreateCell[ FrontEnd`InputNotebook[ ], All]}]&)}] }, Closed]], Cell[CellGroupData[{ Cell["Placeholder Styles", "Section"], Cell["\<\ The cells below define styles useful for making placeholder \ objects in palette templates.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["Placeholder"], Placeholder->True, FormatType->StandardForm, StyleMenuListing->None, FontSlant->"Italic", FontColor->RGBColor[0.890623, 0.864698, 0.384756], TagBoxOptions->{Editable->False, Selectable->False, StripWrapperBoxes->False}], Cell[StyleData["Placeholder", "Presentation"], FormatType->StandardForm], Cell[StyleData["Placeholder", "Condensed"], FormatType->StandardForm], Cell[StyleData["Placeholder", "Printout"], FormatType->StandardForm] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["PrimaryPlaceholder"], Placeholder->PrimaryPlaceholder, FormatType->StandardForm, StyleMenuListing->None, DrawHighlighted->True, FontSlant->"Italic", Background->RGBColor[0.912505, 0.891798, 0.507774], TagBoxOptions->{Editable->False, Selectable->False, StripWrapperBoxes->False}], Cell[StyleData["PrimaryPlaceholder", "Presentation"], FormatType->StandardForm], Cell[StyleData["PrimaryPlaceholder", "Condensed"], FormatType->StandardForm], Cell[StyleData["PrimaryPlaceholder", "Printout"], FormatType->StandardForm] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["FormatType Styles", "Section"], Cell["\<\ The cells below define styles that are mixed in with the styles \ of most cells. If a cell's FormatType matches the name of one of the styles \ defined below, then that style is applied between the cell's style and its \ own options. This is particularly true of Input and Output.\ \>", "Text"], Cell[StyleData["CellExpression"], PageWidth->Infinity, CellMargins->{{6, Inherited}, {Inherited, Inherited}}, ShowCellLabel->False, ShowSpecialCharacters->False, AllowInlineCells->False, AutoItalicWords->{}, FormatType->StandardForm, StyleMenuListing->None, FontFamily->"Courier", FontSize->12, Background->GrayLevel[1]], Cell[StyleData["InputForm"], AllowInlineCells->False, FormatType->StandardForm, StyleMenuListing->None, FontFamily->"Courier"], Cell[StyleData["OutputForm"], PageWidth->Infinity, TextAlignment->Left, LineSpacing->{0.6, 1}, FormatType->StandardForm, StyleMenuListing->None, FontFamily->"Courier"], Cell[StyleData["StandardForm"], LineSpacing->{1.25, 0}, FormatType->StandardForm, StyleMenuListing->None, FontFamily->"Courier"], Cell[StyleData["TraditionalForm"], LineSpacing->{1.25, 0}, FormatType->StandardForm, SingleLetterItalics->True, TraditionalFunctionNotation->True, DelimiterMatching->None, StyleMenuListing->None], Cell["\<\ The style defined below is mixed in to any cell that is in an \ inline cell within another.\ \>", "Text"], Cell[StyleData["InlineCell"], TextAlignment->Left, FormatType->StandardForm, ScriptLevel->0, StyleMenuListing->None], Cell[RawData["\<\ Cell[StyleData[\"InlineCellEditing\"], FormatType->StandardForm, StyleMenuListing->None, Background->RGBColor[1, 0.749996, 0.8]]\ \>"], FormatType->StandardForm, StyleMenuListing->None, Background->RGBColor[1, 0.749996, 0.8]] }, Open ]], Cell[CellGroupData[{ Cell["Expression Annotation Styles", "Section"], Cell["\<\ The cells below define styles that are used to effect the display \ of certain types of objects in typeset expressions. For example, \ \"UnmatchedBracket\" style defines how unmatched bracket, curly bracket, and \ parenthesis characters are displayed (typically by coloring them to make them stand out).\ \>", "Text"], Cell[StyleData["UnmatchedBracket"], FormatType->StandardForm, FontColor->RGBColor[0.760006, 0.330007, 0.8]] }, Closed]], Cell[CellGroupData[{ Cell["Styles for Automatic Numbering", "Section"], Cell["\<\ The following styles are useful for numbered equations, figures, \ etc. They automatically give the cell a FrameLabel containing a reference to \ a particular counter, and also increment that counter.\ \>", "Text"], Cell[CellGroupData[{ Cell[StyleData["NumberedEquation"], CellMargins->{{55, 10}, {0, 10}}, CellFrameLabels->{{None, Cell[ TextData[ {"(", CounterBox[ "NumberedEquation"], ")"}]]}, {None, None}}, DefaultFormatType->DefaultInputFormatType, FormatType->StandardForm, CounterIncrements->"NumberedEquation", FormatTypeAutoConvert->False], Cell[StyleData["NumberedEquation", "Printout"], CellMargins->{{55, 55}, {0, 10}}, FormatType->StandardForm, FontSize->10] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["NumberedFigure"], CellMargins->{{55, 145}, {2, 10}}, CellHorizontalScrolling->True, CellFrameLabels->{{None, None}, {Cell[ TextData[ {"Figure ", CounterBox[ "NumberedFigure"]}], FontWeight -> "Bold"], None}}, FormatType->StandardForm, CounterIncrements->"NumberedFigure", FormatTypeAutoConvert->False], Cell[StyleData["NumberedFigure", "Printout"], FormatType->StandardForm, FontSize->10] }, Closed]], Cell[CellGroupData[{ Cell[StyleData["NumberedTable"], CellMargins->{{55, 145}, {2, 10}}, CellFrameLabels->{{None, None}, {Cell[ TextData[ {"Table ", CounterBox[ "NumberedTable"]}], FontWeight -> "Bold"], None}}, TextAlignment->Center, FormatType->StandardForm, CounterIncrements->"NumberedTable", FormatTypeAutoConvert->False], Cell[StyleData["NumberedTable", "Printout"], CellMargins->{{18, Inherited}, {Inherited, Inherited}}, FormatType->StandardForm, FontSize->10] }, Closed]] }, Closed]] }, Open ]] }] ] (******************************************************************* 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->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1754, 51, 15047, 192, 33, 14824, 184, "GraphicsData", "Bitmap", \ "WWMCHeader", Evaluatable->False], Cell[CellGroupData[{ Cell[16826, 247, 61, 0, 170, "Title"], Cell[16890, 249, 143, 6, 120, "Author"], Cell[CellGroupData[{ Cell[17058, 259, 27, 0, 57, "Section"], Cell[17088, 261, 407, 9, 82, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[17532, 275, 33, 0, 57, "Section"], Cell[17568, 277, 97, 2, 43, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[17702, 284, 153, 5, 82, "Section"], Cell[17858, 291, 1160, 24, 201, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[19055, 320, 34, 0, 57, "Section"], Cell[19092, 322, 1207, 24, 218, "Text"], Cell[20302, 348, 847, 15, 184, "Text"], Cell[21152, 365, 486, 8, 116, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[21675, 378, 98, 2, 57, "Section"], Cell[21776, 382, 161, 5, 48, "Text"], Cell[21940, 389, 65, 0, 31, "Text"], Cell[22008, 391, 113, 3, 48, "Text"], Cell[CellGroupData[{ Cell[22146, 398, 71, 1, 33, "Input"], Cell[22220, 401, 690, 12, 119, "Output"] }, Open ]], Cell[22925, 416, 545, 9, 116, "Text"], Cell[CellGroupData[{ Cell[23495, 429, 123, 2, 31, "Input"], Cell[23621, 433, 154, 3, 39, "Message"], Cell[23778, 438, 255, 6, 87, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[24070, 449, 151, 3, 44, "Input"], Cell[24224, 454, 61, 1, 44, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[24322, 460, 122, 3, 44, "Input"], Cell[24447, 465, 154, 3, 39, "Message"], Cell[24604, 470, 166, 2, 80, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[24807, 477, 85, 1, 31, "Input"], Cell[24895, 480, 154, 3, 39, "Message"], Cell[25052, 485, 1189, 25, 511, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[26278, 515, 91, 1, 35, "Input"], Cell[26372, 518, 154, 3, 39, "Message"], Cell[26529, 523, 79, 1, 27, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[26645, 529, 66, 1, 27, "Input"], Cell[26714, 532, 158, 3, 39, "Message"], Cell[26875, 537, 158, 3, 39, "Message"], Cell[27036, 542, 154, 3, 39, "Message"], Cell[27193, 547, 64, 1, 47, "Output"] }, Open ]], Cell[27272, 551, 495, 13, 99, "Text"], Cell[27770, 566, 276, 6, 65, "Text"], Cell[28049, 574, 475, 13, 82, "Text"], Cell[CellGroupData[{ Cell[28549, 591, 84, 1, 27, "Input"], Cell[28636, 594, 154, 3, 39, "Message"], Cell[28793, 599, 76, 1, 44, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[28906, 605, 379, 12, 27, "Input"], Cell[29288, 619, 38, 1, 27, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[29363, 625, 127, 2, 43, "Input"], Cell[29493, 629, 70, 1, 27, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[29600, 635, 97, 2, 27, "Input"], Cell[29700, 639, 165, 3, 39, "Message"], Cell[29868, 644, 62, 1, 44, "Output"] }, Open ]], Cell[29945, 648, 184, 6, 49, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[30166, 659, 98, 3, 57, "Section"], Cell[30267, 664, 2164, 42, 439, "Text"], Cell[CellGroupData[{ Cell[32456, 710, 88, 1, 27, "Input"], Cell[32547, 713, 142, 3, 29, "Output"] }, Open ]], Cell[32704, 719, 372, 10, 82, "Text"], Cell[33079, 731, 1388, 32, 236, "Text"], Cell[34470, 765, 206, 4, 65, "Text"], Cell[34679, 771, 149, 3, 27, "Input"], Cell[34831, 776, 110, 2, 27, "Input"], Cell[34944, 780, 323, 9, 65, "Text"], Cell[35270, 791, 305, 7, 59, "Input"], Cell[35578, 800, 389, 8, 59, "Input"] }, Open ]], Cell[CellGroupData[{ Cell[36004, 813, 65, 0, 57, "Section"], Cell[36072, 815, 344, 6, 99, "Text"], Cell[CellGroupData[{ Cell[36441, 825, 33, 0, 47, "Subsection"], Cell[36477, 827, 61, 0, 31, "Text"], Cell[36541, 829, 165, 3, 82, "Input"], Cell[36709, 834, 676, 15, 116, "Text"], Cell[37388, 851, 113, 4, 31, "Text"], Cell[CellGroupData[{ Cell[37526, 859, 182, 3, 75, "Input"], Cell[37711, 864, 315, 5, 73, "Message"], Cell[38029, 871, 315, 5, 73, "Message"], Cell[38347, 878, 315, 5, 73, "Message"], Cell[38665, 885, 155, 3, 39, "Message"], Cell[38823, 890, 390, 6, 89, "Message"], Cell[39216, 898, 390, 6, 89, "Message"], Cell[39609, 906, 390, 6, 89, "Message"], Cell[40002, 914, 172, 3, 39, "Message"], Cell[40177, 919, 690, 11, 179, "Output"] }, Open ]], Cell[40882, 933, 109, 3, 48, "Text"], Cell[40994, 938, 80, 1, 27, "Input"], Cell[41077, 941, 215, 7, 48, "Text"], Cell[41295, 950, 216, 4, 65, "Text"], Cell[CellGroupData[{ Cell[41536, 958, 393, 7, 107, "Input"], Cell[41932, 967, 864, 17, 195, "Output"] }, Open ]], Cell[42811, 987, 427, 12, 82, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[43275, 1004, 34, 0, 47, "Subsection"], Cell[43312, 1006, 284, 6, 65, "Text"], Cell[43599, 1014, 629, 10, 209, "Input"], Cell[44231, 1026, 410, 8, 82, "Text"], Cell[CellGroupData[{ Cell[44666, 1038, 125, 2, 59, "Input"], Cell[44794, 1042, 35, 1, 27, "Output"] }, Open ]], Cell[44844, 1046, 325, 6, 82, "Text"], Cell[CellGroupData[{ Cell[45194, 1056, 44, 1, 27, "Input"], Cell[45241, 1059, 192, 3, 45, "Output"] }, Open ]], Cell[45448, 1065, 186, 6, 48, "Text"], Cell[45637, 1073, 157, 3, 27, "Input"], Cell[45797, 1078, 57, 0, 31, "Text"], Cell[CellGroupData[{ Cell[45879, 1082, 70, 1, 27, "Input"], Cell[45952, 1085, 466, 7, 91, "Output"] }, Open ]], Cell[46433, 1095, 502, 13, 99, "Text"], Cell[46938, 1110, 310, 7, 65, "Text"], Cell[47251, 1119, 421, 8, 107, "Input"], Cell[CellGroupData[{ Cell[47697, 1131, 48, 1, 27, "Input"], Cell[47748, 1134, 193, 3, 47, "Output"] }, Open ]], Cell[47956, 1140, 338, 8, 82, "Text"], Cell[CellGroupData[{ Cell[48319, 1152, 133, 3, 27, "Input"], Cell[48455, 1157, 865, 12, 209, "Output"] }, Open ]], Cell[49335, 1172, 1023, 24, 167, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[50395, 1201, 35, 0, 47, "Subsection"], Cell[50433, 1203, 248, 5, 65, "Text"], Cell[50684, 1210, 563, 11, 85, "Input"], Cell[51250, 1223, 412, 12, 65, "Text"], Cell[51665, 1237, 114, 3, 48, "Text"], Cell[CellGroupData[{ Cell[51804, 1244, 181, 3, 59, "Input"], Cell[51988, 1249, 494, 8, 83, "Output"] }, Open ]], Cell[52497, 1260, 356, 7, 82, "Text"], Cell[52856, 1269, 154, 3, 59, "Input"], Cell[53013, 1274, 63, 0, 31, "Text"], Cell[CellGroupData[{ Cell[53101, 1278, 143, 4, 75, "Input"], Cell[53247, 1284, 35, 1, 27, "Output"], Cell[53285, 1287, 38, 1, 27, "Output"], Cell[53326, 1290, 40, 1, 27, "Output"], Cell[53369, 1293, 40, 1, 27, "Output"] }, Open ]], Cell[53424, 1297, 892, 20, 150, "Text"], Cell[CellGroupData[{ Cell[54341, 1321, 120, 2, 43, "Input"], Cell[54464, 1325, 37, 1, 27, "Output"] }, Open ]], Cell[54516, 1329, 310, 7, 65, "Text"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[54875, 1342, 58, 0, 57, "Section"], Cell[54936, 1344, 441, 13, 99, "Text"], Cell[CellGroupData[{ Cell[55402, 1361, 33, 0, 47, "Subsection"], Cell[55438, 1363, 429, 12, 82, "Text"], Cell[CellGroupData[{ Cell[55892, 1379, 134, 2, 43, "Input"], Cell[56029, 1383, 8101, 284, 204, 3067, 217, "GraphicsData", "PostScript", \ "Graphics"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[64179, 1673, 34, 0, 31, "Subsection"], Cell[64216, 1675, 350, 8, 82, "Text"], Cell[CellGroupData[{ Cell[64591, 1687, 190, 4, 93, "Input"], Cell[64784, 1693, 111, 2, 96, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[64944, 1701, 35, 0, 47, "Subsection"], Cell[64982, 1703, 1249, 39, 152, "Text"], Cell[66234, 1744, 184, 5, 49, "Text"], Cell[CellGroupData[{ Cell[66443, 1753, 109, 2, 46, "Input"], Cell[66555, 1757, 158, 3, 39, "Message"], Cell[66716, 1762, 186, 5, 59, "Output"] }, Open ]], Cell[66917, 1770, 744, 20, 133, "Text"], Cell[CellGroupData[{ Cell[67686, 1794, 147, 2, 59, "Input"], Cell[CellGroupData[{ Cell[67858, 1800, 10023, 372, 186, 4262, 296, "GraphicsData", "PostScript", \ "Graphics"], Cell[77884, 2174, 9196, 346, 204, 3897, 276, "GraphicsData", "PostScript", \ "Graphics"] }, Open ]] }, Open ]], Cell[87107, 2524, 133, 3, 45, "Text"], Cell[87243, 2529, 90, 3, 48, "Text"], Cell[87336, 2534, 183, 3, 82, "Input"], Cell[87522, 2539, 90, 3, 48, "Text"], Cell[CellGroupData[{ Cell[87637, 2546, 157, 3, 27, "Input"], Cell[87797, 2551, 8983, 331, 204, 3731, 262, "GraphicsData", "PostScript", \ "Graphics"] }, Open ]], Cell[96795, 2885, 200, 4, 62, "Text"], Cell[CellGroupData[{ Cell[97020, 2893, 57, 1, 27, "Input"], Cell[97080, 2896, 65, 1, 54, "Output"] }, Open ]], Cell[97160, 2900, 134, 4, 45, "Text"], Cell[CellGroupData[{ Cell[97319, 2908, 73, 1, 27, "Input"], Cell[97395, 2911, 51, 1, 54, "Output"] }, Open ]], Cell[97461, 2915, 253, 7, 62, "Text"], Cell[97717, 2924, 211, 6, 59, "Input"], Cell[CellGroupData[{ Cell[97953, 2934, 76, 1, 27, "Input"], Cell[98032, 2937, 65, 1, 54, "Output"] }, Open ]], Cell[98112, 2941, 361, 8, 96, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[98510, 2954, 103, 2, 31, "Subsection"], Cell[98616, 2958, 247, 5, 82, "Text"], Cell[CellGroupData[{ Cell[98888, 2967, 982, 17, 242, "Input"], Cell[99873, 2986, 55, 1, 27, "Output"] }, Open ]], Cell[99943, 2990, 82, 1, 43, "Rule"], Cell[CellGroupData[{ Cell[100050, 2995, 68, 1, 27, "Input"], Cell[100121, 2998, 129, 2, 29, "Output"] }, Open ]], Cell[100265, 3003, 351, 10, 94, "Rule"], Cell[CellGroupData[{ Cell[100641, 3017, 214, 3, 80, "Input"], Cell[100858, 3022, 1414, 24, 107, "Output"] }, Open ]], Cell[102287, 3049, 121, 4, 60, "Rule"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[102457, 3059, 67, 0, 62, "Section"], Cell[102527, 3061, 269, 7, 84, "Text"], Cell[102799, 3070, 104, 4, 31, "Text"], Cell[CellGroupData[{ Cell[102928, 3078, 70, 1, 27, "Input"], Cell[103001, 3081, 45, 1, 52, "Output"] }, Open ]], Cell[103061, 3085, 104, 4, 28, "Text"], Cell[CellGroupData[{ Cell[103190, 3093, 90, 1, 27, "Input"], Cell[103283, 3096, 67, 1, 52, "Output"] }, Open ]], Cell[103365, 3100, 334, 6, 79, "Text"], Cell[CellGroupData[{ Cell[103724, 3110, 66, 1, 27, "Input"], Cell[103793, 3113, 61, 1, 52, "Output"] }, Open ]], Cell[103869, 3117, 226, 5, 62, "Text"], Cell[CellGroupData[{ Cell[104120, 3126, 116, 2, 27, "Input"], Cell[104239, 3130, 133, 3, 49, "Message"], Cell[104375, 3135, 113, 2, 74, "Output"] }, Open ]], Cell[104503, 3140, 121, 3, 28, "Text"], Cell[CellGroupData[{ Cell[104649, 3147, 86, 1, 27, "Input"], Cell[104738, 3150, 58, 1, 74, "Output"] }, Open ]], Cell[104811, 3154, 104, 3, 29, "Text"], Cell[CellGroupData[{ Cell[104940, 3161, 82, 1, 27, "Input"], Cell[105025, 3164, 93, 1, 74, "Output"] }, Open ]], Cell[105133, 3168, 427, 10, 83, "Text"], Cell[105563, 3180, 518, 14, 99, "Text"], Cell[106084, 3196, 93, 1, 27, "Input"], Cell[106180, 3199, 103, 3, 48, "Text"], Cell[106286, 3204, 82, 1, 27, "Input"], Cell[106371, 3207, 259, 9, 48, "Text"], Cell[106633, 3218, 63, 1, 27, "Input"], Cell[106699, 3221, 724, 16, 167, "Text"], Cell[CellGroupData[{ Cell[107448, 3241, 42, 1, 27, "Input"], Cell[107493, 3244, 72, 1, 54, "Output"] }, Open ]], Cell[107580, 3248, 32, 0, 28, "Text"], Cell[CellGroupData[{ Cell[107637, 3252, 71, 1, 27, "Input"], Cell[107711, 3255, 747, 15, 385, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[108495, 3275, 62, 1, 24, "Input"], Cell[108560, 3278, 747, 15, 385, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[109344, 3298, 48, 1, 24, "Input"], Cell[109395, 3301, 438, 7, 150, "Output"] }, Open ]], Cell[109848, 3311, 109, 3, 45, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[109994, 3319, 64, 0, 37, "Section"], Cell[110061, 3321, 578, 12, 150, "Text"], Cell[CellGroupData[{ Cell[110664, 3337, 198, 5, 50, "Input"], Cell[110865, 3344, 303, 4, 73, "Output"] }, Open ]], Cell[111183, 3351, 37, 0, 28, "Text"], Cell[CellGroupData[{ Cell[111245, 3355, 126, 2, 43, "Input"], Cell[111374, 3359, 46, 1, 52, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[111469, 3366, 97, 3, 62, "Section"], Cell[111569, 3371, 488, 11, 117, "Text"], Cell[112060, 3384, 269, 6, 82, "Text"], Cell[112332, 3392, 163, 4, 65, "Text"], Cell[112498, 3398, 843, 15, 219, "Input"], Cell[113344, 3415, 39, 0, 31, "Text"], Cell[CellGroupData[{ Cell[113408, 3419, 150, 4, 31, "Input"], Cell[113561, 3425, 205, 4, 27, "Output"] }, Open ]], Cell[113781, 3432, 61, 1, 43, "Rule"], Cell[CellGroupData[{ Cell[113867, 3437, 159, 2, 50, "Input"], Cell[114029, 3441, 46, 1, 27, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[114112, 3447, 201, 3, 48, "Input"], Cell[114316, 3452, 165, 3, 44, "Output"] }, Open ]], Cell[114496, 3458, 173, 4, 65, "Text"], Cell[CellGroupData[{ Cell[114694, 3466, 161, 3, 49, "Input"], Cell[114858, 3471, 36, 1, 27, "Output"] }, Open ]], Cell[114909, 3475, 137, 3, 48, "Text"], Cell[CellGroupData[{ Cell[115071, 3482, 71, 1, 27, "Input"], Cell[115145, 3485, 49, 1, 27, "Output"] }, Open ]], Cell[115209, 3489, 101, 3, 31, "Text"], Cell[CellGroupData[{ Cell[115335, 3496, 69, 1, 27, "Input"], Cell[115407, 3499, 128, 2, 27, "Output"] }, Open ]], Cell[115550, 3504, 217, 4, 65, "Text"], Cell[CellGroupData[{ Cell[115792, 3512, 109, 2, 27, "Input"], Cell[115904, 3516, 106, 2, 27, "Output"] }, Open ]], Cell[116025, 3521, 230, 7, 48, "Text"], Cell[CellGroupData[{ Cell[116280, 3532, 123, 3, 27, "Input"], Cell[116406, 3537, 102, 2, 27, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[116557, 3545, 43, 0, 57, "Section"], Cell[116603, 3547, 541, 12, 116, "Text"], Cell[117147, 3561, 167, 3, 46, "Input"], Cell[117317, 3566, 350, 5, 82, "Text"], Cell[CellGroupData[{ Cell[117692, 3575, 310, 5, 84, "Input"], Cell[118005, 3582, 213, 4, 47, "Output"], Cell[118221, 3588, 63, 1, 54, "Output"] }, Open ]], Cell[118299, 3592, 252, 5, 65, "Text"], Cell[118554, 3599, 392, 7, 91, "Input"], Cell[CellGroupData[{ Cell[118971, 3610, 231, 5, 91, "Input"], Cell[119205, 3617, 237, 6, 45, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[119491, 3629, 94, 3, 82, "Section"], Cell[119588, 3634, 725, 16, 150, "Text"], Cell[CellGroupData[{ Cell[120338, 3654, 73, 1, 31, "Input"], Cell[120414, 3657, 706, 12, 169, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[121157, 3674, 42, 1, 27, "Input"], Cell[121202, 3677, 239, 3, 27, "Output"] }, Open ]], Cell[121456, 3683, 54, 0, 31, "Text"], Cell[CellGroupData[{ Cell[121535, 3687, 98, 2, 31, "Input"], Cell[121636, 3691, 158, 3, 78, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[121831, 3699, 42, 1, 24, "Input"], Cell[121876, 3702, 126, 2, 52, "Output"] }, Open ]], Cell[122017, 3707, 128, 3, 47, "Text"], Cell[122148, 3712, 299, 5, 68, "Text"], Cell[CellGroupData[{ Cell[122472, 3721, 108, 2, 27, "Input"], Cell[122583, 3725, 2178, 40, 1723, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[124798, 3770, 42, 1, 27, "Input"], Cell[124843, 3773, 222, 3, 27, "Output"] }, Open ]], Cell[125080, 3779, 162, 4, 48, "Text"], Cell[CellGroupData[{ Cell[125267, 3787, 65, 1, 27, "Input"], Cell[125335, 3790, 842, 14, 197, "Output"] }, Open ]], Cell[126192, 3807, 180, 5, 48, "Text"], Cell[CellGroupData[{ Cell[126397, 3816, 119, 3, 27, "Input"], Cell[126519, 3821, 158, 3, 47, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[126726, 3830, 68, 0, 57, "Section"], Cell[126797, 3832, 568, 13, 116, "Text"], Cell[127368, 3847, 641, 11, 155, "Input"], Cell[128012, 3860, 35, 0, 31, "Text"], Cell[CellGroupData[{ Cell[128072, 3864, 174, 3, 45, "Input"], Cell[128249, 3869, 480, 11, 135, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[128766, 3885, 73, 1, 27, "Input"], Cell[128842, 3888, 488, 9, 43, "Output"] }, Open ]], Cell[129345, 3900, 90, 3, 31, "Text"], Cell[CellGroupData[{ Cell[129460, 3907, 69, 1, 27, "Input"], Cell[129532, 3910, 488, 9, 43, "Output"] }, Open ]] }, Open ]], Cell[CellGroupData[{ Cell[130069, 3925, 40, 0, 57, "Section"], Cell[130112, 3927, 615, 13, 168, "Text"], Cell[130730, 3942, 71, 1, 29, "Input"], Cell[130804, 3945, 324, 10, 65, "Text"], Cell[CellGroupData[{ Cell[131153, 3959, 81, 1, 27, "Input"], Cell[131237, 3962, 113, 2, 81, "Output"] }, Open ]], Cell[131365, 3967, 924, 29, 96, "Text"], Cell[132292, 3998, 65, 1, 29, "Input"], Cell[132360, 4001, 472, 11, 82, "Text"], Cell[CellGroupData[{ Cell[132857, 4016, 147, 2, 66, "Input"], Cell[133007, 4020, 110, 2, 77, "Output"], Cell[133120, 4024, 114, 2, 54, "Output"] }, Open ]], Cell[133249, 4029, 518, 13, 96, "Text"], Cell[CellGroupData[{ Cell[133792, 4046, 337, 8, 61, "Input"], Cell[134132, 4056, 78, 1, 54, "Output"], Cell[134213, 4059, 47, 1, 70, "Output"], Cell[134263, 4062, 65, 1, 46, "Output"] }, Open ]], Cell[134343, 4066, 564, 17, 65, "Text"], Cell[CellGroupData[{ Cell[134932, 4087, 275, 6, 47, "Input"], Cell[135210, 4095, 87, 1, 44, "Output"], Cell[135300, 4098, 328, 5, 146, "Output"] }, Open ]], Cell[135643, 4106, 139, 6, 31, "Text"], Cell[CellGroupData[{ Cell[135807, 4116, 91, 1, 27, "Input"], Cell[135901, 4119, 651, 11, 319, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[136589, 4135, 72, 1, 24, "Input"], Cell[136664, 4138, 43, 1, 27, "Output"] }, Open ]], Cell[136722, 4142, 762, 22, 99, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[137521, 4169, 37, 0, 57, "Section"], Cell[137561, 4171, 659, 21, 65, "Text"], Cell[138223, 4194, 73, 1, 27, "Input"], Cell[138299, 4197, 4471, 145, 99, "Text"], Cell[CellGroupData[{ Cell[142795, 4346, 253, 5, 75, "Input"], Cell[143051, 4353, 114, 2, 29, "Output"] }, Open ]], Cell[143180, 4358, 578, 27, 48, "Text"], Cell[CellGroupData[{ Cell[143783, 4389, 64, 1, 27, "Input"], Cell[143850, 4392, 53, 1, 27, "Output"] }, Open ]], Cell[143918, 4396, 976, 34, 65, "Text"], Cell[CellGroupData[{ Cell[144919, 4434, 136, 2, 43, "Input"], Cell[145058, 4438, 71, 1, 46, "Output"], Cell[145132, 4441, 35, 1, 27, "Output"] }, Open ]], Cell[145182, 4445, 1584, 50, 201, "Text"], Cell[CellGroupData[{ Cell[146791, 4499, 209, 5, 43, "Input"], Cell[147003, 4506, 90, 1, 29, "Output"], Cell[147096, 4509, 482, 8, 140, "Output"] }, Open ]], Cell[147593, 4520, 1339, 47, 31, "Text"], Cell[148935, 4569, 158, 2, 59, "Input"], Cell[149096, 4573, 143, 6, 31, "Text"], Cell[CellGroupData[{ Cell[149264, 4583, 232, 4, 59, "Input"], Cell[149499, 4589, 8612, 137, 2683, "Output"] }, Open ]], Cell[158126, 4729, 253, 8, 48, "Text"], Cell[CellGroupData[{ Cell[158404, 4741, 217, 5, 59, "Input"], Cell[158624, 4748, 38, 1, 27, "Output"], Cell[158665, 4751, 38, 1, 27, "Output"] }, Open ]], Cell[158718, 4755, 111, 4, 31, "Text"], Cell[CellGroupData[{ Cell[158854, 4763, 440, 8, 91, "Input"], Cell[159297, 4773, 363, 6, 43, "Output"], Cell[159663, 4781, 363, 6, 43, "Output"], Cell[160029, 4789, 363, 6, 43, "Output"], Cell[160395, 4797, 365, 6, 43, "Output"] }, Open ]], Cell[160775, 4806, 762, 21, 150, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[161574, 4832, 41, 0, 57, "Section"], Cell[161618, 4834, 1264, 34, 201, "Text"], Cell[CellGroupData[{ Cell[162907, 4872, 65, 1, 27, "Input"], Cell[162975, 4875, 89, 1, 39, "Output"] }, Open ]], Cell[163079, 4879, 112, 4, 31, "Text"], Cell[CellGroupData[{ Cell[163216, 4887, 129, 3, 27, "Input"], Cell[163348, 4892, 73, 1, 35, "Output"] }, Open ]], Cell[163436, 4896, 57, 0, 31, "Text"], Cell[CellGroupData[{ Cell[163518, 4900, 117, 3, 59, "Input"], Cell[163638, 4905, 152, 2, 43, "Output"], Cell[163793, 4909, 154, 2, 43, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[163984, 4916, 44, 1, 27, "Input"], Cell[164031, 4919, 161, 3, 43, "Output"] }, Open ]], Cell[164207, 4925, 218, 5, 65, "Text"], Cell[CellGroupData[{ Cell[164450, 4934, 119, 3, 27, "Input"], Cell[164572, 4939, 53, 1, 35, "Output"] }, Open ]], Cell[CellGroupData[{ Cell[164662, 4945, 240, 6, 75, "Input"], Cell[164905, 4953, 73, 1, 35, "Output"], Cell[164981, 4956, 152, 2, 43, "Output"], Cell[165136, 4960, 161, 3, 43, "Output"] }, Open ]], Cell[165312, 4966, 270, 5, 82, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[165619, 4976, 65, 0, 82, "Section"], Cell[165687, 4978, 1303, 19, 371, "Text"], Cell[166993, 4999, 1043, 18, 347, "Input"], Cell[168039, 5019, 35, 0, 31, "Text"], Cell[168077, 5021, 250, 6, 68, "Input"], Cell[CellGroupData[{ Cell[168352, 5031, 155, 3, 59, "Input"], Cell[168510, 5036, 70, 1, 27, "Output"], Cell[168583, 5039, 69, 1, 27, "Output"], Cell[168655, 5042, 38, 1, 27, "Output"] }, Open ]], Cell[168708, 5046, 253, 6, 68, "Input"], Cell[168964, 5054, 158, 3, 59, "Input"], Cell[CellGroupData[{ Cell[169147, 5061, 155, 3, 59, "Input"], Cell[169305, 5066, 69, 1, 27, "Output"], Cell[169377, 5069, 57, 1, 27, "Output"], Cell[169437, 5072, 38, 1, 27, "Output"] }, Open ]], Cell[169490, 5076, 82, 1, 27, "Input"] }, Open ]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)