[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/dY3aGxru    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Nov 29:
; longest duplicated substring

(define sort #f)
(define merge #f)
(let ()
  (define dosort
    (lambda (pred? ls n)
      (if (= n 1)
          (list (car ls))
          (let ((i (quotient n 2)))
            (domerge pred?
                     (dosort pred? ls i)
                     (dosort pred? (list-tail ls i) (- n i)))))))
  (define domerge
    (lambda (pred? l1 l2)
      (cond
        ((null? l1) l2)
        ((null? l2) l1)
        ((pred? (car l2) (car l1))
         (cons (car l2) (domerge pred? l1 (cdr l2))))
        (else (cons (car l1) (domerge pred? (cdr l1) l2))))))
  (set! sort
    (lambda (pred? l)
      (if (null? l) l (dosort pred? l (length l)))))
  (set! merge
    (lambda (pred? l1 l2)
      (domerge pred? l1 l2))))

(define (longest-duplicated-substring str)
  (let ((n (string-length str)))
    (let loop1 ((i (- n 1)) (ss '()))
      (if (<= 0 i)
          (loop1 (- i 1) (cons (substring str i n) ss))
          (let loop2 ((ss (sort string<? ss)) (dup "") (maxlen 0))
            (cond ((null? (cdr ss)) (substring dup 0 maxlen))
                  ((< maxlen (common-length (car ss) (cadr ss)))
                    (loop2 (cdr ss) (car ss)
                           (common-length (car ss) (cadr ss))))
                  (else (loop2 (cdr ss) dup maxlen))))))))

(define (common-length s1 s2)
  (let* ((len1 (string-length s1))
         (len2 (string-length s2))
         (max-i (min len1 len2)))
    (let loop ((i 0))
      (cond ((= i max-i) i)
            ((char=? (string-ref s1 i) (string-ref s2 i))
              (loop (+ i 1)))
            (else i)))))

(display (longest-duplicated-substring "banana")) (newline)
(display (longest-duplicated-substring "ask not what your country can do for you, ask what you can do for your country")) (newline)


Output:
1
2
ana
 can do for you


Create a new paste based on this one


Comments: