; find the longest palindrome in a string
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
((3) (let ((le? (if (negative? (caddr args)) >= <=)))
(let loop ((x(car args)) (xs '()))
(if (le? (cadr args) x)
(reverse xs)
(loop (+ x (caddr args)) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
(define (zip . xss) (apply map list xss))
(define (maximum-by lt? . xs)
(let loop ((xs (cdr xs)) (current-max (car xs)))
(cond ((null? xs) current-max)
((lt? current-max (car xs))
(loop (cdr xs) (car xs)))
(else (loop (cdr xs) current-max)))))
(define (longest-palindrome input)
(let* ((lps (reverse (longest-palindromes input)))
(max-length-pos
(apply maximum-by
(lambda (a b) (< (car a) (car b)))
(zip lps (range (length lps))))))
(show-palindrome input (car max-length-pos) (cadr max-length-pos))))
(define (show-palindrome s len pos)
(let ((startpos (- (quotient pos 2) (quotient len 2)))
(endpos (if (odd? len)
(+ (quotient pos 2) (quotient len 2))
(+ (quotient pos 2) (quotient len 2) -1))))
(substring s startpos (+ endpos 1))))
(define (longest-palindromes a)
(let ((afirst 0) (alast (string-length a)))
(extend-tail a afirst 0 '())))
(define (extend-tail a n current-tail centres)
(let ((afirst 0) (alast (string-length a)))
(cond ((>= n alast)
(final-centres current-tail centres (cons current-tail centres)))
((= (- n current-tail) afirst)
(extend-centres a n (cons current-tail centres) centres current-tail))
((char=? (string-ref a n) (string-ref a (- n current-tail 1)))
(extend-tail a (+ n 1) (+ current-tail 2) centres))
(else
(extend-centres a n (cons current-tail centres) centres current-tail)))))
(define (extend-centres a n centres tcentres centre-distance)
(cond ((= centre-distance 0)
(extend-tail a (+ n 1) 1 centres))
((= (- centre-distance 1) (car tcentres))
(extend-tail a n (car tcentres) centres))
(else (extend-centres a n
(cons (min (car tcentres) (- centre-distance 1)) centres)
(cdr tcentres) (- centre-distance 1)))))
(define (final-centres n+1 tcentres centres)
(if (= n+1 0)
centres
(final-centres (- n+1 1) (cdr tcentres)
(cons (min (car tcentres) (- n+1 1)) centres))))
(define s (string-append
"Fourscoreandsevenyearsagoourfaathersbroughtforthonthisconta"
"inentanewnationconceivedinzLibertyanddedicatedtotheproposit"
"ionthatallmenarecreatedequalNowweareengagedinagreahtcivilwa"
"rtestingwhetherthatnaptionoranynartionsoconceivedandsodedic"
"atedcanlongendureWeareqmetonagreatbattlefiemldoftzhatwarWeh"
"avecometodedicpateaportionofthatfieldasafinalrestingplacefo"
"rthosewhoheregavetheirlivesthatthatnationmightliveItisaltog"
"etherfangandproperthatweshoulddothisButinalargersensewecann"
"otdedicatewecannotconsecratewecannothallowthisgroundThebrav"
"elmenlivinganddeadwhostruggledherehaveconsecrateditfarabove"
"ourpoorponwertoaddordetractTgheworldadswfilllittlenotlenorl"
"ongrememberwhatwesayherebutitcanneverforgetwhattheydidhereI"
"tisforusthelivingrathertobededicatedheretotheulnfinishedwor"
"kwhichtheywhofoughtherehavethusfarsonoblyadvancedItisrather"
"forustobeherededicatedtothegreattdafskremainingbeforeusthat"
"fromthesehonoreddeadwetakeincreaseddevotiontothatcauseforwh"
"ichtheygavethelastpfullmeasureofdevotionthatweherehighlyres"
"olvethatthesedeadshallnothavediedinvainthatthisnationunsder"
"Godshallhaveanewbirthoffreedomandthatgovernmentofthepeopleb"
"ythepeopleforthepeopleshallnotperishfromtheearth"))
(display (longest-palindrome s))