fork download
  1. ; compare strings with one error
  2.  
  3. (define (common eql? xs ys)
  4. (let loop ((xs xs) (ys ys) (zs (list)))
  5. (cond ((or (null? xs) (null? ys)) (reverse zs))
  6. ((not (eql? (car xs) (car ys))) (reverse zs))
  7. (else (loop (cdr xs) (cdr ys)
  8. (cons (car xs) zs))))))
  9.  
  10. (define (match1 str1 str2)
  11. (let* ((cs1 (string->list str1)) (cs1-len (length cs1))
  12. (cs2 (string->list str2)) (cs2-len (length cs2))
  13. (min-len (min cs1-len cs2-len)) (max-len (max cs1-len cs2-len)))
  14. (if (< 1 (- max-len min-len)) #f
  15. (let* ((prefix (common char=? cs1 cs2))
  16. (suffix (reverse (common char=? (reverse cs1) (reverse cs2))))
  17. (pref-len (length prefix)) (suff-len (length suffix)))
  18. (if (= (- max-len pref-len suff-len) 1) pref-len #f)))))
  19.  
  20. (display (match1 "ABCDE" "BCDE")) (newline)
  21. (display (match1 "BCDE" "ABCDE")) (newline)
  22. (display (match1 "ABCD" "ABCDE")) (newline)
  23. (display (match1 "ABCDE" "ABDE")) (newline)
  24. (display (match1 "ABDE" "ACD")) (newline)
  25. (display (match1 "ABCDE" "ADCBE")) (newline)
  26. (display (match1 "ABCDE" "ABCDE")) (newline)
  27. (display (match1 "ABCDE" "ABC")) (newline)
Success #stdin #stdout 0.04s 8656KB
stdin
Standard input is empty
stdout
0
0
4
2
#f
#f
#f
#f