%! % A POSTSCRIPT HEAP SORT UTILITY AND DEMO FOR SUBARRAYS % ==================================================== % by Don Lancaster % Modified to search on subarrays % This is the companion heapsort test code to http://www.tinaja.com/glib/heapsort.pdf % Additional support at http://www.tinaja.com and don@tinaja.com (928) 428-2073. % To use, modify as desired, save as standard ASCII text file and send to Acrobat Distiller. % Use of gonzo utilities are strongly recommended but not essential. % See http://www.tinaja.com/post01.asp % (C:\\windows\\desktop\\gonzo\\gonzo.ps) run % use internal gonzo % (A:\\gonzo.ps) run % use external gonzo /guru { gonzo begin ps.util.1 begin printerror nuisance begin} def % Uncomment next line if gonzo is in use % guru % activate gonzo utilities % Stopwatch utilities extracted from Gonzo... % ============================ % timing utilities. use stopwatchon and stopwatchoff for simple % one shot timing. For multiple time totals, use resettimer % starttimer stoptimer ... starttimer stoptimer reporttimer /stopwatchoff {stoptimer reporttimer} def % for single shots /stopwatchon {resettimer starttimer} def % for single shots /reporttimer {mytime 1000 div (\rElapsed time: ) print 20 string cvs print ( seconds.\r) print flush} def % to host /resettimer {/mytime 0 def} def % reset timer /starttimer {usertime /mytimenow exch def} def % add to time so far /stoptimer {usertime mytimenow sub /mytime exch mytime add def} def % for multiple timing intervals % ========================== % Mergestr utility extracted from Gonzo... % mergestr merges the two top stack strings into one top stack string /mergestr {2 copy length exch length add string dup dup 4 3 roll 4 index length exch putinterval 3 1 roll exch 0 exch putinterval} def % ========================== % /upchuck checks child versus parent and repeatedly swaps UP /upchuck { /cposn hposn store {/pposn cposn 2 idiv store pposn 0 le {exit} if heap cposn get heap pposn get % checkforswap 2 copy arraysamp gt {heap exch cposn exch put % reallyswap heap exch pposn exch put} {pop pop exit} ifelse /cposn pposn store % up one triad } loop } bind store % /fillheap orders the strings into a binary tree heap array. Heap fills from top % to bottom, left to right. Highest value is always at the TOP of any data triad. % Top of any array data triad address is either lowleft 2 idiv or (identically) % lowright 2 idiv. % makeheap previously at 4.17 milliseconds for 273 strings. repeat loop timing = 0. /fillheap {/hposn 1 store stddat { % heap exch hposn exch put % place in next avail opening % arraysamp % pick sort subarray (!) %%%%%%%%%%%%%%%%% inline upchuck routine %%%%%%%%%%%%%%% % we have child as pposn on stack /cposn hposn store % cposn is initially hposn {/pposn cposn 2 idiv store % parent position pposn 0 le { heap exch cposn exch put % got to top? exit } if % store child and exit heap pposn get % checkforswap 2 copy arraysamp ge { % needed heap exch cposn exch put} % hold old child as parent {pop heap exch cposn exch put % save child flush parent exit exit} ifelse /cposn pposn store % up one triad } loop %%%%%%%%%%%%%%%%%% end upchuck %%%%%%%%%%%%%%%%%%%%%%%%%% /hposn hposn 1 add store} forall % reset opening and repeat % exit hposn is high by one } bind store % /emptyheap removes the highest strings in order by removing the first element. % Last element becomes first then downchucks as far as needed to preserve efficient % filed binary tree with each data triad highest value at top. Array address of % leftchild is parent*2. Array address of rightchild is (parent*2)+1 or leftchild+1. % /downchuck checks triads and places the largest on the top, swapping top with largest. /lefttriadposn 1 store /downchuck { heap exch 1 exch put % temporary save of last item /lefttriadposn 1 store { /lefttriadposn lefttriadposn 2 mul store % pick rank of lefttriad position lefttriadposn h1posn 1 sub ge {exit} if % exit if all the way through lefttriadposn dup h1posn 1 sub ne % are we NOT at the last string? { % is right triad bigger? heap lefttriadposn get heap lefttriadposn 1 add get le {1 add} if } if /swapme exch store % correct to exact position heap swapme get heap lefttriadposn 2 idiv get 2 copy arraysamp lt % true=done false=swap {pop pop exit} {heap exch swapme exch put heap exch lefttriadposn 2 idiv exch put } ifelse /lefttriadposn swapme store % right-left shift? % uncomment for more detailed analysis % reportstuff } loop } bind store /h1posn 9999 store % temp marker /reportstuff { (\n\n**%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n) print (hposn: ) hposn 20 string cvs mergestr ( h1posn: ) mergestr h1posn 20 string cvs mergestr ( maybe: ) mergestr maybe 20 string cvs mergestr (\n) mergestr print heap == } store % new downchuck enter with top candidate on stack /basecheck {heap maybe get % get left point heap maybe 1 add get % get right point arraysamp lt {/maybe maybe 1 add store} if % set address of larger point heap maybe get % get correct swapee } store /swapcheckold {2 copy arraysamp lt % apex and heap on stack { heap exch apex exch put dup % save next apex heap exch maybe exch put} % save apex to maybe {pop pop exit} ifelse % no swap needed, done, exit } store /basecheck { heap maybe get % get left point heap maybe 1 add get % get right point arraysamp lt {/maybe maybe 1 add store} if % set address of larger point heap maybe get % get correct swapee } bind def { /basechecknew { heap maybe get % get left point heap maybe 1 add get % get right point 2 copy arraysamp lt {/maybe maybe 1 add store exch} if % set address of larger point pop % get correct swapee } bind def } pop % slightly slower so not used one get is faster than a 2 copy + exch /downchuck { /apex 1 store { /maybe apex 2 mul store % calculate lower left maybe h1posn 2 sub le % full triad available? { basecheck % find larger base %%%%%%%%% swapcheck 2 copy arraysamp lt { % is a swap needed? heap exch apex exch put % yes, swap and save apex } {pop heap exch apex exch % no, save apex only and exit put exit} ifelse %%%%%%%%% } {maybe h1posn 1 sub eq % left only available? {heap maybe get %%%%%%%%% 2 copy arraysamp le { % is a swap needed? heap exch apex exch put % yes, swap and save apex } {pop heap exch apex exch % no, save apex only and exit put exit} ifelse %%%%%%%%% } % yes, process {heap exch apex exch put exit} ifelse % no, save apex only and exit } ifelse /apex maybe store % reset apex for next triad down } loop } bind store % new emptyheap /emptyheap { hposn 1 sub -1 2 {/h1posn exch store % loop through all strings heap h1posn get % end item to stack heap 1 get % get highest value from apex heap exch h1posn exch put % place at end downchuck % rework heap triads } for } bind store %%%%%%%%%%%%%%%%%% actual demo starts here %%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% /stddat [[(110.159.132.36) (/glib/muse145.pdf) (302)] [(110.159.132.36) (/glib/muse145.pdf) (200)] [(110.159.132.36) (/favicon.ico) (200)] [(116.179.32.177) (/canal/field_notes/cluffnw1fn.pdf) (200)] [(160.3.101.15) (/stats/) (302)] [(160.3.101.15) (/stats/index.html) (200)] [(160.3.101.15) (/stats/usage.png) (200)] [(160.3.101.15) (/stats/daily_usage_202109.png) (200)] [(160.3.101.15) (/stats/usage_202109.html) (200)] [(160.3.101.15) (/stats/hourly_usage_202109.png) (200)] [(168.119.140.252) (/psutils/tuna2.pdf) (200)] [(168.119.140.252) (/canal/images/log/hc072_thunder4.shtml) (200)] [(168.119.140.252) (/canal/canaleng1x.js) (200)] [(168.119.140.252) (/glib/p3anim01.pdf) (200)] [(168.119.140.252) (/canal/images/Image_Directory/water22.shtml)(200)] [(168.119.140.252) (/psutils/clams.pdf) (200)] [(168.119.140.252) (/glib/level2.1.psl) (200)] [(168.119.140.252) (/canal/index/alberto26.shtml) (200)] [(168.119.140.252) (/third/vcrplus.pdf) (200)] [(168.119.140.252) (/psweb01.shtml) (200)] [(168.119.140.252) (/canal/index/marysfb07.shtml) (200)] [(168.119.140.252) (/glib/enhebay2.pdf) (200)] [(168.119.140.252) (/web_catalog/web_png_directory1.txt) (404)] [(168.119.140.252) (/muse01.asp) (200)] [(168.119.140.252) (/text/bodcat.html) (200)] [(168.119.140.252) (/glib/pop_elec/timbre_and_voice_6_75.pdf) (200)] [(168.119.140.252) (/bmfonts/f912bg.psl) (200)] [(168.119.140.252) (/glib/g9demoyx.pdf) (200)] [(170.106.202.8) (/ebooks/TTLCB1.pdf) (200)] [(193.189.143.198) (/whtnu.xml) (200)] [(193.189.143.198) (/whtnu.xml) (302)] [(221.6.38.170) (/) (302)] [(221.6.38.170) (/) (200)] ] store %%%%%% end data %%%%%%%%%%%%%%%%% %/arraysamp {} store % uncomment as needed %/arraysamp {exch 0 get exch 0 get} store /arraysamp {exch 1 get exch 1 get} store %/arraysamp {exch 2 get exch 2 get} store stddat length == % report strings being tested /heap stddat length 1 add array store stopwatchon 1000 { fillheap emptyheap } repeat stopwatchoff (\n\n) print heap {==} forall /removenull { heap 1 heap length 2 sub getinterval /heap1a exch store} store removenull (\n\n) print heap1a {==} forall % EOF