Task is to read N string like "name phone" and store in. Then find stored data with requests like "name".
My code stores names and numbers in hashtable, but after it doesn't find any values. Stored values checks with maphash (it shows all pairs key-value).
Function split-by-one-space is just utility.
(defparameter data (make-hash-table))
(defun split-by-one-space (string) ; to split string: "aaa bbb" -> (aaa bbb)
(loop for i = 0 then (1+ j)
as j = (position #\Space string :start i)
collect (subseq string i j)
while j))
(dotimes (i (read)) ; input data
(let* ((inp (read-line))
(raw (split-by-one-space inp))
(name (string (car raw)))
(phone (cadr raw)))
(format t "Adding: ~W ~W~%" name phone) ; debug
(setf (gethash name data) phone)))
(maphash #'(lambda (k v) (format t "~a => ~a~%" k v)) data) ; this show all stored data
(loop for line = (read-line *standard-input* nil :eof)
until (or (eq line :eof) (eq line nil))
do
(let ((key (gethash line data))) ; it cannot find anything. Why?
(format t "Searching: ~W~%" line) ; debug
(if (null key)
(format t "Not found~%")
(format t "~A=~A~%" (car key) (cdr key)))))
Sample input:
3
sam 99912222
tom 11122222
harry 12299933
sam
edward
harry
Unless you specify a test function, hash tables will use eql to determine "is this key identical to that key".
(defvar *s1* "a string")
(defvar *s2* "a string")
(loop for pred in '(eq eql equal equalp)
do (format t "Using ~a, the result is ~a~%"
pred (funcall pred *s1* *s2*)))
This generates the output:
Using EQ, the result is NIL
Using EQL, the result is NIL
Using EQUAL, the result is T
Using EQUALP, the result is T
In this case, the main difference between equal and equalp is that the latter is case-insensitive, while the former is not. To use another test function, use the :test keyword and one of the found "standard" test functions. If you don't need case-insensitive matches, you would simply create your hash table like this: (make-hash-table :test #'equal).
Related
I am working on a complicated macro and have run into a roadblock.
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o
(with-hash-table-iterator (next-entry ,on)
(destructuring-bind
,(apply #'append vars)
(let ((current-band (list ,#(mapcar #'not (apply #'append vars)))))
(for (i 1 ,(length (apply #'append vars)) 2)
(multiple-value-bind
(succ k v) (next-entry)
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
im getting "Evaluation aborted on #<UNDEFINED-FUNCTION NEXT-ENTRY {100229C693}>"
i dont understand why next-entry appears to be invisible to the macro i have created.
I've tried stripping down this to a small replicable example but i couldnt find a minimal scenario without the macro i created where next-entry would be invisible besides this scenario no matter what I tried, i've always managed to find a way to call next-entry in my other examples so im stumped as to why i cannot get it working here
I've tested the for macro ive created and it seems to generally work in most cases but for some reason it cannot see this next-entry variable. How do i make it visible?
In your code there are multiple places where the macro generates bindings in a way that is subject to variable capture (pdf).
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o ;; VARIABLE CAPTURE
(with-hash-table-iterator (next-entry ,on) ;; VARIABLE CAPTURE
(destructuring-bind ,(apply #'append vars)
(let ((current-band ;;; VARIABLE CAPTURE
(list ,#(mapcar #'not (apply #'append vars)))))
(for
(i ;;; VARIABLE CAPTURE
1 ,(length (apply #'append vars)) 2)
(multiple-value-bind (succ k v) ;;; VARIABLE CAPTURE
,(next-entry) ;;; WRONG EVALUATION TIME
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
A simplified example of such a capture is:
`(let ((x 0)) ,#body)
Here above, the x variable is introduced, but if the code is expanded in a context where xis already bound, then body will not be able to reference that former x binding and will always see x bound to zero (you generally don't want this behavior).
Write a function instead
Instead of writing a big macro for this, let's first try understanding what you want to achieve and write instead a higher-order function, ie. a function that calls user-provided functions.
If I understand correctly, your function iterates over a hash-table by bands of entries. I assume vars holds a list of (key value) pairs of symbols, for example ((k1 v1) (k2 v2)). Then, body works on all the key/value pairs in the band.
In the following code, the function map-each-hashtable-band accepts a function, a hash-table, and instead of vars it accepts a size, the width of the band (the number of pairs).
Notice how in your code, you only have one loop, which builds a band using the hash-table iterator. But then, since the macro is named for-each-hashtable-band, I assume you also want to loop over all the bands. The macro with-hash-table-iterator provides an iterator but does not loop itself. That's why here I have two loops.
(defun map-each-hashtable-band (function hash-table band-size)
(with-hash-table-iterator (next-entry hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(apply function current-band))
(unless next-p
(return-from outer-loop)))))))
For example:
(map-each-hashtable-band (lambda (&rest band) (print `(:band ,band)))
(alexandria:plist-hash-table
'(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5 :g 6))
2)
NB. Iterating over a hash-table happens in an arbitrary order, there is no guarantee that you'll see the entries in any particular kind of order, this is implementation-dependant.
With my current version of SBCL this prints the following:
(:BAND (:A 0 :B 1))
(:BAND (:C 2 :D 3))
(:BAND (:E 4 :F 5))
(:BAND (:G 6))
Wrap the function in a macro
The previous function might not be exactly the behavior you want, so you need to adapt to your needs, but once it does what you want, you can wrap a macro around it.
(defmacro for-each-hashtable-band (vars hash-table &body body)
`(map-each-hashtable-band (lambda ,(apply #'append vars) ,#body)
,hash-table
,(length vars)))
For example:
(let ((test (alexandria:plist-hash-table '(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5))))
(for-each-hashtable-band ((k1 v1) (k2 v2)) test
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2 v2)))
This prints:
A -> 0 && B -> 1
C -> 2 && D -> 3
E -> 4 && F -> 5
Macro-only solution, for completeness
If you want to have only one, single macro, you can start by inlining the body of the above function in the macro, you don't need to use apply anymore, but instead you need to establish bindings around the body, using destructuring-bind as you did. A first draft would be to simply as follows, but notice that this is not a proper solution:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (next-entry ,hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat ,band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(destructuring-bind ,(apply #'append vars) current-band
,#body))
(unless next-p
(return-from outer-loop))))))))
In order to be free of variable capture problems with macros, each temporary variable you introduce must be named after a symbol that cannot exist in any context you expand your code. So instead we first unquote all the variables, making the macro definition fail to compile:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop))))))))
When compiling the macro, the macro is supposed to inject symbols into the code, but here we have a compilation error that says undefined variables:
;; undefined variables: CURRENT-BAND KEY NEXT-ENTRY NEXT-P OUTER-LOOP VALUE
So now, those variables should be fresh symbols:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
(let ((current-band (gensym))
(key (gensym))
(next-entry (gensym))
(next-p (gensym))
(outer-loop (gensym))
(value (gensym)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop)))))))))
This above is a bit verbose, but you could simplify that.
Here is what the previous for-each-hashtable-band example expands into with this new macro:
(with-hash-table-iterator (#:g1576 test)
(loop :named #:g1578
:do (loop :with #:g1575
and #:g1579
and #:g1577
:repeat 2
:do (multiple-value-setq (#:g1577 #:g1575 #:g1579) (#:g1576))
:while #:g1577
:collect #:g1575 into #:g1574
:collect #:g1579 into #:g1574
:finally (progn
(when #:g1574
(destructuring-bind
(k1 v1 k2 v2)
#:g1574
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2
v2)))
(unless #:g1577 (return-from #:g1578))))))
Each time you expand it, the #:gXXXX variables are different, and cannot possibly shadow existing bindings, so for example, the body can use variables named like current-band or value without breaking the expanded code.
I am trying to implement a dictionary using lists in Common Lisp. The program is supposed to take a list of words and create a word histogram with frequency of each unique word.
This is the program:
(defparameter *histo* '())
(defun scanList (list)
(loop for word in list
do (if (assoc word histo)
((setf pair (assoc word histo))
(remove pair histo)
(setf f (+ 1 (second pair)))
(setf pair ((car pair) f))
(append histo pair))
((setf pair (word '1)) (append histo pair)))))
The error I get is: (SETF PAIR (ASSOC WORD *HISTO*)) should be a lambda expression.
Where is the syntax or semantic error exactly ?
(defun scanList (list the fox jumped over the other fox))
(princ *histo*)
Use hash-table for creating the dictionary and then transform to an association-list (alist) to sort it by key or value.
(defun build-histo (l)
(let ((dict (make-hash-table :test 'equal)))
(loop for word in l
do (incf (gethash word dict))
finally (return dict))))
;; which was simplification (by #Renzo) of
;; (defun build-histo (l)
;; (let ((dict (make-hash-table :test 'equal)))
;; (loop for word in l
;; for count = (1+ (gethash word dict 0))
;; do (setf (gethash word dict) count)
;; finally (return dict))))
(defparameter *histo* (build-histo '("a" "b" "c" "a" "a" "b" "b" "b")))
(defun hash-table-to-alist (ht)
(maphash #'(lambda (k v) (cons k v)) ht))
;; which is the same like:
;; (defun hash-table-to-alist (ht)
;; (loop for k being each hash-key of ht
;; for v = (gethash k ht)
;; collect (cons k v)))
;; sort the alist ascending by value
(sort (hash-table-to-alist *histo*) #'< :key #'cdr)
;; => (("c" . 1) ("a" . 3) ("b" . 4))
;; sort the alist descending by value
(sort (hash-table-to-alist *histo*) #'> :key #'cdr)
;; => (("b" . 4) ("a" . 3) ("c" . 1))
;; sort the alist ascending by key
(sort (hash-table-to-alist *histo*) #'string< :key #'car)
;; => (("a" . 3) ("b" . 4) ("c" . 1))
;; sort the alist descending by key
(sort (hash-table-to-alist *histo*) #'string> :eky #'car)
;; => (("c" . 1) ("b" . 4) ("a" . 3))
The posted code has a whole lot of problems. The reported error is caused by superfluous parentheses. Parentheses can't be added arbitrarily to expressions in Lisps without causing problems. In this case, these are the offending expressions:
((setf pair (assoc word histo))
(remove pair histo)
(setf f (+ 1 (second pair)))
(setf pair ((car pair) f)
(append histo pair))
((setf pair (word '1)) (append histo pair))
In both of these expressions, the results of the calls to setf are placed in the function position of a list, so the code attempts to call that result as if it is a function, leading to the error.
There are other issues. It looks like OP code is trying to pack expressions into the arms of an if form; this is probably the origin of the extra parentheses noted above. But, if forms can only take a single expression in each arm. You can wrap multiple expressions in a progn form, or use a cond instead (which does allow multiple expressions in each arm). There are some typos: *histo* is mistyped as histo in most of the code; f and pair are not defined anyplace; (setf pair (word '1)) quotes the 1 unnecessarily (which will work, but is semantically wrong).
Altogether, the code looks rather convoluted. This can be made much simpler, still following the same basic idea:
(defparameter *histo* '())
(defun build-histogram (words)
(loop :for word :in words
:if (assoc word *histo*)
:do (incf (cdr (assoc word *histo*)))
:else
:do (push (cons word 1) *histo*)))
This code is almost self-explanatory. If a word has already been added to *histo*, increment its counter. Otherwise add a new entry with the counter initialized to 1. This code isn't ideal, since it uses a global variable to store the frequency counts. A better solution would construct a new list of frequency counts and return that:
(defun build-histogram (words)
(let ((hist '()))
(loop :for word :in words
:if (assoc word hist)
:do (incf (cdr (assoc word hist)))
:else
:do (push (cons word 1) hist))
hist))
Of course, there are all kinds of other ways you might go about solving this.
Let's say I have the floating point number 1234.9
I want to format it as 1.234,90
Is there a format directive combination for that? ~D ,which can handle the grouping and the group char, handles only integers. ~F doesn't handle grouping at all. And none as far as I know can change the decimal point from . to ,
The only solution I see is to use ~D for the integer part digit grouping and concatenate it with , and the decimal part. Any better ideas?
You can define a function to be called with tilde-slash, which most of the other answers have already done, but in order to get output similar to ~F, but with comma chars injected, and with the decimal point replaced, I think it's best to call get the output produced by ~F, and then modify it and write it to the string. Here's a way to do that, using a utility inject-comma that adds a comma character at specified intervals to a string. Here's the directive function:
(defun print-float (stream arg colonp atp
&optional
(point-char #\.)
(comma-char #\,)
(comma-interval 3))
"A function for printing floating point numbers, with an interface
suitable for use with the tilde-slash FORMAT directive. The full form
is
~point-char,comma-char,comma-interval/print-float/
The point-char is used in place of the decimal point, and defaults to
#\\. If : is specified, then the whole part of the number will be
grouped in the same manner as ~D, using COMMA-CHAR and COMMA-INTERVAL.
If # is specified, then the sign is always printed."
(let* ((sign (if (minusp arg) "-" (if (and atp (plusp arg)) "+" "")))
(output (format nil "~F" arg))
(point (position #\. output :test 'char=))
(whole (subseq output (if (minusp arg) 1 0) point))
(fractional (subseq output (1+ point))))
(when colonp
(setf whole (inject-comma whole comma-char comma-interval)))
(format stream "~A~A~C~A"
sign whole point-char fractional)))
Here are some examples:
(progn
;; with # (for sign) and : (for grouping)
(format t "~','.2#:/print-float/ ~%" 12345.6789) ;=> +1.23.45,679
;; with no # (no sign) and : (for grouping)
(format t "~'.'_3:/print-float/ ~%" 12345.678) ;=> 12_345.678
;; no # (but sign, since negative) and : (for grouping)
(format t "~'.'_3:/print-float/ ~%" -12345.678) ;=> -12_345.678
;; no # (no sign) and no : (no grouping)
(format t "~'.'_3#/print-float/ ~%" 12345.678)) ;=> +12345.678 (no :)
Here are the examples from coredump-'s answer, which actually helped me catch a bug with negative numbers:
CL-USER> (loop for i in '(1034.34 -223.12 -10.0 10.0 14 324 1020231)
do (format t "~','.:/print-float/~%" i))
1.034,34
-223,12
-10,0
10,0
14,0
324,0
1.020.231,0
NIL
Here's inject-comma, with some examples:
(defun inject-comma (string comma-char comma-interval)
(let* ((len (length string))
(offset (mod len comma-interval)))
(with-output-to-string (out)
(write-string string out :start 0 :end offset)
(do ((i offset (+ i comma-interval)))
((>= i len))
(unless (zerop i)
(write-char comma-char out))
(write-string string out :start i :end (+ i comma-interval))))))
(inject-comma "1234567" #\, 3)
;;=> "1,234,567"
(inject-comma "1234567" #\. 2)
;;=> "1.23.45.67"
As the comment of jkiiski suggests, you could use the ~/func/ directive.
This is just an example, you can elaborate more with the function:
CL-USER> (defun q(stream arg &rest args)
(declare (ignore args))
(format stream
"~,,'.,:D,~a"
(truncate arg)
(let ((float-string (format nil "~f" arg)))
(subseq float-string (1+ (position #\. float-string))))))
Q
CL-USER> (format t "~/q/~%" 1024.36)
1.024,36
NIL
CL-USER> (format t "~/q/~%" -1024.36)
-1.024,36
NIL
Edited
The first version had round, which is wrong, truncate is the right operator to use.
If you don't mind splitting integer and fractional part, you can do the following:
(multiple-value-bind (int rest) (floor 1234.56)
(let ((rest (round (* rest 1000))))
(format t "~,,'.,:D,~D~%" int rest)))
1.234,560
The multiplication before rounding tells how many digits after comma you would like to print. Not sure if this approach lands itself nicely into automatic control of precision printing, i.e. 1.5 printed as "1,5" and not as "1,500".
Other answers currently use round, which is probably not the intended behavior when rounding up (positive numbers) or down (negative numbers). Here is another approach for a ~/custom/ directive, derived mostly from Renzo's answer.
(defun custom (stream number &rest args)
(declare (ignore args))
(multiple-value-bind (integer decimal) (truncate number)
(format stream "~,,'.,:D~#[,~a~]"
integer
(unless (zerop decimal)
(let ((decimal-string (princ-to-string (abs decimal))))
(subseq decimal-string (1+ (position #\. decimal-string))))))))
TESTS
(loop for i in '(1034.34 -223.12 -10.0 10.0 14 324 1020231)
collect (custom nil i))
=> ("1.034,33996582" "-223,11999512" "-10" "10" "14" "324" "1.020.231")
I've come to this little solution for positive numbers.
(defun comma-point (stream arg &rest args)
(declare (ignore args))
(multiple-value-bind (i r) (truncate arg)
(format stream "~,,',,:D.~2,'0D" i (truncate (* 100 r)))))
;; ^ ^
;; | `Decimal point
;; `Thousands separator
(defun point-comma (stream arg &rest args)
(declare (ignore args))
(multiple-value-bind (i r) (truncate arg)
(format stream "~,,'.,:D,~2,'0D" i (truncate (* 100 r)))))
(defun space-comma (stream arg &rest args)
(declare (ignore args))
(multiple-value-bind (i r) (truncate arg)
(format stream "~,,' ,:D,~2,'0D" i (truncate (* 100 r)))))
The testing numbers:
(dolist (value '(1034.34 -223.12 -10.0 10.0 14 324 1020231.099))
(format t "~16#A" (format nil "~/comma-point/" value))
(format t "~16#A" (format nil "~/point-comma/" value))
(format t "~16#A~%" (format nil "~/space-comma/" value)))
;; 1,034.33 1.034,33 1 034,33
;; -223.-11 -223,-11 -223,-11
;; -10.00 -10,00 -10,00
;; 10.00 10,00 10,00
;; 14.00 14,00 14,00
;; 324.00 324,00 324,00
;; 1,020,231.12 1.020.231,12 1 020 231,12
The second test number shows that does not work for negative numbers (-223.11 => -223,-11). Also, using truncate (or other similar functions) implies that a loss of accuracy appears, as can be seen in the last test number (1020231.099 => 1.020.231,12).
I need to write a function that will concatenate a list into a string. example:
(concatString (quote ("hello" " world"))) ==> "hello world"
here is what i have so far:
(defun concatString (list)
"A non-recursive function that concatenates a list of strings."
(cond
((not (listp list))
(princ "Error: argument to concatNR must be a list")(terpri) ())) ; check if parameter is a list
(if (not (null list)) ;check if list is not null
(let ((result (car list)))
(dolist (item (cdr list))
(if (stringp item)
(setq result (concatenate result item)))
)
)
)
)
I'm getting a "Error: "hello" is and illegal type specifier" message when i try to run it. I've tried a bunch of ways to modify this function and i havent been able to figure it out. does anyone have any ideas?
concatenate requires a sequence type specifier as its second argument. To concatenate two strings, you should call concatenate as:
(concatenate 'string "hello" "world")
Another bug in your code: you do not make sure that the car of the list is a string before assigning it to result. By fixing your code, I came up with the following implementation:
(defun concatString (list)
"A non-recursive function that concatenates a list of strings."
(if (listp list)
(let ((result ""))
(dolist (item list)
(if (stringp item)
(setq result (concatenate 'string result item))))
result)))
;; tests
> (concatString (list "hello" " world"))
"hello world"
> (concatString (list "hello" 1 2 3 " world"))
"hello world"
> (concatString (list "hello" 1 2 "3" " world"))
"hello3 world"
> (concatString (list 1 2 3 "hello" " world"))
"hello world"
The following redefinition of concatString is more efficient as it does not create many intermediary string objects:
(defun concatString (list)
"A non-recursive function that concatenates a list of strings."
(if (listp list)
(with-output-to-string (s)
(dolist (item list)
(if (stringp item)
(format s "~a" item))))))
Just use the format function on a list, this will convert everything to strings and concatenate them with the correct format string.
(defun my-concat( list )
(format nil "~{~a~}" list))
If you want to concatenate them with a space use this form with the "~^" directive:
(defun my-concat( list )
(format nil "~{~a~^ ~}" list))
If you'd like to filter out the results, you can just transform the list before formatting it.
(defun my-concat(list)
(format nil "~{~a~^ ~}" (remove-if-not #'stringp list)))
To concatenate sequences to a string, use concatenate 'string.
(defun concat-strings (list)
(apply #'concatenate 'string list))
To remove anything from the list that is not a string, use remove-if-not.
(defun concat-strings (list)
(apply #'concatenate 'string
(remove-if-not #'stringp list)))
If the argument is not a list, an error will be signaled by remove-if-not. You can add the assertion before, of course, to give a more specific error message, but it does not really add value here.
(defun concat-strings (list)
(assert (listp list)
"This is not a list: ~s." list)
(apply #'concatenate 'string
(remove-if-not #'stringp list)))
EDIT:
As Rainer notes, apply only works on lists of limited length. If you do not have reason to believe that your list cannot be longer than call-arguments-limit minus one, a reduce form is better:
(defun concat-strings (list)
(reduce (lambda (a b)
(concatenate 'string a b))
(remove-if-not #'stringp list)))
Common Lisp the Language, 2nd Edition
concatenate result-type &rest
sequences
This one should work
(concatenate 'string result item)
According to the Common Lisp Cookbook :
(concatenate 'string "Karl" " " "Marx")
"Karl Marx"
Why limit yourself to lists?
(defun concatenate-strings (sequence)
(reduce #'(lambda (current next)
(if (stringp next)
(concatenate 'string current next)
current))
sequence
:initial-value ""))
Here are my two cents:
(defmacro concatString (&rest strings) `(concatenate 'string
,#strings) )
I want to parse the text line from the Wavefront OBJ file. Currently I am interested in "V" and "F" types only.
My algorithm is as follows:
check if line is not nil (otherwise step 2 would fail)
drop comment after "#" and trim spaces
drop prefix "v " or "f "
split string to the list of elements where each element
is split to the list if it is symbol like |34/76/23|
is converted from the list: I take one element only, the first by default
or coerced to the given type if it is atomic number already.
Here is the code:
(defun parse-line (line prefix &key (type 'single-float))
(declare (optimize (debug 3)))
(labels ((rfs (what)
(read-from-string (concatenate 'string "(" what ")")))
(unpack (str &key (char #\/) (n 0))
(let ((*readtable* (copy-readtable)))
(when char ;; we make the given char a delimiter (space)
(set-syntax-from-char char #\Space))
(typecase str
;; string -> list of possibly symbols.
;; all elements are preserved by (map). nil's are dropped
(string (delete-if #'null
(map 'list
#'unpack
(rfs str))))
;; symbol -> list of values
(symbol (unpack (rfs (symbol-name str))))
;; list -> value (only the requested one)
(list (unpack (nth n str)))
;; value -> just coerce to type
(number (coerce str type))))))
(and line
(setf line (string-trim '(#\Space #\Tab)
(subseq line 0 (position #\# line))))
(< (length prefix) (length line))
(string= line prefix :end1 (length prefix) :end2 (length prefix))
(setf line (subseq line (length prefix)))
(let ((value (unpack line :char nil)))
(case (length value)
(3 value)
(4 (values (subseq value 0 3) ;; split quad 0-1-2-3 on tri 0-1-2 + tri 0-2-3
(list (nth 0 value)
(nth 2 value)
(nth 3 value)))))))))
Step four (label "unpack") is kind of recursive. It is one function and can call itself three times.
Anyway, this solution seems to be clunky.
My question is: how should one solve this task with shorter and clearer code?
I would approach this in a more structured manner.
You want to parse an obj file into some sort of data structure:
(defun parse-obj-file (filespec)
;; todo
)
You need to think about how the data structure returned should look. For now, let us return a list of two lists, one of the vertices, one of the faces. The parser will go through each line, determine whether it is either a vertex or a face, and then collect it into the appropriate list:
(defun parse-obj-file (filespec)
(with-open-file (in-stream filespec
:direction :input)
(loop for line = (read-line in-stream nil)
while line
when (cl-ppcre:scan "^v " line)
collect (parse-vertex line) into vertices
when (cl-ppcre:scan "^f " line)
collect (parse-face line) into faces
finally (return (list vertices faces)))))
I used the cl-ppcre library here, but you could also use mismatch or search. You will then need to define parse-vertex and parse-face, for which cl-ppcre:split should come in quite handy.
It would perhaps also be useful to define classes for vertices and faces.
Update: This is how I would approach vertices:
(defclass vertex ()
((x :accessor x :initarg :x)
(y :accessor y :initarg :y)
(z :accessor z :initarg :z)
(w :accessor w :initarg :w)))
(defun parse-vertex (line)
(destructuring-bind (label x y z &optional w)
(cl-ppcre:split "\\s+" (remove-comment line))
(declare (ignorable label))
(make-instance 'vertex
:x (parse-number x)
:y (parse-number y)
:z (parse-number z)
:w (parse-number w))))
Parse-number is from the parse-number library. It is better than using read.
Update 2: (Sorry for making this a run-on story; I have to interlace some work.) A face consists of a list of face-points.
(defclass face-point ()
((vertex-index :accessor vertex-index :initarg :vertex-index)
(texture-coordinate :accessor texture-coordinate
:initarg :texture-coordinate)
(normal :accessor normal :initarg :normal)))
(defun parse-face (line)
(destructuring-bind (label &rest face-points)
(cl-ppcre:split "\\s+" (remove-comment line))
(declare (ignorable label))
(mapcar #'parse-face-point face-points)))
(defun parse-face-point (string)
(destructuring-bind (vertex-index &optional texture-coordinate normal)
(cl-ppcre:split "/" string)
(make-instance 'face-point
:vertex-index vertex-index
:texture-coordinate texture-coordinate
:normal normal)))
Remove-comment simply throws away everything after the first #:
(defun remove-comment (line)
(subseq line 0 (position #\# line)))