#lang racket/base
(require "suffixtree.rkt"
racket/list
racket/contract
racket/local
(only-in srfi/1 find lset-union))
(provide longest-common-substring)
(provide/contract [longest-common-sublabels
((listof label?) . -> . (listof label?))])
(define (leaf? node)
(empty? (node-children node)))
(define (longest-common-substring . words)
(let*-values ([(labels) (map string->label/with-sentinel words)])
(apply string-append
(map label->string/removing-sentinel
(longest-common-sublabels labels)))))
(define (longest-common-sublabels labels)
(let*-values ([(tree annotations)
(make-tree/annotations labels)])
(local ((define N (length labels))
(define (shared-by-all? node)
(= N (length (hash-ref annotations node))))
(define best-so-far '())
(define best-so-far-length 0)
(define (visit-children! node labels len visit!)
(for-each
(lambda (n)
(visit! n
(cons (node-up-label node) labels)
(+ len (label-length (node-up-label node)))))
(node-children node)))
(define (update-best! labels len)
(when (> len best-so-far-length)
(set! best-so-far labels)
(set! best-so-far-length len))))
(let visit! ([node (tree-root tree)]
[labels '()]
[len 0])
(cond
[(shared-by-all? node)
(cond [(leaf? node)
(update-best!
(cons (node-up-label node) labels)
(+ len (label-length (node-up-label node))))]
[else
(visit-children! node labels len visit!)])]
[else
(update-best! labels len)]))
(reverse best-so-far))))
(define (make-tree/annotations labels)
(let* ((tree (make-tree))
(_ (for-each (lambda (l) (tree-add! tree l)) labels))
(ht (annotate-tree tree labels)))
(values tree ht)))
(define (annotate-tree a-tree original-labels)
(local ((define ht (make-hasheq))
(define (label->original-label l)
(find (lambda (o) (label-source-eq? l o))
original-labels))
(define (update-leaf! node)
(hash-set!
ht node
(list (label->original-label (node-up-label node)))))
(define (update-parent! node)
(hash-set!
ht node
(apply lset-union eq?
(map
(lambda (c) (hash-ref ht c))
(node-children node))))))
(let loop ([node (tree-root a-tree)])
(cond [(leaf? node)
(update-leaf! node)]
[else
(for-each loop (node-children node))
(update-parent! node)]))
ht))