Nikdy jsem nebyl dobry v programovani basicu na Spectru. A stejne jsem vsechno zapomnel. Ale kdyz uz je basic na ZX Spectru znamy tim ze zvlada funkce s parametry, nekonecne rekurze a jine vymozenosti modernejsich jazyku tak jsem prepsal tu C variantu.
Kód:
10 REM ZX Spectrum Levenshtein
20 INPUT "first word:", n$
30 INPUT "second word:", m$
40 LET r=LEN n$+LEN m$:DIM n(r):DIM m(r):DIM e(r)
50 LET n(2)=LEN n$:LET m(2)=LEN m$:LET n(1)=n(2)+1:LET m(1)=m(1)+1:LET r=1
60 GOSUB 1000
70 PRINT "The Levenshtein distance between """;n$;""", """;m$;""" is ";e(2);"."
80 STOP
1000 LET r=r+1
1010 IF n(r)=0 THEN LET e(r)=m(r):LET r=r-1:RETURN
1020 IF m(r)=0 THEN LET e(r)=n(r):LET r=r-1:RETURN
1030 IF n$(n(r) TO n(r))=m$(m(r) TO m(r)) THEN LET n(r)=n(r)-1:LET m(r)=m(r)-1:GOTO 1010
1040 LET n(r+1)=n(r)-1:LET m(r+1)=m(r)-1:GOSUB 1000:LET e(r)=e(r+1)
1050 IF n(r-1)>n(r) THEN LET n(r+1)=n(r)-1:LET m(r+1)=m(r):GOSUB 1000:if e(r+1)<e(r) THEN LET e(r)=e(r+1)
1060 IF m(r-1)>m(r) THEN LET n(r+1)=n(r):LET m(r+1)=m(r)-1:GOSUB 1000:if e(r+1)<e(r) THEN LET e(r)=e(r+1)
1070 LET e(r)=e(r)+1:LET r=r-1:RETURN
Pridal jsem tam optimalizaci, protoze ta C varianta je napsana tak jednoduse, ze jednou umaze jeden znak z prvniho retezce (1050) a zavola se znova, kde pak umaze znak z druheho retezce (1060)...
coz je to same co zamena znaku (1040), jen delsi.
Obavam se ze tu trolim Atari forum a jeste hroznym kodem. Nevim kolik rekurzi ZX zvladne, ale aspon na testovacich slovech to ZX zvladnul (zrychlil jsem emulator 100x a cekal a cekal...
).
Mozna by stalo za to predhodit to dalsim lidem,
kdo to napise lepe. .)
EDIT: Tak to trva 3h 11m a bez optimalizace asi nekolik dni.
_________________
Z80 Forth compiler (ZX Spectrum 48kb):
https://codeberg.org/DW0RKiN/M4_FORTH