20110215-google-code-jam-qualification-round-africa-2010.scm

;; http://programmingpraxis.com/2011/02/15/google-code-jam-qualification-round-africa-2010/

(define (shop target items)
  (let oloop ((i 0) (soln #f))
    (if (or soln
	    (>= i (vector-length items)))
	soln
	(begin
	  (let iloop ((j (+ i 1)))
	    (cond
	     ((>= j (vector-length items)) #f)
	     ((= target (+ (vector-ref items i)
			   (vector-ref items j)))
	      (set! soln (list (+ i 1) (+ j 1))))
	     (else (iloop (+ j 1)))))
	  (oloop (+ i 1) soln)))))

(define (reverse-words words)
  (string-join (reverse (string-split words #\space))))

(define t9-dict '((#\space . "0")
		  (#\a . "2")
		  (#\b . "22")
		  (#\c . "222")
		  (#\d . "3")
		  (#\e . "33")
		  (#\f . "333")
		  (#\g . "4")
		  (#\h . "44")
		  (#\i . "444")
		  (#\j . "5")
		  (#\k . "55")
		  (#\l . "555")
		  (#\m . "6")
		  (#\n . "66")
		  (#\o . "666")
		  (#\p . "7")
		  (#\q . "77")
		  (#\r . "777")
		  (#\s . "7777")
		  (#\t . "8")
		  (#\u . "88")
		  (#\v . "888")
		  (#\w . "9")
		  (#\x . "99")
		  (#\y . "999")
		  (#\z . "9999")))

(define (t9 message)
  (define (t9-lookup c)
    (let ((r (assoc c t9-dict)))
      (if r (cdr r) #\.)))
  (let loop ((m (string->list (string-downcase message))) (last #f) (r '()))
    (if (null? m)
	(string-join (reverse r) "")
	(begin
	  (if (equal? (car m) last)
	      (set! r (cons " " r))
	      #f)
	  (loop (cdr m) (car m) (cons (t9-lookup (car m)) r))))))