home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 4 / 64er_Magazin_Sonderheft_04_86-04_1986_Markt__Technik_de_Disk_1_of_2_Side_A.d64 / super-sorter (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  5KB  |  154 lines
  1. 0 rem ********************************
  2. 1 rem *    sortierprogramm fuer      *
  3. 2 rem *      relative dateien        *
  4. 3 rem *       <c> 1985 bei           *
  5. 4 rem *      michael nickles         *
  6. 5 rem ********************************
  7. 100 m%=300    :rem groesse des puffers
  8. 105 n%=m%     :rem wert von m% speichern
  9. 110 dimm$(m%) :rem puffer fuer saetze
  10. 120 dimms(m%) :rem puffer fuer zahlen
  11. 130 dimlg(100),rg(100):z=0:lg(1)=1:rg(1)=m%           :rem fuer quicksort
  12. 200 rem anfangsmenue -----------------------------------------------------------
  13. 201 :
  14. 205 poke53280,0:poke53281,0:print"[147]";
  15. 210 print"      rel.datei sortierprogramm         [146]";
  16. 215 print"         von michael nickles            [146]"
  17. 220 input"dateiname ";n$
  18. 230 open15,8,15:rem floppykanal auf
  19. 235 print#15,"i0":rem initialisieren
  20. 240 open1,8,3,n$ :rem rel.datei oeffnen
  21. 250 input#15,a,b$:rem fehlerabfrage
  22. 254 ifa<>0thenprint"error[146]  ";b$:end
  23. 270 print"        g[146]anze datei sortieren
  24. 275 [153]"        twaiteilbereich sortieren
  25. 277 print"        l[146]esen
  26. 280 [161]i$:[139]i$[179][177]"g"[175]i$[179][177]"t"[175]i$[179][177]"l"[167]280
  27. 281 [139]i$[178]"l"[167]10000
  28. 285 [139]i$[178]"g"[167]an[178]1:[137]290
  29. 286 [153]"bitte geben sie anfang und ende des     bereiches an, der sortiert";
  30. 287 [153]" werden soll!"
  31. 288 [133]"anfang ";an
  32. 289 [133]"ende   ";en:[139]an[177]en[167][153]"unsinn!":[137]295
  33. 290 [153]"bitte geben sie an, nach welchem string-bereich die sortierung
  34. 291 print"erfolgem soll!"
  35. 292 input"von zeichen ";zl
  36. 293 input"bis zeichen ";zr
  37. 295 zr=zr-zl+1
  38. 300 rem sortiervorgang anfang --------------------------------------------------
  39. 301 :
  40. 305 ti$="000000"     :rem zeit auf 0
  41. 310 zd=an            :rem zeiger setzen
  42. 320 zp=1             :rem pufferzeiger
  43. 325 sa=zd:gosub9000:gosub9100                                :rem 1.satz lesen
  44. 330 vg$=a$           :rem vergl.satz
  45. 400 rem die m% kleinesten elemente von satz zd bis letzten satz suchen----------
  46. 401 :
  47. 402 print"";zp;"[157]. durchlauf    [146]"
  48. 410 sa=zd+1:rem ----- begin loop -----
  49. 411 printsa,a$       :rem supermike
  50. 430 :gosub9000       :rem positionieren
  51. 431 ifa=50thenm%=sa-zd:en=sa:goto500                               :rem end loop
  52. 432 ifsa=en+1then500                                         :rem end loop
  53. 435 :gosub9100       :rem a$ lesen
  54. 440 :ifmid$(a$,zl,zr)>mid$(vg$,zl,zr)ora$="@"then460
  55. 445 : vg$=a$         :rem neuer vg$
  56. 450 : mm=sa          :rem satznr. merken
  57. 460 sa=sa+1          :rem next satz
  58. 465 goto411:rem ----- cont loop  -----
  59. 470 :
  60. 500 rem kleinstes element im bereich zd bis zd+m$ = vg$ wurde gefunden ---------
  61. 501 :
  62. 510 sa=mm:gosub9000:a$="@":gosub9200                       :rem satz mm loeschen
  63. 520 m$(zp)=vg$:ms(zp)=mm                                   :rem puffer fuellen
  64. 530 zp=zp+1        :rem puffer-zeiger+1
  65. 540 ifzp>m%then600 :rem puffer voll
  66. 550 rem neuen vg$ suchen
  67. 555 sa=zd
  68. 560 gosub9000:gosub9100:ifa$="@"thensa=sa+1:goto560
  69. 565 vg$=a$:mm=sa
  70. 570 goto400
  71. 600 rem puffer ist jetzt voll --------------------------------------------------
  72. 601 :
  73. 610 print"pufferinhalt[146]":fori=1tom%:printm$(i),ms(i):nexti:rem supermike
  74. 620 rem ms(1)-ms(m%) wird jetzt mit quicksort sortiert -------------------------
  75. 621 :
  76. 625 gosub30000:rem aufruf quicks.up
  77. 630 print"sortierter nummerpuffer[146]":fori=1tom%:printms(i):next:rem supermike
  78. 650 rem neuen pufferzeiger setzen ----------------------------------------------
  79. 651 :
  80. 655 zp=1
  81. 660 ifms(zp)<zd+m%thenzp=zp+1:goto660
  82. 670 print"zp=";zp       :rem supermike
  83. 700 rem platz fuer puffer schaffen ---------------------------------------------
  84. 701 :
  85. 710 fori=zdtozd+m%-1
  86. 720 :sa=i:gosub9000:gosub9100                              :rem a$ lesen
  87. 729 printa$        :rem supermike
  88. 730 :ifa$="@"then760
  89. 740 :  sa=ms(zp):gosub9000:gosub9200                       :rem luecke fuellen
  90. 745 :  zp=zp+1     :rem p.zeiger +1
  91. 760 nexti
  92. 800 rem puffer zurueckschreiben ------------------------------------------------
  93. 801 :
  94. 810 sa=zd
  95. 820 : fori=1tom%
  96. 830 :   a$=m$(i)
  97. 831 :   printa$          :rem supermike
  98. 840 :   gosub9000:gosub9200
  99. 850 :   sa=sa+1
  100. 860 : nexti
  101. 900 rem naechsten sortiervorgang vorbereiten------------------------------------
  102. 901 :
  103. 910 ifm%<>n%oro%thenprint"sortierzeit: ";ti$:print"*** fertig ***":close15:end
  104. 920 zd=zd+m%:rem dateizeiger erhoehen
  105. 924 zp=1    :rem pufferzeiger auf 1
  106. 925 sa=zd
  107. 926 gosub9000:gosub9100:ifa$="@"thensa=sa+1:goto560
  108. 927 vg$=a$:mm=sa
  109. 930 ifm%>en-zdthenm%=en-zd
  110. 935 ifm%=en-zdtheno%=1
  111. 950 goto400 :rem naechste sortierrunde
  112. 9000 rem positionieren ***************
  113. 9001 :
  114. 9010 : hb%=sa/256:lb%=sa-hb%*256
  115. 9020 : print#15,"p";chr$(3);chr$(lb%);chr$(hb%);chr$(1)
  116. 9030 : input#15,a:rem fehlerabfrage
  117. 9040 return
  118. 9100 rem satz lesen    ***************
  119. 9101 :
  120. 9110 : ifa=50thenreturn: rem fehler
  121. 9120 : input#1,a$
  122. 9130 return
  123. 9200 rem satz schreiben **************
  124. 9201 :
  125. 9210 : print#1,a$
  126. 9230 return
  127. 10000 rem datei lesen ----------------------------------------------------------
  128. 10001 :
  129. 10010 print"lesen / ende[146]"
  130. 10015 geti$:ifi$<>"l"andi$<>"e"then10015
  131. 10020 ifi$="e"thenprint"[147]":goto270
  132. 10030 input"satznummer ";ia
  133. 10034 print"satz";ia;"[157]-";ia+20;"[146]"
  134. 10035 forsa=iatoia+20
  135. 10040 : gosub9000:gosub9100
  136. 10050 : iflen(a$)<40thenprinta$
  137. 10060 : iflen(a$)>=40thenprinta$;
  138. 10070 nextsa
  139. 10080 goto10010
  140. 30000 rem  quicksort -----------------------------------------------------------
  141. 30001 rg(1)=m%
  142. 30010 z=z+1:iflg(z)>=rg(z)then30120
  143. 30020 x=lg(z):y=rg(z)
  144. 30030 vg=ms(int((x+y)/2))
  145. 30040 if x>y then30100
  146. 30050 if ms(x)<vgthenx=x+1:goto30050
  147. 30060 if ms(y)>vgtheny=y-1:goto30060
  148. 30070 if x>ythen30100
  149. 30080 s=ms(x):ms(x)=ms(y):ms(y)=s
  150. 30090 x=x+1:y=y-1:goto30040
  151. 30100 rg(z+1)=y:lg(z+1)=lg(z):gosub30010
  152. 30110 lg(z+1)=x:rg(z+1)=rg(z):gosub30010
  153. 30120 z=z-1:return
  154.