48024 justinhj #| Word Numbers "If the integers from 1 to 999,999,999 are written as words, sorted alphabetically, and concatenated, what is the 51 billionth letter?" To be precise: if the integers from 1 to 999,999,999 are expressed in words (omitting spaces, 'and', and punctuation[1]), and sorted alphabetically so that the first six integers are * eight * eighteen * eighteenmillion * eighteenmillioneight * eighteenmillioneighteen * eighteenmillioneighteenthousand and the last is * twothousandtwohundredtwo then reading top to bottom, left to right, the 28th letter completes the spelling of the integer "eighteenmillion". The 51 billionth letter also completes the spelling of an integer. Which one, and what is the sum of all the integers to that point? [1] For example, 911,610,034 is written "ninehundredelevenmillionsixhundredtenthousandthirtyfour"; 500,000,000 is written "fivehundredmillion"; 1,709 is written "onethousandsevenhundrednine". |# ; (load (compile-file "wordnumbers.lisp")) ; (solve 999999999 51000000000) ; ;;;; Utilities (defmacro with-string-words((str word) &body body) "Utility macro to iterate over a string and return each word (anything between spaces)" `(do* ((start 0 (if end (1+ end) nil)) (end (position #\Space ,str :start 0) (if end (position #\Space ,str :start (1+ end)) nil)) (,word (subseq ,str start end) (if start (subseq ,str start end) nil))) ((null start)) ,@body)) ;;;; Numbers are stores as the number in words, the length of this string and finally the numeric value (defun get-words(lst) (first lst)) (defun get-length(lst) (second lst)) (defun get-value(lst) (third lst)) (defun remove-and(str) "remove occurences of 'and' from a string" (let ((new-str (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))) (with-string-words (str word) (if (string/= "and" word) (and (setf new-str (concatenate 'string new-str word)) (setf new-str (concatenate 'string new-str " "))))) new-str)) (defun remove-spaces-and-hyphens(str) "remove spaces and hyphens from a string" (let ((new-str (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))) (loop for p from 0 to (1- (length str)) do (unless (or (char= (aref str p) #\Space) (char= (aref str p) #\-)) (vector-push-extend (aref str p) new-str))) new-str)) (defun get-number-as-words(n) "Use common lisps built in English text number output" (format nil "~r" n)) (defun get-numbers-as-word-list(n) "get the numbers from 1 to n and return as a list of strings and the lengths of each string as a pair" (loop for n from 1 to n collect (let* ((str (get-number-as-words n)) (len (length str))) (list (convert-text str) len n)))) (defun compare-word-and-len(a b) "given a string, length pair compare on alphabetical order" (string< (get-words a) (get-words b))) (defun sort-number-word-list-alphabetically(lst) (sort lst #'compare-word-and-len)) (defun convert-text(str) (remove-spaces-and-hyphens (remove-and str))) (defun get-number-from-letter-index(lst target-index) (do ((number 0 (1+ number)) (index 0 (+ index (get-length (nth number lst))))) ((> number (1- (length lst)))) (if (<= target-index (+ index (get-length (nth number lst)))) (return-from get-number-from-letter-index number))) nil) (defun sum-to-n(lst n) (if (>= n 0) (+ (get-value (car lst)) (sum-to-n (cdr lst) (1- n))) 0)) (defun solve(num n) "Solve the problem for 'num' numbers, finding character position n" (let ((lst (sort-number-word-list-alphabetically (get-numbers-as-word-list num)))) (format t "Made list~%") (let ((number (get-number-from-letter-index lst n))) (format t "Found number~%") (let ((value (get-value (nth number lst)))) (format t "Done.~%Number at character pos ~a is ~a. Sum to that number is ~a~%" n value (sum-to-n lst number)))))) 3399315968 None Common Lisp