guile-project-euler-solutions/017/solution.scm

;;; Number letter counts

;;; Problem 17

;;; If the numbers 1 to 5 are written out in words: one, two,
;;; three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19
;;; letters used in total.

;;; If all the numbers from 1 to 1000 (one thousand)
;;; inclusive were written out in words, how many letters
;;; would be used?

;;; NOTE: Do not count spaces or hyphens. For example, 342
;;; (three hundred and forty-two) contains 23 letters and 115
;;; (one hundred and fifteen) contains 20 letters. The use of
;;; "and" when writing out numbers is in compliance with
;;; British usage.

(import
 (except (rnrs base) let-values map)
 (only (guile)
       lambda* λ
       ;; printing
       display
       simple-format
       command-line)
 (srfi srfi-69)  ; hash tables
 (srfi srfi-1)  ; drop
 (ice-9 textual-ports))


(define letters
  (string->list "abcdefghijklmnopqrstuvwxyz"))

(define special-number-names
  (alist->hash-table '(#;(0 . "null")
                       (1 . "one")
                       (2 . "two")
                       (3 . "three")
                       (4 . "four")
                       (5 . "five")
                       (6 . "six")
                       (7 . "seven")
                       (8 . "eight")
                       (9 . "nine")
                       (10 . "ten")
                       (11 . "eleven")
                       (12 . "twelve")
                       (13 . "thirteen")
                       (14 . "fourteen")
                       (15 . "fifteen")
                       (16 . "sixteen")
                       (17 . "seventeen")
                       (18 . "eighteen")
                       (19 . "nineteen"))
                     =))

(define multiples-of-ten-number-names
  (alist->hash-table '((1 . "ten")
                       (2 . "twenty")
                       (3 . "thirty")
                       (4 . "forty")
                       (5 . "fifty")
                       (6 . "sixty")
                       (7 . "seventy")
                       (8 . "eighty")
                       (9 . "ninety"))
                     =))


(define count-letters
  (λ (words)
    (string-length
     (string-filter (λ (c) (member c letters))
                    words))))


(define one-rule
  (λ (digit-char)
    (hash-table-ref special-number-names
                    (string->number (list->string (list digit-char))))))


(define ten-rule
  (λ (digit-chars)
    "There are special rules for naming multiples of ten. Do
not use this function for special numbers (1 to 13)."
    (display (simple-format #f "applying ten rule for digits: ~s\n" digit-chars))
    (let* ([leading-digit-char (car digit-chars)]
           [leading-digit-word (one-rule leading-digit-char)]
           [trailing-digits (drop digit-chars 1)])
      (if (all-zero-digits trailing-digits)
          (hash-table-ref multiples-of-ten-number-names
                          (string->number
                           (list->string
                            (list (car digit-chars)))))
          (string-append
           (hash-table-ref multiples-of-ten-number-names
                           (string->number
                            (list->string
                             (list (car digit-chars)))))
           "-")))))


(define hundred-rule
  (λ (digit-chars)
    (display (simple-format #f "applying hundred rule for digits: ~s\n" digit-chars))
    (let* ([leading-digit-char (car digit-chars)]
           [leading-digit-word (one-rule leading-digit-char)]
           [trailing-digits (drop digit-chars 1)])
      (string-join
       (if (all-zero-digits trailing-digits)
           (list (one-rule leading-digit-char)
                 "hundred")
           (list (one-rule leading-digit-char)
                 "hundred"
                 "and "))
       " "))))


(define thousand-rule
  (λ (digit-chars)
    (display (simple-format #f "applying thousand rule for digits: ~s\n" digit-chars))
    (let* ([leading-digit-char (car digit-chars)]
           [leading-digit-word (one-rule leading-digit-char)]
           [trailing-digits (drop digit-chars 1)])
      (string-join
       (if (all-zero-digits trailing-digits)
           (list (one-rule leading-digit-char)
                 "thousand")
           (list (one-rule leading-digit-char)
                 "thousand "))
       " "))))


(define digit-list->number
  (λ (digits)
    (string->number (list->string digits))))


(define all-zero-digits
  (λ (digit-chars)
    (cond
     [(null? digit-chars) #t]
     [(char=? (car digit-chars) #\0)
      (all-zero-digits (cdr digit-chars))]
     [else #f])))


(define number->words
  (λ (num)
    (call-with-output-string
      (λ (out-port)
        (let ([digits (string->list (number->string num))]
              [rules (list thousand-rule
                           hundred-rule
                           ten-rule
                           one-rule)])
          (let loop ([digits digits]
                     [rules
                      ;; Drop rules, which are not required
                      ;; for translating the number to
                      ;; words. For example the number 14
                      ;; does not need rules for thousands
                      ;; or hundreds.
                      (drop rules
                            (- (length rules) (length digits)))])
            ;; (display (simple-format #f "digits: ~s\n" digits))
            ;; (display (simple-format #f "rules: ~s\n" rules))
            (cond
             [(null? digits)
              (display (simple-format #f "~a\n" "no more digits"))]
             [(null? rules)
              (display (simple-format #f "~a\n" "no more rules"))]

             ;; Check, if all remaining digits are zeros. If
             ;; so do not recur.
             [(char=? #\0 (car digits))
              (loop (cdr digits) (cdr rules))]

             ;; If there are still at least 2 digits left,
             ;; it could be a special name number, so look
             ;; that up.
             [(hash-table-ref special-number-names
                              (digit-list->number digits)
                              (λ () #f))
              ;; Output the special name number and do not
              ;; continue to iterate.
              (put-string out-port
                          (hash-table-ref special-number-names
                                          (digit-list->number digits)))]

             ;; Otherwise apply regular rules.
             [else
              (display (simple-format #f "applying regular rules to digit: ~s\n" (car digits)))
              (put-string out-port ((car rules) digits))
              (loop (cdr digits) (cdr rules))])))))))


(define calculate-letter-count
  (λ (start maximum)
    (let iter ([num start]
               [num-letters 0])
      (cond
       [(<= num maximum)
        (let ([words (number->words num)])
          (display (simple-format #f "number in words: ~a\n" words))
          (iter (+ num 1)
                (+ num-letters
                   (count-letters words))))]
       [else num-letters]))))


(let* ([args (command-line)]
       [start (string->number (cadr args))]
       [maximum (string->number (caddr args))])
  (display
   (simple-format
    #f "~a\n"
    (calculate-letter-count start maximum))))