fork download 
  1. ; making a palindrome
  2.  
  3. (define (palin str)
  4.   (define (string-reverse str) (list->string (reverse (string->list str))))
  5.   (let ((freqs (make-vector 256 0)))
  6.     (define (s t i d)
  7.       (string-append t
  8.         (make-string (/ (vector-ref freqs i) d) (integer->char i))))
  9.     (do ((cs (string->list str) (cdr cs))) ((null? cs))
  10.       (let ((i (char->integer (car cs))))
  11.         (vector-set! freqs i (+ (vector-ref freqs i) 1))))
  12.     (let loop ((i 0) (left "") (center ""))
  13.       (cond ((= 256 i) (string-append left center (string-reverse left)))
  14.             ((even? (vector-ref freqs i)) (loop (+ i 1) (s left i 2) center))
  15.             ((string=? center "") (loop (+ i 1) left (s center i 1)))
  16.             (else #f)))))
  17.  
  18. (display (palin "pprrrraaxxxiiiiiissss")) (newline)
  19.  
  20. (define (palin str)
  21.   (let ((freqs (make-vector 256 0)) (len (string-length str)))
  22.     (do ((cs (string->list str) (cdr cs))) ((null? cs))
  23.       (let ((i (char->integer (car cs))))
  24.         (vector-set! freqs i (+ (vector-ref freqs i) 1))))
  25.     (let loop ((i 0) (p 0) (center-char #f) (center-count 0))
  26.       (cond ((= 256 i)
  27.               (when center-char
  28.                 (do ((j 0 (+ j 1))) ((= j center-count))
  29.                   (string-set! str (+ p j) center-char)))
  30.               str)
  31.             ((even? (vector-ref freqs i))
  32.               (do ((j 0 (+ j 1)))
  33.                   ((= j (/ (vector-ref freqs i) 2)))
  34.                 (string-set! str (+ p j) (integer->char i))
  35.                 (string-set! str (- len p j 1) (integer->char i)))
  36.               (loop (+ i 1) (+ p (/ (vector-ref freqs i) 2))
  37.                     center-char center-count))
  38.             ((not center-char)
  39.               (loop (+ i 1) p (integer->char i) (vector-ref freqs i)))
  40.             (else #f)))))
  41.  
  42. (display (palin "pprrrraaxxxiiiiiissss")) (newline)
Success #stdin #stdout 0s 7276KB
comments (?)
stdin 
Standard input is empty
stdout 
aiiiprrssxxxssrrpiiia
aiiiprrssxxxssrrpiiia
https://ideone.com/f05O6W
language:
Scheme (chicken 4.13)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!