Modify A Copy of a Structure's Field/Slot in Lisp - common-lisp

I'm trying to modify a copy of a structure's field. I tried using COPY-TREE without avail. Here is my code:
(defstruct scenario
(board '() :type list)
(letters "" :type string)
(blank-char #\- :type character))
(defparameter *scen-1*
(make-scenario
:board (string->board "cat---|a-----|b-----" #\|)))
Before SETFing:
(print *scen-1*)
#S(SCENARIO
:BOARD ("CAT---" "A-----" "B-----")
:LETTERS ""
:BLANK-CHAR #\-)
When I try to modify a copy of the board with COPY-TREE, it modifies the original board.
(let ((board (copy-tree (scenario-board *scen-1*))))
(setf (subseq (nth 1 board) 0 2) "GG"))
(print *scen-1*)
#S(SCENARIO
:BOARD ("CAT---" "GG----" "B-----")
:LETTERS ""
:BLANK-CHAR #\-)
*scen-1* should be untouched.
How can I modify a copy of the BOARD field, not the original? Thanks!


The problem is that COPY-TREE copies the list structure, but not the elements of the list. You don't really need COPY-TREE here because the list to be copied is flat.
One fix would be to write a function that replaces characters in a copy of a string with characters from another string, and then to replace the desired board element in a copy of the original board. Here is a function that does the substring replacement:
;;; Writes the characters from NEW to OLD starting from START.
(defun replace-substring (old start new)
(let ((result (copy-seq old)))
(loop for replacement across new
for i from start below (+ start (length new))
do (setf (elt result i) replacement)
finally (return result))))
And here is a function that updates a copy of the board field by updating a copy of one of its string elements:
;;; Creates a copy of the BOARD field with the Nth string replaced
;;; by a copy which has had the characters starting from POS
;;; replaced by the characters from NEW.
(defun update-board (board n pos new)
(let ((new-board (copy-list board))
(new-seq (replace-substring (nth n board) pos new)))
(setf (nth n new-board) new-seq)
new-board))
Sample interaction:
CL-USER> *scen-1*
#S(SCENARIO :BOARD ("cat---" "a-----" "b-----") :LETTERS "" :BLANK-CHAR #\-)
CL-USER> (update-board (scenario-board *scen-1*) 1 0 "gg")
("cat---" "gg----" "b-----")
CL-USER> *scen-1*
#S(SCENARIO :BOARD ("cat---" "a-----" "b-----") :LETTERS "" :BLANK-CHAR #\-)


As an alternative to the above answer, I found that MAPCAR and COPY-SEQ can be used to perform a "deep copy" of a list of strings.
(let ((board (mapcar #'copy-seq (scenario-board *scen-1*))))
etc
This does the trick as well.

Related

Common Lisp generate variable names in a macro

I'm currently learning Common Lisp and, as part of the process, am trying to implement a generic tic-tac-toe game where the board can be any odd numbered size (so there's a center square). I got to where I'm checking for winners and am working on this function to check if a row or column have a winner.
(defun straight-winner-p (board start size)
(let ((row-player (aref board start 0))
(row-count 0)
(col-player (aref board 0 start))
(col-count 0))
(loop for step from 0 to (- size 1) do
(if (equal
(aref board start step)
row-player)
(incf row-count))
(if (equal
(aref board step start)
col-player)
(incf col-count))
)
(format t "row ~a, col ~a~%" row-count col-count)))
The format call would eventually be replaced with a check if the player is nil and count equals size. Anyway, I wanted to replace the two ifs with a macro. So, it would be something like
(check row start step)
And the macro would generate the if statement
(if (equal
(aref board start step)
row-player)
(incf row-count))
Then call the same macro with (check col step start). I can't seem to get the macro to generate row-count and row-player from row. How would you do that?

How about using the functionality in the loop macro when you already use the loop macro?:
(defun straight-winner-p (board start size)
(loop :with row-player := (aref board start 0)
:and col-player := (aref board 0 start)
:for step :below size
:count (equal (aref board start step) row-player) :into row-count
:count (equal (aref board step start) col-player) :into col-count
:finally (format t "row ~a, col ~a~%" row-count col-count)
(return (or (= row-count size) (= col-count size)))))
How you do what you want:
(defmacro check (prefix start step)
(let ((player (intern (concatenate 'string (string prefix) (string '-player)) (symbol-package prefix)))
(count (intern (concatenate 'string (string prefix) (string '-count)) (symbol-package prefix))))
`(when (equal (aref board ,start ,step) ,player)
(incf ,count))))
While special care has been taken in case the macro and your code ends up in different packages and use the package of the provided symbol it will not work if the files are reade with different reader settings. If you compile one but not the other it might not work.

setf doesn't work as I think

I've just started leaning Common Lisp and I don't know why the code below returns 3:
(progn
(setq lista '(1 2))
(setq listb lista)
(setf (nth 1 listb) 3)
(nth 1 lista))
Can you help me, please?

Setq does not copy things. After (setq listb lista), both names point to the same list. When you modify it using one name, it also changes under the other.
If you want to create a copy, use copy-list, copy-tree, copy-alist, or copy-seq (see the CLHS). Also, don't modify literal data (things you quote (') are literal data).
(let* ((list-a (list 1 2))
(list-b (copy-list list-a)))
(setf (nth 1 list-b) 3)
(nth 1 list-a))

Common lisp hashtable

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).

In common lisp how can I format a floating point and specify grouping, group char and decimal separator char

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).

Joining a series of paths components in common lisp

How do I join a series of path components in common lisp?
In python, I can do,
`os.path.join("/home/", username, "dira", "dirb", "dirc");`
What would be the equivalent in common lisp?
Of course I can write my own function, but I suspect I should be able to use something built-in.

If you insist on using strings to represent pathnames, then there seems to be no built-in solution except rolling your own.
(defun join-strings (list &key (separator "/") (force-leading nil))
(let* ((length (length list))
(separator-size (length separator))
(text-size (reduce #'+ (mapcar #'length list) :initial-value 0))
(size (+ text-size (* separator-size (if force-leading length (1- length)))))
(buffer (make-string size)))
(flet ((copy-to (position string)
(loop
:with wp := position
:for char :across string
:do (setf (char buffer (prog1 wp (incf wp))) char)
:finally (return wp))))
(loop
:with wp := 0
:for string :in list
:do (when (or force-leading (plusp wp)) (setf wp (copy-to wp separator)))
(setf wp (copy-to wp string)))
buffer)))
(join-strings '("home" "kurt" "source" "file.txt") :force-leading t)
==> "/home/kurt/source/file.txt"
However, if you can use pathnames, then you could, for example, do:
(merge-pathnames #P"subdir1/subdir2/file.type" #P"/usr/share/my-app")
==> #P"/usr/share/my-app/subdir1/subdir2/file.type"
The pathname API also provides functions to manipulate pathnames symbolically, extract the components of a pathname, etc.:
(pathname-directory #P"subdir1/subdir2/file.type")
==> '(:relative "subdir1" "subdir2")
(pathname-name #P"subdir1/subdir2/file.type")
==> "file"
(pathname-type #P"subdir1/subdir2/file.type")
==> "type"
(make-pathname :name "file" :type "type" :directory '(:relative "subdir1" "subdir2"))
==> #P"subdir1/subdir2/file.type"
In particular, the directory component of a pathname is represented as a list, and thus, you can use the full set of list handling functions to derive directory values from others:
(make-pathname :directory (append '(:absolute "usr" "share") '("more" "stuff"))
:name "packages" :type "lisp")

A simpler join-strings
(defun join-strings (lst sep)
(if
(atom lst)
lst
(reduce
(lambda (a b)
(concatenate 'string a sep b))
(cdr lst)
:initial-value (car lst))))

Resources