Advent of Code: "Not Quite Lisp"

Question

I have solved this simple challenge on Advent of Code:

Santa is trying to deliver presents in a large apartment building, but he can't find the right floor - the directions he got are a little confusing. He starts on the ground floor (floor 0) and then follows the instructions one character at a time.

An opening parenthesis, (, means he should go up one floor, and a closing parenthesis, ), means he should go down one floor.

The apartment building is very tall, and the basement is very deep; he will never find the top or bottom floors.

This is my first time trying out Lisp (and functional programming at all) and would like to see if there is anything that I could do better, or more "functionally".

I wrote the function in a manner to be quite generic, i.e., it can take any input string, and any two characters. It returns a list containing the amount of up and down characters along with the difference between the two (which is the answer to the challenge). Demo on Coding Ground

(defun count-up-down-characters-with-difference (input-string up-char down-char)
 "Given a string of any length, iterate each character of the string looking for up- and down-characters
 provided by the caller, and return the number of each, as well as the difference between them."
 (setf count-up 0) 
 (setf count-down 0)
 (loop for c across input-string do
 (if (char-equal c up-char) 
 (incf count-up))
 (if (char-equal c down-char) 
 (decf count-down)))
 (list count-up count-down (+ count-up count-down)))

Example generic usage:

(setf night-before-xmas "'Twas the night before Christmas, when all through the house, Not a creature was stirring, not even a mouse; The stockings were hung by the chimney with care, In hopes that St. Nicholas soon would be there;")
(time (print (count-up-down-characters-with-difference night-before-xmas #\e #\a))) 
;; prints:
;(21 -10 11) 
;Real time: 5.97E-4 sec. 
;Run time: 5.7E-4 sec. 
;Space: 1400 Bytes 

• 200_success: Note that iterating using loop is not functional programming.
• Phrancis: @200_success is it the loop macro, or is looping in its very nature not "FP"?
• 200_success: A rule of functional programming is that any variable, once assigned, never changes its value. Here, c changes its value with every iteration. As a rule, you can't have loops in FP (except perhaps infinite loops).

Answer 1

The IDE you linked uses CLISP, which is a bit lenient; when I evaluate that definition, I immediately get two warnings from SBCL:

; in: DEFUN COUNT-UP-DOWN-CHARACTERS-WITH-DIFFERENCE
; (SETF COUNT-DOWN 0)
; ==>
; (SETQ COUNT-DOWN 0)
;
; caught WARNING:
; undefined variable: COUNT-DOWN
; (SETF COUNT-UP 0)
; ==>
; (SETQ COUNT-UP 0)
;
; caught WARNING:
; undefined variable: COUNT-UP
;
; compilation unit finished
; Undefined variables:
; COUNT-DOWN COUNT-UP
; caught 2 WARNING conditions

That is because count-up and count-down weren't defined anywhere. It's implementation-defined what happens in this case.

So firstly let's define them with defvar:

(defvar *count-up*)
(defvar *count-down*)
...
(defvar +night-before-xmas+ "...")
...

(Constants usually have + as markers, globals *. Indentation is usually a bit different as well, I'm only going to show the Emacs-formatted code without more explanation though.)

Then again, if you want a functional solution, don't use setf (that is, assignment) or globals at all. Instead (and in general) prefer let.

A few other things to make it more idiomatic (for some value of idiomatic) are the use of the most strict equality operator possible, which here would be eql (since you check for exact equality between characters), and not using if if there's only one case, instead when or unless would be preferable.

(defun count-up-down-characters-with-difference (input-string up-char down-char)
 "..."
 (let ((count-up 0)
 (count-down 0))
 (loop
 for c across input-string
 do (when (eql c up-char)
 (incf count-up))
 (when (eql c down-char)
 (decf count-down)))
 (list count-up count-down (+ count-up count-down))))

loop also has more grammar to compress it more, but I think this is fine for now. Also consider using count instead of a manual loop, i.e.:

(defun count-up-down-characters-with-difference (input-string up-char down-char)
 "..."
 (let ((count-up (count up-char input-string))
 (count-down (- (count down-char input-string))))
 (list count-up count-down (+ count-up count-down))))

Or also (count up-char input-string :test #'char-equal) (see COUNT).

• Phrancis: I was hoping to be able to keep using the case-insensitive char-equals is there a way to make that work without the (loop for ... do(...) construct?
• ferada: Indeed, just add :test #'char-equal on the calls.

Answer 2

The version with the count feature of loop in Common Lisp:

(defun count-up-down-characters-with-difference (input-string up-char down-char)
 "Given a string of any length, iterate each character of the string looking
 for up- and down-characters provided by the caller, and return the number of
 each, as well as the difference between them."
 (loop for c across input-string
 count (char-equal c up-char) into count-up
 count (char-equal c down-char) into count-down
 finally (return (list count-up
 (- count-down)
 (- count-up count-down)))))

Answer 3

LOOP works, it's an iterative version of the algorithm. But there are other ways to implement a solution in Common Lisp.

I always try to solve a problem by checking the following techniques, generally in this order :

1. Using applicative operators (MAPCAR, MAP, REDUCE...),
2. Tail-Recursive function,
3. Iterative function (DOTIMES, DOLIST, DO, DO*).

And then I try to check performance of each version using TIME.

Here are my versions and their evaluation on a 10000 parenthesis string using SBCL 2.0.1 on OpenBSD :

;;; Applicative version :
(defun xmas-floor (instr)
 (reduce #'+
 (map 'list
 #'(lambda (c)
 (cond ((equal c #\( ) 1)
 ((equal c #\) ) -1)
 (t 0)))
 instr)))
;; Evaluation took:
;; 0.006 seconds of real time
;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system)
;; 0.00% CPU
;; 17,685,922 processor cycles
;; 30 page faults
;; 163,840 bytes consed
;; 10000

;;; Tail-Recursive version :
(defun xmas-floor (instr)
 (let ((len (length instr)))
 (labels ((helper (i fl)
 (when (equal i len)
 (return-from helper fl))
 (let ((c (elt instr i)))
 (cond ((equal c #\( ) (helper (+ i 1) (+ fl 1)))
 ((equal c #\) ) (helper (+ i 1) (- fl 1)))
 (t (helper (+ i 1) fl))))))
 (helper 0 0))))
;; Evaluation took:
;; 0.002 seconds of real time
;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system)
;; 0.00% CPU
;; 4,558,671 processor cycles
;; 0 bytes consed
;; 10000

;;; Iterative version :
(defun xmas-floor (instr)
 (let ((fl 0) (c nil))
 (dotimes (i (length instr) fl)
 (setf c (elt instr i))
 (cond ((equal c #\( ) (incf fl))
 ((equal c #\) ) (decf fl))))))
;; Evaluation took:
;; 0.000 seconds of real time
;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system)
;; 100.00% CPU
;; 1,280,905 processor cycles
;; 0 bytes consed
;; 10000

For comparison, your function using LOOP on my computer, with a string of 10000 parenthesis, gives the following evaluation :

;; Evaluation took:
;; 0.002 seconds of real time
;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system)
;; 0.00% CPU
;; 4,833,080 processor cycles
;; 0 bytes consed
;; (10000 0 10000)