%!PS % Basic Laplacian exploration % =================================== % by Don Lancaster % Interim internal code -- can be improved on request. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Copyright c 2003 by Don Lancaster & Synergetics, Box 809, Thatcher, AZ, 85552 % (928) 428-4073 Email: don@tinaja.com Website: http://www.tinaja.com % Consulting services available http://www.tinaja.com/info01.html % All commercial rights and all electronic media rights ~fully~ reserved. % Linking usually welcome. Reposting expressly forbidden. Version 1.1 % Exploring Laplacian solution per field theory first example % ========= % IMPORTANT NOTE: Don Lancaster's file gonzo.ps is required for this program. % After obvious location mods, uncomment ONE of the following two lines: (C:\\windows\\desktop\\gonzo\\gonzo.ps) run % use internal gonzo % (A:\\gonzo.ps) run % use external gonzo % NOTE THAT ALL PS FILENAME STRINGS !!!DEMAND!!! DOUBLE REVERSE SLASHES. % GONZO20A Guru Gonzo PostScript power tools (Interim release) % Includes gonzo justification and layout utilities. % Copyright c 1990, 1996, 2001 by Don Lancaster and Synergetics, Box 809, % Thatcher Arizona, 5552 (928) 428-4073 don@tinaja.com support % via http://www.tinaja.com All commercial rights and all electronic % media rights **FULLY** reserved. Reposting is expressly forbidden. % ======== /guru { gonzo begin ps.util.1 begin printerror nuisance begin} def guru % activate gonzo utilities % ========= % A space with zero bottom potential, zero side potential and a sinusodial top potential.... -2 vmreclaim /y0 [ 0 0 0 0 0 ] store /y1 [ 0 50 150 300 707 ] store /y2 [ 0 100 200 500 1000 ] store /y1 [0 0 0 0 707]store /y2 [0 0 0 0 1000] store /field [ y0 y1 y2 y1 ] store % make a fancy field /linpoints 10 pop 30 store /field mark 0 1 linpoints 2 mul {/nn exch store mark linpoints 1 sub {0} repeat 90 linpoints div nn mul sin 1000 mul ] } for ] store field {==} forall (\n\n\n\n) print flush /quadavg { /carrayposn exch store field carrayposn get /curarray exch store mark curarray 0 get 1 1 curarray length 2 sub { /cpos exch store field carrayposn get cpos 1 sub get field carrayposn get cpos 1 add get field carrayposn 1 sub get cpos get field carrayposn 1 add get cpos get add add add 4 div } for curarray dup length 1 sub get ] field exch carrayposn exch put } store /evaluatepotential { numtrips { 1 1 field length 2 sub {quadavg %%%% field {==} forall } for field 8 get 8 get == } repeat } store /numtrips 1500 store /oldfield field store (\n\n\n) print flush evaluatepotential field {==} forall (\n\n\n\n\n\n\n) print flush % double the field? { /doublefield { mark field { mark exch { dup } forall ] dup } forall ] /field exch store } store } pop % Field doubler quadruples sample points by interpolation /doublefield { doublev doubleh } store /doublev {mark 1 1 field length 1 sub {/ptr exch store field ptr 1 sub get /pre exch store field ptr get /post exch store pre % place early on stack mark 0 1 pre length 1 sub {/ii exch store pre ii get post ii get add 2 div } for ] % create tween array } for post ] /field exch store } store /doubleh {mark 0 1 field length 1 sub {/jj exch store mark field jj get /cura exch store 1 1 cura length 1 sub {/kk exch store cura kk 1 sub get dup cura kk get add 2 div } for cura dup length 1 sub get ] } for ] /field exch store } store doublefield /numtrips 400 pop 40 store evaluatepotential (\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n) print flush field {==} forall (\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n) print flush (\n\n\n\n\n) print flush doublefield /numtrips 100 pop 20 store evaluatepotential (\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n) print flush field {==} forall (\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n) print flush %%% plot the field /adjtint { 1000 sub abs 1000 div 0.66667 mul } store /plotfield {/sf exch store gsave translate sf dup scale field length /vsize exch store field 0 get length /hsize exch store 0 1 vsize 1 sub { /vpos exch store 0 1 hsize 1 sub { /hpos exch store vpos hpos moveto 1 pd 1 pr 1 pu closepath field vpos get hpos get adjtint 0.7 1 sethsbcolor fill } for % each horizontal pixel } for % each row grestore } store % demo - remove or alter before reuse 100 100 1 plotfield % gsave 400 0 translate -1 1 scale 0 100 5 plotfield grestore % sneaky mirror? /trytrace { /trial exch store 0 setgray 0.15 setlinewidth /firstun true store 0 1 field length 1 sub { /ccc exch store field ccc get /curr exch store 0 1 curr length 1 sub {/mmm exch store curr mmm get trial gt { exit} if } for interpolatemmm ccc mmm firstun {moveto}{lineto} ifelse /firstun false store } for stroke } store /interpolatemmm { curr mmm get curr mmm 1 sub get sub dup 0 eq {pop 0.0001} if % no zero width /fullinc exch store % full increment curr mmm get trial sub dup 0 lt {pop 0} if % no missed /fractinc exch store fractinc fullinc div mmm exch sub /mmm exch store } store gsave 100 100 translate [100 200 300 400 500 600 700 800 900 1000] {trytrace} forall % attempt a gradient calculates and moves a unit vector in array dimension space % currently 240 x120 ? /findunitgrad { field hhh cvi get vvv cvi get dup % nearest value field hhh 1 add cvi get vvv cvi get % x change sub exch field hhh cvi get vvv 1 add cvi get sub % y change exch dup 0 eq {pop 0.000025} if atan % go downhill? dup == dup cos hhh add /hhh exch store sin vvv add /vvv exch store hhh 0 le hhh field length 1 sub ge or {exit} if vvv 0 le hhh field 0 get length 1 sub pop 240 ge or {exit} if hhh vvv lineto } store /topp {field 0 get length 2 sub} store /hhh 80.1 store /vvv 115 store % huh - can't quite reach top [10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190] {/hhh exch store /vvv 115 store hhh vvv moveto 200 {findunitgrad} repeat stroke} forall % 30 field 2x = 30+29=59 +58= 117 % 60 field 2x = 60+59=119+118= 237 /fieldhi 117 store /fieldwi 241 store /showblank true store /emptyfield {save /mtsnap exch store gsave translate showblank { 0 -1 mt fieldhi pu fieldwi pr fieldhi pd closepath aqua 0.85 setgray fill} if black 0.3 setlinewidth 0 -3.5 mt fieldhi 3 add u -0.5 0 mt fieldwi 1 add r fieldwi -3.5 mt fieldhi 3 add u /cstretch 0 store /sstretch 0 store /kern 1 store /font- /Symbol 10 gonzofont /font1 /Helvetica 10 gonzofont font- black 0 -13(|1(x|j=|-|j0|j)) cc fieldwi -13 (|1(|jx|j=|j|-p|j)) cc fieldwi 2 div fieldhi 4 add (|-f|1|j=|j1000|j|jsin|j(|jx|j) volts) cc fieldwi 2 div -13 (|1zero volts) cc gsave -5 fieldhi 2 div translate 90 rotate 0 0 (|1zero volts) cc grestore gsave fieldwi 12 add fieldhi 2 div translate 90 rotate 0 0 (|1zero volts) cc grestore grestore mtsnap restore} store % 0 0 emptyfield showpage % EOF