[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Oct 13:
; 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))


Output:
1
ranynar


Create a new paste based on this one


Comments: