codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; 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))
Private
[
?
]
Run code
Submit