[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on May 25:
; pig latin

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))
        (reverse ys)
        (loop (- n 1) (cdr xs)
              (cons (car xs) ys)))))

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (take-while pred? xs)
  (let loop ((xs xs) (ys '()))
    (if (or (null? xs) (not (pred? (car xs))))
        (reverse ys)
        (loop (cdr xs) (cons (car xs) ys)))))

(define (pig-latin word)
  (let* ((vowels (string->list "aeiouAEIOU"))
         (ws (string->list word)) (rs (reverse ws)))
    (if (member #\- ws)
        ; pig-latin to english
        (let* ((front (take-while (lambda (c) (not (char=? c #\-))) ws))
               (back (drop (+ (length front) 1) ws)))
          (if (string=? (list->string back) "way") (list->string front)
            (list->string (append (take (- (length back) 2) back) front))))
        ; english to pig-latin
        (if (member (car ws) vowels) (string-append word "-way")
          (let ((init-cons (take-while (lambda (c) (not (member c vowels))) ws)))
            (list->string (append (drop (length init-cons) ws) (list #\-) init-cons (list #\a #\y))))))))

(display (map pig-latin '("art" "eagle" "start" "door" "spray" "prays" "wart")))
(newline)
(display (map pig-latin '("art-way" "eagle-way" "art-stay" "oor-day" "ay-spray" "ays-pray" "art-way")))


Output:
1
2
(art-way eagle-way art-stay oor-day ay-spray ays-pray art-way)
(art eagle start door spray prays art)


Create a new paste based on this one


Comments: