My overly verbose lisp version of AOC day 7

aoc-day7.lisp

(ql:quickload :arrows)
(defpackage aoc-day-7
  (:use :cl)
  (:import-from :arrows
                :->
                :->>
                :-<>))
(in-package :aoc-day-7)

(declaim (optimize (safety 3) (debug 3)))
(defclass file ()
  ((name
    :accessor name
    :type Pathname
    :initarg :name
    :initform (error "NAME required")
    :documentation "The full path to the given directory")
   (is-directory
    :reader is-directory
    :type Boolean
    :initarg :is-directory
    :initform (error "IS-DIRECTORY required")
    :documentation "A clarifies if this is or isn't a file")
   (size
    :accessor size
    :type fixnum
    :initarg :size
    :initform 0))
  (:documentation "A file system directory"))

(defmethod initialize-instance :after ((instance file) &rest initargs)
  (declare (ignore initargs))
  (check-type (name instance) pathname)
  (assert (eql :absolute (car (pathname-directory
                               (name instance))))))

(defun insert (fs file)
  (declare (type file file))
  (adjoin (cons (namestring (name file))
                file)
          fs :key #'car
             :test #'equal))

(defun up (cwd)
  (let* ((cwd-string (namestring (name cwd)))
         (last-/ (position #\/ cwd-string :from-end t))
         (upper-dir (if  (and last-/
                              (= last-/ 0))
                         "/"
                         (subseq cwd-string 0 last-/))))

    (assert (string/= cwd-string "/"))

    (make-instance 'file
                   :name (pathname upper-dir)
                   :is-directory t)))

(defun update-cwd (cwd next-path)
  (cond
    ((equal next-path "..") (up cwd))
    ((eql :absolute
          (car (pathname-directory
                (directory-namestring next-path))))
     (make-instance 'file
                    :name (pathname next-path)
                    :is-directory t))
    ((not (pathname-directory
           (directory-namestring next-path)))
     (make-instance 'file
                    :name (pathname
                           (concatenate 'string
                                        (namestring (name cwd))
                                        "/"
                                        next-path))
                    :is-directory t))))

(defun cd (fs cwd path)
  (let ((new-cwd (update-cwd cwd path)))
    (values (insert fs new-cwd)
            new-cwd)))

(defun parse-commands (fs cwd line)
  (cond
    ((uiop:string-prefix-p "$ cd" line)
     (cd fs cwd (third (uiop:split-string line))))

    ((uiop:string-prefix-p "dir " line)
     (values (insert fs (update-cwd cwd
                                    (second (uiop:split-string line))))
             cwd))

    ((parse-integer line :junk-allowed t)
     (let ((location-of-file (name (update-cwd cwd
                                               (second (uiop:split-string line))))))
       (values (insert fs (make-instance 'file
                                         :name location-of-file
                                         :size (parse-integer line :junk-allowed t)
                                         :is-directory nil))
               cwd)))

    (t (assert (string= "$ ls" line))
       (values fs cwd))))

(defun create-fs (cur-fs cwd iter)
  (uiop:if-let ((line (funcall iter)))
    (multiple-value-bind (new-fs new-cwd) (parse-commands cur-fs cwd line)
      (create-fs new-fs
                 new-cwd
                 iter))
    cur-fs))

(defun num-of-slashes (str)
  (count #\/ str))

(defun size-of-dir (fs)
  (lambda (f)
    (cons (car f)
          (->> fs
               (remove-if-not
                (lambda (f2)
                  (and (or (uiop:string-prefix-p (format nil "~a/" (car f))
                                                 (car f2))
                           (string= (car f) "/"))
                       (string/= (car f) (car f2)))))
               (mapcar (lambda (f2)
                         (size (cdr f2))))
               (reduce #'+)))))

(defun size-fs ()
  (with-open-file (s #p"~/res.txt")
    (let*  ((root (make-instance 'file
                                 :name #p"/"
                                 :is-directory t))
            (root-fs `(("/" . ,root)))
            (fs (create-fs root-fs root (lambda () (read-line s nil)))))
      (mapcar (size-of-dir fs) fs))))

(defun day7 ()
  (->> (size-fs)
       (mapcar #'cdr)
       (remove-if (lambda (x) (> x 100000)))
       (reduce #'+)))
(day7)
 ; => 1783610 (21 bits, #x1B373A)

(defun day7-p2 ()
  (let ((sz-fs (size-fs)))
    (-<> sz-fs
         (remove (- (cdr (assoc "/" sz-fs :test #'equal))
                    40000000)
                 <>
                 :key #'cdr :test #'>=)
         (reduce #'min
                 <>
                 :key #'cdr))))


(day7-p2)
 ; => 4370655 (23 bits, #x42B0DF)