In article
<····································@i7g2000prf.googlegroups.com>,
Volkan YAZICI <·············@gmail.com> wrote:
> Hi,
>
> I've implemented a solution to the word number puzzle[1] of ITA. It
> gives quite similar results to the (so called) solutions found here[2]
> and here[3], but not identical results. (OTOH, those two doesn't
> produce same results too.) I think I am missing some point but
> couldn't be sure (neither could figure it out), because of there is
> not any known right solution to the problem.
>
> I paste the code[4] below. (I think the code is self-documenting, but
> if it seems obfuscated, please inform me and I will make related
> explanations.) I will be really appreciated if somebody would review
> the code and comment on the (possible) mistakes.
>
>
> Regards.
>
> P.S. This is the shortest and fastest solution I know of, and without
> a single CL optimization hack. Can be good advertisement about Common
> Lisp.
>
> [1] http://www.itasoftware.com/careers/puzzles07.html
> [2] http://conway.rutgers.edu/~ccshan/wiki/blog/posts/WordNumbers4/
> [3] http://mignon.jottit.com/ita
> [4] http://www.students.itu.edu.tr/~yazicivo/word-numbers.lisp.txt
>
> (defpackage :word-numbers
> (:use :cl)
> (:export :get-nth-character))
Well, I would use strings. ;-)
>
> (in-package :word-numbers)
>
> (let ((lo-char-code (char-code #\a))
> (hi-char-code (char-code #\z)))
> (defun number-to-string (num)
> (remove-if-not
> (lambda (code) (<= lo-char-code code hi-char-code))
> (format nil "~r" num)
> :key #'char-code)))
Why a closure? Make the character codes a constant.
See DEFCONSTANT.
Somehow I would either rename this function and
a write a documentation string.
Why do you compute with CHAR-CODEs? There is CHAR<= .
>
> (defparameter +atom-data+
Variables are named *foo* . +foo+ is for contants.
> ;; Order is important! First pseudo atoms.
> (concatenate
> 'vector
> ;; Pseudo atoms.
> #((8 "thousand" 1000)
> (7 "million" 1000000))
> ;; Plain atoms.
> (coerce
> (loop for i from 1 to 999
> for str = (number-to-string i)
> collect (list (length str) str i))
> '(simple-array t (*)))))
Create the array and then set the contents of the array.
You can thus get rid of all the intermediate stuff
and the concatenate.
>
> (defconstant +plain-atom-count+ 999)
This constant is not used above?
>
> (defconstant +pseudo-atom-count+ (- (length +atom-data+) +plain-atom-
> count+))
>
> (defparameter +plain-atoms+
> (loop for i below +plain-atom-count+
> collect (+ i +pseudo-atom-count+)))
>
> (defparameter +pseudo-atoms+
> (loop for i below +pseudo-atom-count+ collect i))
>
> (defun pseudo-atom-p (atom)
> (< atom +pseudo-atom-count+))
>
> (defun length-of (atom)
> (first (aref +atom-data+ atom)))
>
> (defun word-of (atom)
> (second (aref +atom-data+ atom)))
>
> (defun number-of (atom)
> (third (aref +atom-data+ atom)))
What is an 'atom'? This conflicts with Lisp's builtint
idea of ATOM.
>
> (defun atom-list-string (atom-list)
> (apply #'concatenate 'string (mapcar #'word-of (reverse atom-
> list))))
The the above is not efficient.
Also APPLY only supports limited length lists.
There is an implementation limit for this.
>
> (let ((table (make-hash-table
> :test #'eq
> :size (* (length +plain-atoms+)
> (length +pseudo-atoms+)))))
> (defun atom-list-short-string-internal (plain pseudo)
> (let ((key (+ (number-of pseudo) plain)))
> (or (gethash key table)
> (setf (gethash key table)
> (concatenate
> 'string
> (word-of plain)
> (word-of pseudo)))))))
I'm not a big fan of closures like these. Makes debugging harder.
>
> (defun atom-list-short-string (atom-list)
> (if (pseudo-atom-p (first atom-list))
> (atom-list-short-string-internal (second atom-list) (first atom-
> list))
> (word-of (first atom-list))))
>
> (defun atom-list-length (atom-list)
> (reduce #'+ atom-list :key #'length-of))
>
> (defun atom-list-number (atom-list)
> (loop for (plain pseudo) on (reverse atom-list) by #'cddr
> sum (* (number-of plain)
> (if pseudo (number-of pseudo) 1))))
>
> ;;; Total number of characters
> ;;; ... from 1 to 999: _18440_
>
> ;;; ... from 1,000 to 999,000 (just 3 zeros at the end):
> ;;; 18440 + (999 * 8) = 26432
> ;;; ... from 1,001 to 999,001 (no three zeros at the end):
> ;;; (999 * 26432) + (999 * 18440) = 44,827,128
>
> ;;; ... from 1 to 999,999:
> ;;; 18440 + 26432 + 44,827,128 = _44,872,000_
>
> ;;; ... from 1,000,000 to 999,000,000 (just 6 zeros at the end):
> ;;; 18440 + (999 * 7) = 25,433
> ;;; ... from 1,000,001 to 999,999,999 (no 6 zeros at the end):
> ;;; (999,999 * 25,433) + (999 * 44,872,000) = 70,260,102,567
>
> ;;; ... from 1 to 999,999,999:
> ;;; 44,872,000 + 25,433 + 70,260,102,567 = _70,305,000,000_
>
> (defun pseudo-block-length (plain pseudo)
> (case pseudo
> (0 (+ (* 999 (+ (length-of plain)
> (length-of pseudo)))
> 18440))
> (1 (+ (* 999999 (+ (length-of plain)
> (length-of pseudo)))
> 44872000))))
>
> (defun merged-cartesian-product (atom-lists pseudo-atoms)
> (if (null pseudo-atoms)
> atom-lists
> (nconc
> (mapcar
> (lambda (atom) (cons (first pseudo-atoms) atom))
> atom-lists)
> (merged-cartesian-product atom-lists (rest pseudo-atoms)))))
>
> (defun traverse-combinations (submit skip-block-p atom-list plain-
> atoms pseudo-atoms)
> (mapc
> (lambda (atom-list)
> (funcall submit atom-list)
> (let ((pseudo (first atom-list))
> (plain (second atom-list)))
> (if (and (pseudo-atom-p pseudo)
> (not (funcall skip-block-p (pseudo-block-length plain
> pseudo))))
> (traverse-combinations
> submit
> skip-block-p
> atom-list
> plain-atoms
> (remove-if-not
> (lambda (pseudo-atom) (< pseudo-atom pseudo))
> pseudo-atoms)))))
> (sort
> (merged-cartesian-product
> (mapcar
> (lambda (atom) (cons atom atom-list))
> plain-atoms)
> pseudo-atoms)
> #'string<
> :key #'atom-list-short-string)))
>
> (defun get-nth-character (n)
> (let ((distance 0))
> (flet ((submit (atom-list)
> (incf distance (atom-list-length atom-list))
> (if (>= distance n)
> (return-from get-nth-character
> (list distance
> atom-list
> (atom-list-number atom-list)
> (atom-list-string atom-list)))))
> (skip-block-p (block-length)
> (if (not (> (+ block-length distance) n))
> (incf distance block-length))))
> (traverse-combinations
> #'submit
> #'skip-block-p
> nil
> +plain-atoms+
> +pseudo-atoms+)))
It does not look too bad.
Still I (just me, I'm old-fashioned, maybe) would not accept any
source code without documentation strings. ;-)
Source code should be self-descriptive as possible, but still
one needs a short description:
* what is the purpose of the code in general
* how should I use it?
* for every variable declaration the purpose and type
of the variable should be explained
* for every function the purpose, the input and output
of the function should be described.
As a starting point, try to imagine what documentation you
would need to EASILY understand your own source code if you look
at it two months later.
As I said, I may be old-fashioned. ;-)
If you want others to read and understand this code, then
some extra lines of documentation are needed.
--
http://lispm.dyndns.org/
On Jan 3, 1:37 am, Rainer Joswig <······@lisp.de> wrote:
> > (let ((lo-char-code (char-code #\a))
> > (hi-char-code (char-code #\z)))
> > (defun number-to-string (num)
> > (remove-if-not
> > (lambda (code) (<= lo-char-code code hi-char-code))
> > (format nil "~r" num)
> > :key #'char-code)))
>
> Why a closure? Make the character codes a constant.
> See DEFCONSTANT.
>
> Somehow I would either rename this function and
> a write a documentation string.
>
> Why do you compute with CHAR-CODEs? There is CHAR<= .
Right. Here is the fixed version:
(defun number-to-string (num)
(remove-if-not
(lambda (char) (char<= #\a char #\z))
(format nil "~r" num)))
> > (defparameter +atom-data+
>
> Variables are named *foo* . +foo+ is for contants.
Yes, but I wanted them to be constants, at least look like constants.
But because of DEFCONSTANT doesn't use an EQUALP to check the values,
I needed to use DEFPARAMETER.
> > (defconstant +plain-atom-count+ 999)
>
> This constant is not used above?
But used below.
> What is an 'atom'? This conflicts with Lisp's builtint
> idea of ATOM.
;;; Instead of storing string (or number) representation of a number
while
;;; counting characters, I'll keep a list of atoms to represent the
number.
;;; There'll be two kinds of atom: pseudo (thousand, million,
billion, ...) and
;;; plain (one, two, three, ..., ninehundredninetynine). +ATOM-DATA+
dictionary
;;; will save us from the computing overhead of some of the properties
(length,
;;; word, number) of these atoms in case of
need.
(defparameter +atom-data+
;; Order is important! First pseudo
atoms.
(concatenate
'vector
;; Pseudo atoms. (Order is important. First pseudo atoms with lower
levels.)
#((8 "thousand" 1000)
(7 "million" 1000000))
;; Plain
atoms.
(coerce
(loop for i from 1 to 999
for str = (number-to-string i)
collect (list (length str) str i))
'(simple-array t (*))))
"List of (ATOM-LENGTH ATOM-WORD ATOM-NUMBER) triples.")
> > (defun atom-list-string (atom-list)
> > (apply #'concatenate 'string (mapcar #'word-of (reverse atom-
> > list))))
>
> The the above is not efficient.
Suggestions? Using a WITH-OUTPUT-TO-STRING?
> Also APPLY only supports limited length lists.
> There is an implementation limit for this.
Atom lists can only have maximum 5 atoms in current implementation.
(Because of 999,999,999 limit. But current program can be expanded to
given any pseudo level.)
> It does not look too bad.
>
> Still I (just me, I'm old-fashioned, maybe) would not accept any
> source code without documentation strings. ;-)
> Source code should be self-descriptive as possible, but still
> one needs a short description:
>
> * what is the purpose of the code in general
> * how should I use it?
> * for every variable declaration the purpose and type
> of the variable should be explained
> * for every function the purpose, the input and output
> of the function should be described.
>
> As a starting point, try to imagine what documentation you
> would need to EASILY understand your own source code if you look
> at it two months later.
I tried to supply comments as much as I can in the new uploaded
file[1]. But here are a few excerpts that I think are the significant
ones.
[1] http://www.students.itu.edu.tr/~yazicivo/word-numbers.lisp.txt
(defun atom-list-short-string (atom-list)
"String representation of the last two atoms in the supplied ATOM-
LIST."
(if (pseudo-atom-p (first atom-list))
(atom-list-short-string-internal (second atom-list) (first atom-
list))
(word-of (first atom-list))))
(defun atom-list-length (atom-list)
"Length of the string representation of the supplied ATOM-LIST."
(reduce #'+ atom-list :key #'length-of))
(defun atom-list-number (atom-list)
"Number representation of the supplied ATOM-LIST."
(loop for (plain pseudo) on (reverse atom-list) by #'cddr
sum (* (number-of plain)
(if pseudo (number-of pseudo) 1))))
(defun pseudo-block-length (plain pseudo)
"Returns how many characters we will need to traverse in specified
pseudo
block length."
(case pseudo
;; This is a number with a "thousand" suffix.
(0 (+ (* 999 (+ (length-of plain)
(length-of pseudo)))
18440))
;; This is a number with a "million" suffix.
(1 (+ (* 999999 (+ (length-of plain)
(length-of pseudo)))
44872000))))
(defun merged-cartesian-product (atom-lists pseudo-atoms)
"Produces cartesian product of supplied ATOM-LISTS and PSEUDO-ATOMS,
and
concatenates result with the ATOM-LISTS."
(if (null pseudo-atoms)
atom-lists
(nconc
(mapcar
(lambda (atom) (cons (first pseudo-atoms) atom))
atom-lists)
(merged-cartesian-product atom-lists (rest pseudo-atoms)))))
(defun traverse-combinations (submit skip-block-p atom-list plain-
atoms pseudo-atoms)
(mapc
(lambda (atom-list)
;; Submit atom list.
(funcall submit atom-list)
(let ((pseudo (first atom-list))
(plain (second atom-list)))
;; If this is a pseudo atom (which means we have a list ending
with
;; "thousand" or "million" atoms), continue by processing this
block
;; first.
(if (and (pseudo-atom-p pseudo)
;; Am I allowed to skip this block instead of
calculating every
;; number in the inner blocks?
(not (funcall skip-block-p (pseudo-block-length plain
pseudo))))
(traverse-combinations
submit
skip-block-p
atom-list
plain-atoms
;; Just keep pseudo atoms lower than current pseudo level.
(For
;; instance, if we just used a "million", now passing
"thousand" is
;; allowed only.)
(remove-if-not
(lambda (pseudo-atom) (< pseudo-atom pseudo))
pseudo-atoms)))))
;; Sort generated atom lists according to their string order.
(sort
;; First generate a new list of atom lists by appending plain
atoms to the
;; current atom list. And then concatenate this list with the
cartesian
;; product of same list on "thousand", "million" atoms; in other
terms,
;; produce the merged cartesian product.
(merged-cartesian-product
(mapcar
(lambda (atom) (cons atom atom-list))
plain-atoms)
pseudo-atoms)
#'string<
;; While sorting atom lists, we don't need to get the string
representation
;; of the whole atom list. Because of we just created the last two
(or one)
;; atom(s) in the list, it is ok to just check their string
representation.
:key #'atom-list-short-string)))
(defun get-nth-character (n)
"Get Nth character of the sorted list of string representation of
numbers from
1 to 999,999,999."
(let ((distance 0))
(flet ((submit (atom-list)
(incf distance (atom-list-length atom-list))
(if (>= distance n)
(return-from get-nth-character
(list distance
atom-list
(atom-list-number atom-list)
(atom-list-string atom-list)))))
(skip-block-p (block-length)
;; If will be skipped block length doesn't exceed the
target
;; distance, let it skip the block.
(if (not (> (+ block-length distance) n))
(incf distance block-length))))
(traverse-combinations
#'submit
#'skip-block-p
nil
+plain-atoms+
+pseudo-atoms+))))
Thanks so much for your detailed answer. Please inform me if you'd
need any further explanation. I'd be very very happy if we can spot
the erronous part of the algorithm, if there is any.
Regards.
On Jan 3, 6:05 am, Volkan YAZICI <·············@gmail.com> wrote:
> On Jan 3, 1:37 am, Rainer Joswig <······@lisp.de> wrote:
>
> > > (let ((lo-char-code (char-code #\a))
> > > (hi-char-code (char-code #\z)))
> > > (defun number-to-string (num)
> > > (remove-if-not
> > > (lambda (code) (<= lo-char-code code hi-char-code))
> > > (format nil "~r" num)
> > > :key #'char-code)))
>
> > Why a closure? Make the character codes a constant.
> > See DEFCONSTANT.
>
> > Somehow I would either rename this function and
> > a write a documentation string.
>
> > Why do you compute with CHAR-CODEs? There is CHAR<= .
>
> Right. Here is the fixed version:
>
> (defun number-to-string (num)
> (remove-if-not
> (lambda (char) (char<= #\a char #\z))
> (format nil "~r" num)))
CL-USER> (loop for x from 1 to 999 summing (length (number-to-string
x)))
21113
Maybe:
(defun number-to-string(number)
"Returns the string form of a number w/o spaces, 'and', or
punctuation"
(let ((string (format nil "~r" number)))
(remove-if-not #'alpha-char-p
(loop for j = 0 then (+ i 4)
for i = (search " and " string :start2 j)
then (search " and " string :start2 j)
while i do (loop for k from (+ i 1)
for count below 3
do (setf (elt string k) #
\Space))
finally (return string)))))
CL-USER> (loop for x from 1 to 999 summing (length (number-to-string
x)))
18440
> > > (defparameter +atom-data+
>
> > Variables are named *foo* . +foo+ is for contants.
>
> Yes, but I wanted them to be constants, at least look like constants.
> But because of DEFCONSTANT doesn't use an EQUALP to check the values,
> I needed to use DEFPARAMETER.
What are you talking about????
----
Geoff
On Jan 3, 6:41 pm, Geoffrey Summerhayes <·······@gmail.com> wrote:
> On Jan 3, 6:05 am, Volkan YAZICI <·············@gmail.com> wrote:
> > (defun number-to-string (num)
> > (remove-if-not
> > (lambda (char) (char<= #\a char #\z))
> > (format nil "~r" num)))
>
> CL-USER> (loop for x from 1 to 999 summing (length (number-to-string
> x)))
> 21113
>
> Maybe:
> (defun number-to-string(number)
> "Returns the string form of a number w/o spaces, 'and', or
> punctuation"
> (let ((string (format nil "~r" number)))
> (remove-if-not #'alpha-char-p
> (loop for j = 0 then (+ i 4)
> for i = (search " and " string :start2 j)
> then (search " and " string :start2 j)
> while i do (loop for k from (+ i 1)
> for count below 3
> do (setf (elt string k) #
> \Space))
> finally (return string)))))
>
> CL-USER> (loop for x from 1 to 999 summing (length (number-to-string
> x)))
> 18440
I couldn't reproduce same in here.
(defun number-to-string-v1 (num)
(remove-if-not
(lambda (char) (char<= #\a char #\z))
(format nil "~r" num)))
=> NUMBER-TO-STRING-V1
(defun number-to-string-v2 (number)
"Returns the string form of a number w/o spaces, 'and', or
punctuation"
(let ((string (format nil "~r" number)))
(remove-if-not #'alpha-char-p
(loop for j = 0 then (+ i 4)
for i = (search " and " string :start2 j)
then (search " and " string :start2 j)
while i do (loop for k from (+ i 1)
for count below 3
do (setf (elt string k)
#\Space))
finally (return string)))))
=> NUMBER-TO-STRING-V2
(loop for i from 1 to 999
for v1 = (number-to-string-v1 i)
for v2 = (number-to-string-v2 i)
unless (string= v1 v2)
collect (cons v1 v2))
=> NIL
I use SBCL 1.0.11.debian. Maybe this is an implementation dependent
gotcha? (BTW, #'ALPHA-CHAR-P is a far better choice than a custom
LAMBDA, thanks.)
> > > > (defparameter +atom-data+
>
> > > Variables are named *foo* . +foo+ is for contants.
>
> > Yes, but I wanted them to be constants, at least look like constants.
> > But because of DEFCONSTANT doesn't use an EQUALP to check the values,
> > I needed to use DEFPARAMETER.
>
> What are you talking about????
CLHS tells that
The consequences are undefined if there are any bindings of the
variable named by name at the time defconstant is executed or if
the value is not eql to the value of initial-value.
and if I'd use DEFCONSTANT instead of DEFPARAMETER, reloading same
file makes SBCL complain that value of +ATOM-DATA+ is altered even if
it is not. Because DEFCONSTANT uses EQL to compare the values, instead
of EQUALP. (Did I misinterpret the related CLHS part?)
Regards.
On Jan 3, 1:22 pm, Volkan YAZICI <·············@gmail.com> wrote:
> On Jan 3, 6:41 pm, Geoffrey Summerhayes <·······@gmail.com> wrote:
> > On Jan 3, 6:05 am, Volkan YAZICI <·············@gmail.com> wrote:
> > > (defun number-to-string (num)
> > > (remove-if-not
> > > (lambda (char) (char<= #\a char #\z))
> > > (format nil "~r" num)))
>
> > CL-USER> (loop for x from 1 to 999 summing (length (number-to-string
> > x)))
> > 21113
>
> > Maybe:
> > (defun number-to-string(number)
> > "Returns the string form of a number w/o spaces, 'and', or
> > punctuation"
> > (let ((string (format nil "~r" number)))
> > (remove-if-not #'alpha-char-p
> > (loop for j = 0 then (+ i 4)
> > for i = (search " and " string :start2 j)
> > then (search " and " string :start2 j)
> > while i do (loop for k from (+ i 1)
> > for count below 3
> > do (setf (elt string k) #
> > \Space))
> > finally (return string)))))
>
> > CL-USER> (loop for x from 1 to 999 summing (length (number-to-string
> > x)))
> > 18440
>
> I couldn't reproduce same in here.
*snip*
> I use SBCL 1.0.11.debian. Maybe this is an implementation dependent
> gotcha? (BTW, #'ALPHA-CHAR-P is a far better choice than a custom
> LAMBDA, thanks.)
Yep, at the very least, LW and clisp both insert 'and'.
I doubt they're the only ones, but that's all I have
available to test at the moment.
> > > > > (defparameter +atom-data+
>
> > > > Variables are named *foo* . +foo+ is for contants.
>
> > > Yes, but I wanted them to be constants, at least look like constants.
> > > But because of DEFCONSTANT doesn't use an EQUALP to check the values,
> > > I needed to use DEFPARAMETER.
>
> > What are you talking about????
>
> CLHS tells that
>
> The consequences are undefined if there are any bindings of the
> variable named by name at the time defconstant is executed or if
> the value is not eql to the value of initial-value.
>
> and if I'd use DEFCONSTANT instead of DEFPARAMETER, reloading same
> file makes SBCL complain that value of +ATOM-DATA+ is altered even if
> it is not. Because DEFCONSTANT uses EQL to compare the values, instead
> of EQUALP. (Did I misinterpret the related CLHS part?)
*SIGH*
No, that's right. Because it happens a lot during development, *most*
implementations will simply do it. clisp gives a warning, LW does it
silently, SBCL is a bit of an oddball in signalling it as an error.
See..
<URL: http://www.sbcl.org/manual/Defining-Constants.html#Defining-Constants
>
---
Geoff