10 REM ++++++++++++++++++++++++++++++++
11 REM + Program....      SORTERA.BAS
12 REM + Version 1.0      84.09.23
13 REM + (c) Copyright Sigvard Nilsson
14 REM + Minne 16 Kbytes
15 REM + Ins{nt av 3018
16 REM ++++++++++++++++++++++++++++++++
17 REM 
18 REM SORTERINGSTEST - SE PERSONDATORN
19 REM NR 6 SEPTEMBER 1984
20 REM Anpassat / modifierat f|r ABC80.
21 REM Program som pr|var hur effektivt
22 REM olika sorteringsalgoritmer kan
23 REM utf|ra en sortering.
24 REM 
25 REM 
180 ; CHR$(12%) : ONERRORGOTO 180 : N%=0%
190 ; '           Sorteringstest.'
200 ; '           =============='
210 ; : ; 'Med detta program kan Du direkt under-' : ; 's|ka skillnaden i snabbhet mellan'
220 ; 'olika sorteringsalgoritmer.'
230 ; : ; 'Programmet tar sj{lv tid p} sorterings-' : ; 'proceduren.'
240 ; : ; : ; 'F|rst skapas ett antal slumpvis bildade "ord" '
250 ; : ; 'Hur m}nga ord skall sorteras ?          (Max 600)'; : INPUT N%
260 DIM A$(N%)=7%,B$(N%)=7%
270 DEFFNU(I)=INT(I)-(I<>INT(I))
280 REM ++++++++++++++++++++++++++++
290 REM ++ Bilda ord att sortera  ++
300 REM ++++++++++++++++++++++++++++
310 ; : ; 'V [ N T A !     Ordf|rr}det byggs upp.'
320 FOR I%=1% TO N% : A$="" : A$=CHR$(RND*28%+65%) : FOR J%=1% TO RND*4%+2% : A$=A$+CHR$(RND*28%+97%) : NEXT J%
330 A$(I%)=A$ : B$(I%)=A$ : NEXT I% : ; 
340 ; : ; 'K L A R T !' : ; CHR$(7%)
350 FOR F=1 TO 2000 : NEXT F : ; CHR$(12%)
360 ; '  S O R T E R I N G .'
370 ; '  =================='
380 ; : ; 'Nu sorteras';N%;'  ord'
390 ; 'V{lj metod genom att ange en siffra'
400 ; : ; '      1.  BUBBLE-sortering'
410 ; : ; '      2.  URVALS-sortering'
420 ; : ; '      3.  DELAYED REPLACEMENT-sortering'
430 ; : ; '      4.  BATCHER-sortering'
440 ; : ; '      5.  SHELL-METZNER-sortering'
450 ; : ; '      6.  QUICKSORT.'
460 ; : ; 'V[LJ METOD (1-6)   '; : INPUT G%
470 IF G%<1% OR G%>6% THEN 460
480 ; : ; 'S O R T E R I N G   P ] G ] R !'
490 REM ++++++++++++++++++++++++
500 REM ++ KLOCKAN NOLLST[LLS ++
510 REM ++++++++++++++++++++++++
520 POKE 65008%,-1%,-1%,-1%
530 REM 
540 ; CUR(G%*2+5%,7%)CHR$(127%)
550 ON G% GOSUB 610,730,930,1090,1230,1410
560 GOSUB 1950
570 GOSUB 2020
580 ; : ; 'Vill du pr|va en ny sorteringsalgoritm? (J)'; : GET A9$
590 IF A9$='J' OR A9$='j' THEN 350 ELSE ; 'Ok. Hoppas att du har haft trevligt!' : ; CHR$(12%) : END 
600 REM +++++++++++++++++++++
610 REM ++ BUBBLESORTERING ++
620 REM +++++++++++++++++++++
630 FOR I%=1% TO N%-1%
640 FOR J%=I%+1% TO N%
650 IF B$(I%)<B$(J%) 690
660 T$=B$(I%)
670 B$(I%)=B$(J%)
680 B$(J%)=T$
690 NEXT J%
700 NEXT I%
710 RETURN 
720 REM +++++++++++++++++++++
730 REM ++ URVALSSORTERING ++
740 REM +++++++++++++++++++++
750 I%=1%
760 GOTO 890
770 K%=I%
780 T$=B$(I%)
790 J%=I%+1%
800 IF B$(J%)>=T$ 830
810 T$=B$(J%)
820 K%=J%
830 J%=J%+1%
840 IF J%<=N% 800
850 T$=B$(K%)
860 B$(K%)=B$(I%)
870 B$(I%)=T$
880 I%=I%+1%
890 IF I%<N% 770
900 RETURN 
910 REM 
920 REM +++++++++++++++++++++++++++++++++++
930 REM ++ DELAYED REPLACEMENT-SORTERING ++
940 REM +++++++++++++++++++++++++++++++++++
950 J2%=0% : M2%=0% : L2%=0%
960 L2%=L2%+1%
970 IF L2%=N% RETURN 
980 J2%=L2%
990 M2%=J2%+1%
1000 IF B$(M2%)>B$(J2%) 1020
1010 J2%=M2%
1020 M2%=M2%+1%
1030 IF M2%<=N% 1000
1040 IF L2%=J2% 960
1050 T$=B$(J2%)
1060 B$(J2%)=B$(L2%)
1070 B$(L2%)=T$
1080 GOTO 960
1090 REM +++++++++++++++++++++++
1100 REM ++ BATCHER-SORTERING ++
1110 REM +++++++++++++++++++++++
1120 T%=FNU(LOG(N%)/LOG(2)) : P%=INT(2^(T%-1%))
1130 Q%=INT(2^(T%-1%)) : R%=0% : D%=P%
1140 S%=P% OR R% : G%=N%-D%-1% : FOR K%=R% TO G% STEP S%*2% : H%=K%+S%-1% : IF G%<H% THEN H%=G%
1150 FOR I%=K% TO H% : J%=I%+1%
1160 IF B$(J%)>B$(J%+D%) THEN T$=B$(J%) : B$(J%)=B$(J%+D%) : B$(J%+D%)=T$
1170 NEXT I%
1180 NEXT K%
1190 IF Q%<>P% THEN D%=Q%-P% : Q%=Q%/2 : R%=P% : GOTO 1140
1200 P%=INT(P%/2%) : IF P% 1130
1210 RETURN 
1220 REM ++++++++++++++++++++++++++++++
1230 REM ++ SHELL-METZNER-SORTERING ++
1240 REM ++++++++++++++++++++++++++++++
1250 M1%=N%
1260 M1%=INT(M1%/2%)
1270 IF M1%=0% RETURN 
1280 K7%=N%-M1%
1290 J1%=1%
1300 I1%=J1%
1310 L1%=I1%+M1%
1320 IF B$(I1%)<=B$(L1%) 1380
1330 T$=B$(I1%)
1340 B$(I1%)=B$(L1%)
1350 B$(L1%)=T$
1360 I1%=I1%-M1%
1370 IF I1%>=1% 1310
1380 J1%=J1%+1%
1390 IF J1%>K7% 1260
1400 GOTO 1300
1410 REM ++++++++++++++++++++
1420 REM ++ QUICKSORTERING ++
1430 REM ++++++++++++++++++++
1440 M3%=1%
1450 P%(M3%)=1%
1460 W%(M3%)=N%
1470 L3%=1%
1480 R3%=N%
1490 IF (R3%-L3%)<9% 1790
1500 I3%=L3%
1510 J3%=R3%
1520 IF B$(I3%)>B$(J3%) 1620
1530 J3%=J3%-1%
1540 IF J3%>I3% 1520
1550 J3%=J3%+1%
1560 M3%=M3%+1%
1570 IF (I3%-L3%)<(R3%-J3%) 1750
1580 P%(M3%)=L3%
1590 W%(M3%)=I3%
1600 L3%=J3%
1610 GOTO 1490
1620 T$=B$(J3%)
1630 B$(J3%)=B$(I3%)
1640 B$(I3%)=T$
1650 GOTO 1670
1660 IF B$(J3%)<B$(I3%) 1710
1670 I3%=I3%+1%
1680 IF J3%>I3% 1660
1690 J3%=J3%+1%
1700 GOTO 1560
1710 T$=B$(J3%)
1720 B$(J3%)=B$(I3%)
1730 B$(I3%)=T$
1740 GOTO 1530
1750 P%(M3%)=J3%
1760 W%(M3%)=R3%
1770 R3%=I3%
1780 GOTO 1490
1790 IF (R3%-L3%+1)=1% 1890
1800 FOR I3%=(L3%+1%) TO R3%
1810 FOR J3%=L3% TO (I3%-1%)
1820 J9=I3%-J3%+L3%-1%
1830 IF B$(J9)<=B$(J9+1%) 1880
1840 T$=B$(J9)
1850 B$(J9)=B$(J9+1)
1860 B$(J9+1%)=T$
1870 NEXT J3%
1880 NEXT I3%
1890 L3%=P%(M3%)
1900 R3%=W%(M3%)
1910 M3%=M3%-1%
1920 IF M3%=0% RETURN 
1930 GOTO 1490
1940 REM ++++++++++++++++++++++++++++++++
1950 REM ++ KLOCKAN L[SES - TIDTAGNING ++
1960 REM ++++++++++++++++++++++++++++++++
1970 T=(20*(255% XOR PEEK(-528%))+5120*(255% XOR PEEK(-527%))+1.31072E+6*(255% XOR PEEK(-526%)))/1000
1980 ; CHR$(12%)CUR(8,5)'Sorteringen tog :'
1990 ; CUR(10%,5%)'TIME ';T;' SEKUNDER'CHR$(7)
2000 REM 
2010 RETURN 
2020 REM ++++++++++++++++++++++
2030 REM ++ VISUELL KONTROLL ++
2040 REM ++++++++++++++++++++++
2050 E%=0%
2060 ; CUR(14%,5%)'Vill Du se p} de ord som testats?'
2070 ; CUR(16%,5%)'Tryck i s} fall p} RETURN'; : GET D$ : ; CHR$(12%)
2080 IF D$=CHR$(13%) THEN 2090 ELSE 2170
2090 ; 'Osorterat:',,'Sorterat:'
2100 ; '=========',,'==========' : ; 
2110 FOR I%=1% TO N% : ; A$(I%),,B$(I%)
2120 E%=E%+1%
2130 IF E%=15% THEN ; : ; ,'Tryck tangent'; : GET D$ : E%=0% : ; CHR$(12%) : ; 'Osorterat:',,'Sorterat:'
2140 IF E%=0% THEN ; '==========',,'==========' : ; 
2150 NEXT I%
2160 ; ,'Tryck tangent'; : GET D$
2170 RETURN