Hi,
I need to convert a file that contains a rectangular block of letters
into a 2-dimensional array.
I have written the following code that does it, however i think that it
is not 'lispy' enough. I want to have a collect clause in it instead of
manually doing the collecting and also remove the temporary variables -
line & result. However i have not been able to come up with a solution
because of the required nesting.
(defun stream-to-multi-dimensional-list (stream)
(let ((result ())
(line ()))
(loop for c = (read-char stream nil)
while (characterp c)
do (progn
(if (equal c #\Newline)
(progn
(push (reverse line) result)
(setq line ()))
(push c line))))
(unless (null line)
(push (reverse line) result))
(reverse result)))
(defun stream-to-multi-dimensional-array (stream)
(let ((l (stream-to-multi-dimensional-list stream)))
(make-array (list (length l) (length (first l))) :initial-contents
l)))
CG-USER(13): (with-input-from-string (stream "abcd
efgh
ijkl")
(stream-to-multi-dimensional-array stream))
#2A((#\a #\b #\c #\d) (#\e #\f #\g #\h) (#\i #\j #\k #\l))
Would you have any suggestions?
Thanks,
Dmitry Jouravlev
Dmitry Jouravlev ha scritto:
> Hi,
>
> I need to convert a file that contains a rectangular block of letters
> into a 2-dimensional array.
>
> I have written the following code that does it, however i think that it
> is not 'lispy' enough. I want to have a collect clause in it instead of
> manually doing the collecting and also remove the temporary variables -
> line & result. However i have not been able to come up with a solution
> because of the required nesting.
>
> (defun stream-to-multi-dimensional-list (stream)
> (let ((result ())
> (line ()))
> (loop for c = (read-char stream nil)
> while (characterp c)
> do (progn
> (if (equal c #\Newline)
> (progn
> (push (reverse line) result)
> (setq line ()))
> (push c line))))
> (unless (null line)
> (push (reverse line) result))
> (reverse result)))
>
> (defun stream-to-multi-dimensional-array (stream)
> (let ((l (stream-to-multi-dimensional-list stream)))
> (make-array (list (length l) (length (first l))) :initial-contents
> l)))
>
> CG-USER(13): (with-input-from-string (stream "abcd
> efgh
> ijkl")
> (stream-to-multi-dimensional-array stream))
> #2A((#\a #\b #\c #\d) (#\e #\f #\g #\h) (#\i #\j #\k #\l))
>
>
> Would you have any suggestions?
>
> Thanks,
> Dmitry Jouravlev
What about having two loops one for rows and one for colums?
Or a recursive function?
Do you want to use only one loop?
matteo
matteo d'addio 81 wrote:
> Dmitry Jouravlev ha scritto:
>
> > Hi,
> >
> > I need to convert a file that contains a rectangular block of letters
> > into a 2-dimensional array.
> >
> > I have written the following code that does it, however i think that it
> > is not 'lispy' enough. I want to have a collect clause in it instead of
> > manually doing the collecting and also remove the temporary variables -
> > line & result. However i have not been able to come up with a solution
> > because of the required nesting.
> >
> > (defun stream-to-multi-dimensional-list (stream)
> > (let ((result ())
> > (line ()))
> > (loop for c = (read-char stream nil)
> > while (characterp c)
> > do (progn
> > (if (equal c #\Newline)
> > (progn
> > (push (reverse line) result)
> > (setq line ()))
> > (push c line))))
> > (unless (null line)
> > (push (reverse line) result))
> > (reverse result)))
> >
> > (defun stream-to-multi-dimensional-array (stream)
> > (let ((l (stream-to-multi-dimensional-list stream)))
> > (make-array (list (length l) (length (first l))) :initial-contents
> > l)))
> >
> > CG-USER(13): (with-input-from-string (stream "abcd
> > efgh
> > ijkl")
> > (stream-to-multi-dimensional-array stream))
> > #2A((#\a #\b #\c #\d) (#\e #\f #\g #\h) (#\i #\j #\k #\l))
> >
> >
> > Would you have any suggestions?
> >
> > Thanks,
> > Dmitry Jouravlev
>
> What about having two loops one for rows and one for colums?
Brilliant!
now why didn't i think of that...
(defun stream-to-multi-dimensional-list2 (stream)
(loop for line =
(loop for c = (read-char stream nil)
while (and (characterp c) (not (equal c #\Newline)))
collect c)
while (not (null line))
collect line))
Thats much better...
Thanks!
> Or a recursive function?
>
> Do you want to use only one loop?
>
> matteo
"Dmitry Jouravlev" <·········@aussiemail.com.au> writes:
> matteo d'addio 81 wrote:
>> Dmitry Jouravlev ha scritto:
>>
>> > Hi,
>> >
>> > I need to convert a file that contains a rectangular block of letters
>> > into a 2-dimensional array.
>> >
>> > I have written the following code that does it, however i think that it
>> > is not 'lispy' enough. I want to have a collect clause in it instead of
>> > manually doing the collecting and also remove the temporary variables -
>> > line & result. However i have not been able to come up with a solution
>> > because of the required nesting.
>> >
>> > (defun stream-to-multi-dimensional-list (stream)
>> > (let ((result ())
>> > (line ()))
>> > (loop for c = (read-char stream nil)
>> > while (characterp c)
>> > do (progn
>> > (if (equal c #\Newline)
>> > (progn
>> > (push (reverse line) result)
>> > (setq line ()))
>> > (push c line))))
>> > (unless (null line)
>> > (push (reverse line) result))
>> > (reverse result)))
>> >
>> > (defun stream-to-multi-dimensional-array (stream)
>> > (let ((l (stream-to-multi-dimensional-list stream)))
>> > (make-array (list (length l) (length (first l))) :initial-contents
>> > l)))
>> >
>> > CG-USER(13): (with-input-from-string (stream "abcd
>> > efgh
>> > ijkl")
>> > (stream-to-multi-dimensional-array stream))
>> > #2A((#\a #\b #\c #\d) (#\e #\f #\g #\h) (#\i #\j #\k #\l))
>> >
>> >
>> > Would you have any suggestions?
>> >
>> > Thanks,
>> > Dmitry Jouravlev
>>
>> What about having two loops one for rows and one for colums?
> Brilliant!
>
> now why didn't i think of that...
>
> (defun stream-to-multi-dimensional-list2 (stream)
> (loop for line =
> (loop for c = (read-char stream nil)
> while (and (characterp c) (not (equal c #\Newline)))
> collect c)
> while (not (null line))
> collect line))
>
You can still remove one loop.
(defun stream-to-multi-dimensional-list2 (stream)
(loop for line = (read-line stream nil nil)
while line
collect (coerce line 'list)))
--
Surendra Singhi
http://www.public.asu.edu/~sksinghi/index.html
,----
| By all means marry; if you get a good wife, you'll be happy. If you
| get a bad one, you'll become a philosopher.
| -- Socrates
`----
"Dmitry Jouravlev" <·········@aussiemail.com.au> writes:
> (defun stream-to-multi-dimensional-list (stream)
> (let ((result ())
> (line ()))
> (loop for c = (read-char stream nil)
> while (characterp c)
> do (progn
> (if (equal c #\Newline)
> (progn
> (push (reverse line) result)
> (setq line ()))
> (push c line))))
> (unless (null line)
> (push (reverse line) result))
> (reverse result)))
This is not really a solution to your problem, but it may be
educational to inspect this version:
(defun stream-to-multi-dimensional-list (stream)
(loop for line = (read-line stream nil)
while line
collect (coerce line 'list)))
On 21 Nov 2005 03:04:06 -0800, "Dmitry Jouravlev"
<·········@aussiemail.com.au> tried to confuse everyone with this
message:
>(defun stream-to-multi-dimensional-list (stream)
> (let ((result ())
> (line ()))
> (loop for c = (read-char stream nil)
> while (characterp c)
> do (progn
This progn is rather superfluous. Not only it contains only one form,
but LOOP's DO can contain many forms at once already.
> (if (equal c #\Newline)
> (progn
> (push (reverse line) result)
> (setq line ()))
> (push c line))))
> (unless (null line)
> (push (reverse line) result))
> (reverse result)))
--
|a\o/r|,-------------.,---------- Timofei Shatrov aka Grue ------------.
| m"a ||FC AMKAR PERM|| mail: grue at mail.ru http://grue3.tripod.com |
| k || PWNZ J00 || Kingdom of Loathing: Grue3 lvl 18 Seal Clubber |
`-----'`-------------'`-------------------------------------------[4*72]
"Dmitry Jouravlev" <·········@aussiemail.com.au> writes:
> I need to convert a file that contains a rectangular block of letters
> into a 2-dimensional array.
You may wish to enjoy the fact that the initial contents to
make-array is a nested structure of sequences. Thus one may
mix lists and vectors and indeed a relevant list of vectors
is easily come by
CL-USER> (defun letter-matrix (stream)
(let ((lines (loop for line = (read-line stream nil nil)
while line
collect line)))
(make-array (list (length lines)
(length (car lines)))
:initial-contents lines)))
LETTER-MATRIX
CL-USER> (with-input-from-string (stream "abcd
efgh
ijkl")
(letter-matrix stream))
#2A((#\a #\b #\c #\d) (#\e #\f #\g #\h) (#\i #\j #\k #\l))
Alan Crowe
Edinburgh
Scotland
Alan Crowe <····@cawtech.freeserve.co.uk> wrote:
+---------------
| You may wish to enjoy the fact that the initial contents to make-array
| is a nested structure of sequences. Thus one may mix lists and vectors
| and indeed a relevant list of vectors is easily come by
| CL-USER> (defun letter-matrix (stream)
| (let ((lines (loop for line = (read-line stream nil nil)
| while line
| collect line)))
| (make-array (list (length lines)
| (length (car lines)))
| :initial-contents lines)))
| LETTER-MATRIX
| CL-USER> (with-input-from-string (stream "abcd
| efgh
| ijkl")
| (letter-matrix stream))
| #2A((#\a #\b #\c #\d) (#\e #\f #\g #\h) (#\i #\j #\k #\l))
+---------------
And by specializing the array with some subtype of CHARACTER,
one can also explore some of the consequences of arrays being
stored in row-major order:
> (defun letter-matrix (stream)
(let ((lines (loop for line = (read-line stream nil nil)
while line
collect line)))
(make-array (list (length lines)
(length (car lines)))
:initial-contents lines
:element-type 'base-char)))
LETTER-MATRIX
> (with-input-from-string (stream "Here we
have an
example
that is
so fun.
") (letter-matrix stream))
#2A((#\H #\e #\r #\e #\ #\w #\e)
(#\h #\a #\v #\e #\ #\a #\n)
(#\e #\x #\a #\m #\p #\l #\e)
(#\t #\h #\a #\t #\ #\i #\s)
(#\s #\o #\ #\f #\u #\n #\.))
> (make-array (reduce #'* (array-dimensions *))
:element-type 'base-char
:displaced-to *)
"Here wehave anexamplethat isso fun."
> (type-of *)
(BASE-STRING 35)
> (setf (aref *** 4 6) #\!)
#\!
cmu> ***
"Here wehave anexamplethat isso fun!"
>
Thus showing that the two-dimensional array really is, in this case,
"the same" string as the displaced array.
-Rob
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
"Dmitry Jouravlev" <·········@aussiemail.com.au> writes:
> I need to convert a file that contains a rectangular block of letters
> into a 2-dimensional array.
>
> I have written the following code that does it, however i think that it
> is not 'lispy' enough. I want to have a collect clause in it instead of
> manually doing the collecting and also remove the temporary variables -
> line & result. However i have not been able to come up with a solution
> because of the required nesting.
> [...]
> Would you have any suggestions?
What about reading the whole block at once and displacing the vector
to a 2D array?
If you know the dimensions of the array beforehand:
(defun read-char-matrix (stream cols rows)
(let ((characters (make-array (* rows (1+ cols))
:element-type 'character)))
(assert (= (* rows (1+ cols)) (read-sequence characters stream)))
(make-array (list rows (1+ cols))
:element-type 'character
:displaced-to characters)))
[32]> (let ((a (with-input-from-string (in "abcd
efgh
1234
") (read-char-matrix in 4 3))))
(loop :for i :below 3
:do (loop :for j :below 4
:do (format t "~C " (aref a i j))
:finally (format t "~%"))))
a b c d
e f g h
1 2 3 4
NIL
--
"You question the worthiness of my code? I should kill you where you
stand!"
Hi everyone,
Thanks very much for your suggestions. I settled on the following:
(defun read-char-matrix (stream)
(let ((lines (loop for line = (read-line stream nil)
while line
collect line)))
(make-array (list (length lines) (length (first lines)))
:initial-contents lines)))
However, i have a similar problem with another one of my functions for
a crossword program i'm writing - i again don't like the style of the
code that i've written. The skeleton of the code looks like this:
(defclass letter ()
((name :initarg name :initform nil :documentation "letter
name")
(horz-word :initarg horz-word :initform nil :documentation
"containing horizontal word")
(horz-pos :initarg horz-pos :initform nil :documentation "position
in the containing horizontal word")
(vert-word :initarg vert-word :initform nil :documentation
"containing vertical word")
(vert-pos :initarg vert-pos :initform nil :documentation "position
in the containing vertical word")))
(defclass word ()
((name :initarg name :initform nil :documentation "word name")
(letters :initarg letters :initform nil :documentation "contained
letters")))
(defun create-letters (grid)
(let ((letters (make-array (array-dimensions grid))))
(loop for y below (array-dimension letters 0)
do (loop for x below (array-dimension letters 1)
do (unless (equal (aref grid y x) #\Space)
(setf (aref letters y x)
(make-instance 'letter 'name (list x y))))))
letters))
(defun create-horz-words (letters)
(let ((words nil))
(loop for y below (array-dimension letters 0)
do (let ((word nil)
(word-pos 0))
(loop for x below (array-dimension letters 1)
do (let ((letter (aref letters y x)))
(if (null letter)
(when word
(let ((word-letters (slot-value word
'letters)))
(when (> (length word-letters) 1)
(setf (slot-value word 'letters)
(reverse word-letters))
(push word words)))
(setq word nil))
(progn
(unless word
(setq word (make-instance 'word 'name (list
x y "horizontal")))
(setq word-pos 0))
(push letter (slot-value word 'letters))
(setf (slot-value letter 'horz-word) word)
(setf (slot-value letter 'horz-pos) word-pos)
(incf word-pos)))))
(when word
(let ((word-letters (slot-value word 'letters)))
(when (> (length word-letters) 1)
(setf (slot-value word 'letters) (reverse
word-letters))
(push word words))))))
(reverse words)))
(defun create-vert-words (letters)
(let ((words nil))
(loop for x below (array-dimension letters 1)
do (let ((word nil)
(word-pos 0))
(loop for y below (array-dimension letters 0)
do (let ((letter (aref letters y x)))
(if (null letter)
(when word
(let ((word-letters (slot-value word
'letters)))
(when (> (length word-letters) 1)
(setf (slot-value word 'letters)
(reverse word-letters))
(push word words)))
(setq word nil))
(progn
(unless word
(setq word (make-instance 'word 'name (list
x y "vertical")))
(setq word-pos 0))
(push letter (slot-value word 'letters))
(setf (slot-value letter 'vert-word) word)
(setf (slot-value letter 'vert-pos) word-pos)
(incf word-pos)))))
(when word
(let ((word-letters (slot-value word 'letters)))
(when (> (length word-letters) 1)
(setf (slot-value word 'letters) (reverse
word-letters))
(push word words))))))
(reverse words)))
(defparameter *grid*
(with-input-from-string (stream "qwe rty
a s d f
zxc vbn")
(read-char-matrix stream)))
(defparameter *letters* (create-letters *grid*))
(defparameter *words*
(append (create-horz-words *letters*)
(create-vert-words *letters*)))
The idea is that given a rectangular character matrix (obtained via
read-char-matrix) to create some letter and word objects that reference
each other. The above code creates a letter array in *letters* and a
list of words in *words* (qwe, rty, zxc, vbn, qaz, esc, rdv, yfn).
The code i don't like is in create-horz-words and create-vert-words.
There, I again had to manually collect a list of 'words' because i need
to set the 'word' and 'word-pos' into every letter. Is there a way to
still do this using a collect without the temporary variables and push
/ reverse?
A second problem in those functions is that I am not aware of how to
parametrise the loop variables (the x & y) because they are part of a
macro, so i had to duplicate most of the content of those two
functions. Ie i could not get the following to work:
(defun create-words (letters horz)
(let ((dir (if horz "horizontal" "vertical"))
(word-slot (if horz 'horz-word 'vert-word))
(pos-slot (if horz 'horz-pos 'vert-pos)))
(outer-loop-variable (if horz 'x 'y)) ; these are the
problem
(inner-loop-variable (if horz 'y 'x))) ; these are the
problem
....
Do you have any suggestions?
Of course, suggestions about other parts of code are welcome as well :)
Thanks,
Dmitry Jouravlev
"Dmitry Jouravlev" <·········@aussiemail.com.au> writes:
> (defun create-horz-words (letters)
> (let ((words nil))
> (loop for y below (array-dimension letters 0)
> do (let ((word nil)
> (word-pos 0))
> (loop for x below (array-dimension letters 1)
> do (let ((letter (aref letters y x)))
> (if (null letter)
> (when word
> (let ((word-letters (slot-value word
> 'letters)))
> (when (> (length word-letters) 1)
> (setf (slot-value word 'letters)
> (reverse word-letters))
> (push word words)))
> (setq word nil))
> (progn
> (unless word
> (setq word (make-instance 'word 'name (list
> x y "horizontal")))
> (setq word-pos 0))
> (push letter (slot-value word 'letters))
> (setf (slot-value letter 'horz-word) word)
> (setf (slot-value letter 'horz-pos) word-pos)
> (incf word-pos)))))
> (when word
> (let ((word-letters (slot-value word 'letters)))
> (when (> (length word-letters) 1)
> (setf (slot-value word 'letters) (reverse
> word-letters))
> (push word words))))))
> (reverse words)))
and a very similar create-vert-words
> The code i don't like is in create-horz-words and create-vert-words.
> There, I again had to manually collect a list of 'words' because i need
> to set the 'word' and 'word-pos' into every letter. Is there a way to
> still do this using a collect without the temporary variables and push
> / reverse?
>
> A second problem in those functions is that I am not aware of how to
> parametrise the loop variables (the x & y) because they are part of a
> macro, so i had to duplicate most of the content of those two
> functions. Ie i could not get the following to work:
> (defun create-words (letters horz)
> (let ((dir (if horz "horizontal" "vertical"))
> (word-slot (if horz 'horz-word 'vert-word))
> (pos-slot (if horz 'horz-pos 'vert-pos)))
> (outer-loop-variable (if horz 'x 'y)) ; these are the
> problem
> (inner-loop-variable (if horz 'y 'x))) ; these are the
> problem
> ....
>
> Do you have any suggestions?
I've been watching this thread to see if anyone would
respond - my guess was that nobody would: so many details,
so little time.
I've also been watching it because my code tends to look
like Dmitry's and I don't like my code either. It looks
perfectly readable when I have just finished writing it, but
when I come back to it in three months time I find it quite
time consuming to re-read it and get back into it. So many
details, so little time. Indeed my medium sized project,
Seal Song, has bogged down for exactly this reason. I've
written enough code that I'm adding to an existing code
base. If I can find 5 hours to add a feature to the existing
code, then the issue of whether it takes 2 hours to read the
code base and plan the changes, or whether it takes 4 hours
to do this becomes highly leveraged, determining whether I
have one hour or three remaining to write it and debug it.
Obviously the clarity of code is a quantitative
measure. Nevertheless, one wants to quantize this quite
coarsely, to say this code is clear, that code is turbid,
and make sure that all the code meets the standard for
clarity.
Can one get away with a two level quantization, clear or
turbid? I am beginning to think that one cannot. One needs
three levels
1)Puzzle
2)Prose
3)Poem
PUZZLE is easy enough to explain: you have to puzzle out how
the code works. It feels like it would be easier to rewrite
it from scratch. Probably it would take 3 times as long to
do it again.
PROSE is honest work-man like code that tells the computer
what to do in a straight forward way. One reads it slowly
and carefully. One understands. It feels that one is getting
a benefit from building on an existing code base rather than
starting over, and yet something doesn't feel right. One is
concentrating hard, burning glucose to kept the short term
memory powered up (or something, I don't know much about
brain physiology) and eating away at the limited stock of
hours of 100% full-on concentration that one is hoping to
reserve for strategic planning and new coding.
POEM is my hope that code could be better, some how it could
capture the analysis that makes the code make sense. The
insight that let you write the code in the first place would
still be there, cracking open the problem in a way that is
easy to comprehend.
Clearly one needs to write PROSE instead of PUZZLE. I think
that there is another stage, of turning code into POETRY
instead of PROSE, with the hope that a clearer code base
will expand the limits of how large a program one can write.
So I'm thrashing about wondering how to do this, and trying
to rewrite Dmitry's code to be more accessible looks like a
useful exercise.
My first idea saw the core of the problem as being to break
up a list of items into a list of non-empty sub-lists as
indicated by certain items being separators.
I tried generalising this with functional arguments, and I
tried generalising this CLOS. I ended up with a
place-in-array object, that responded to messages such as
end-test, current-value, step-forward,
separator-p. Obviously I was aiming at having two kinds of
place-in-array object, for horizontal scanning and vertical
scanning.
This proved too clumsy, there were too many messages in my
objects protocol.
Thinking some more, I decided that the distinction between
1)hitting a separator charactor
2)reaching the end of the list, or the end of the row and
staring on the next one.
was somewhat artificial. There were just two things going
on, accumulating and separating. Either you add your letter
to a part formed word, or you finish the word and add it too
your list of complete words. So you process a letter by
choosing either to accumulate of separate and you respond to
breaks between rows and finishing by separating. Accordingly
I put accumulate, seperate, and process into local
functions.
This left the issue of parameterising the directions. That
looks like it can easily go horribly wrong. You could end up
with one routine but it would be just as long as the
concatenation of the two you started with because it would
be full of
(case direction
(vertical (array-dimension a 0))
(horizontal (array-dimension a 1)))
splitting into two cases all over the code.
I decide that provided the clever processing could be moved
out of the loops into local functions it was simpler to just
have two loops. I ended up with
(defclass letter ()
((name :accessor name
:initarg :name
:documentation "x y")
(horz-word :accessor horz-word)
(horz-pos :accessor horz-pos)
(wert-word :accessor vert-word)
(vert-pos :accessor vert-pos)))
(defun create-letters (grid)
(let ((letters (make-array (array-dimensions grid)
:initial-element nil)))
(loop for y below (array-dimension letters 0)
do (loop for x below (array-dimension letters 1)
do (unless (equal (aref grid y x) #\Space)
(setf (aref letters y x)
(make-instance 'letter :name (list x y))))))
letters))
(defclass word ()
((name :accessor name
:initarg :name
:documentation "x y orientation")
(letters :accessor letters
:initarg :letters)))
(defun parse-x-word (matrix)
(let (result accumulator)
(labels ((accumulate (letter)
(push letter accumulator))
(separate (orientation)
(when accumulator
(let* ((letters (nreverse accumulator))
(word (make-instance 'word
:name (append (name (first letters))
(list orientation))
:letters letters)))
(push word result)
;; back link from letters to containing word
(loop for letter in letters
and index upfrom 0 do
(ecase orientation
(:horz (setf (horz-word letter) word
(horz-pos letter) index))
(:vert (setf (vert-word letter) word
(vert-pos letter) index))))
(setf accumulator nil))))
(process (letter orientation)
(if letter
(accumulate letter)
(separate orientation))))
(loop for row below (array-dimension matrix 0) do
(loop for col below (array-dimension matrix 1)
do (process (aref matrix row col) :horz))
(separate :horz))
(loop for col below (array-dimension matrix 1) do
(loop for row below (array-dimension matrix 0) do
(process (aref matrix row col) :vert))
(separate :vert))
(nreverse result))))
Hmm, labels should be two flets
flet accumulate separate
flet process
That great problem in learning to write good code is that
I've just written this, so it looks very clear to me
today. Is it prose or poetry? I will not get to judge myself
until I come back to it in three months time.
What does comp.lang.lisp think? Is this code better, worse,
or more of the same?
Alan Crowe
Edinburgh
Scotland