aoc-2022/common-lisp/day-7/solution.lisp

#!/usr/bin/env -S sbcl --script

;; Copyright (C) 2022
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(require 'asdf)
(require 'cl-ppcre)
(require 'str)
(require 'iterate)
(require 'uiop)

(defpackage :advent-of-code-day-7
  (:use :cl)
  (:import-from :iterate :iter)
  (:import-from :uiop :if-let)
  (:shadow :directory))

(in-package :advent-of-code-day-7)

(defclass dir ()
  ((name
    :initarg :name
    :reader name)
   (parent
    :initarg :parent
    :reader parent)
   (files
    :initform nil
    :accessor files)
   (subdirs
    :initform nil
    :accessor subdirs)))

(defun mkdir (dir dirname)
  (push (cons dirname (make-instance 'dir :name dirname :parent dir)) (subdirs dir)))

(defun touch (dir filename filesize)
  (push (cons filename filesize) (files dir)))

(defun find-dir (dir dirname)
  (if-let ((d (assoc dirname (subdirs dir) :test 'string=)))
    (cdr d)
    nil))

(defun depth (dir &optional (depth 0))
  (if-let ((p (parent dir)))
    (depth p (incf depth))
    depth))

(defun size (dir)
  (with-accessors ((files files)
                   (subdirs subdirs))
      dir
    (let ((files-sum (apply '+ (mapcar 'cdr files)))
          (subdirs-sum (apply '+ (mapcar 'size (mapcar 'cdr subdirs)))))
      (+ files-sum subdirs-sum))))

(defmethod print-object ((obj dir) stream)
  (format stream "<dir ~a>" (name obj)))

(defun walk (dir &optional visited)
  (with-accessors ((subdirs subdirs))
      dir
    (push dir visited)
    (iter (iter:for (_ . subdir) in subdirs)
      (setq visited (walk subdir visited)))
    visited))

(defclass fs ()
  ((root
    :initform (make-instance 'dir :name "root" :parent nil)
    :reader root)
   (cwd
    :initform nil
    :accessor cwd)))

(defvar fs-indent-factor 4)

(defun cd (fs dirname)
  (with-accessors ((cwd cwd)
                   (root root))
      fs
    (cond ((string= dirname "/")
           (setf cwd root))
          ((string= dirname "..")
           (setf cwd (parent cwd)))
          (t
           (setf cwd (find-dir cwd dirname))))))

(defun fs-print-tree (dir stream)
  (let ((indent (* (depth dir) fs-indent-factor)))
    (iter (iter:for (filename . filesize) in (files dir))
      (format stream "~vt - ~a size=~a~%" indent filename filesize))
    (iter (iter:for (subdirname . subdir) in (subdirs dir))
      (format stream "~vt / ~a~%" indent subdirname)
      (fs-print-tree subdir stream))))

(defmethod print-object ((obj fs) stream)
  (format stream "/ root~%")
  (fs-print-tree (root obj) stream))

(defun parse-input (lines)
  (iter (iter:for line in lines)
    (iter:for parts = (str:split " " line))    
    (cond ((string= (nth 1 parts) "cd")
           (iter:collect (list 'cd (nth 2 parts))))
          ((string= (nth 0 parts) "dir")
           (iter:collect (list 'dir (nth 1 parts))))
          ((str:digit? (nth 0 parts))
           (iter:collect (list 'file (nth 1 parts) (parse-integer (nth 0 parts))))))))

(defun run-commands (events)
  (iter (iter:with fs = (make-instance 'fs))
    (iter:for event in events)
    (let* ((type (car event))
           (dir-or-file-name (cadr event))
           (size (if (equal type 'file) (car (last event)) nil)))
      (with-accessors ((root root)
                       (cwd cwd))
          fs
        (cond ((equal type 'cd)
               (cd fs dir-or-file-name))
              ((equal type 'dir)
               (mkdir cwd dir-or-file-name))
              ((equal type 'file)
               (touch cwd dir-or-file-name size))))
      (iter:finally (return fs)))))

(defun solution-part-1 (fs)
  (apply '+ (remove-if-not (lambda (size)
                           (<= size 100000))
                         (mapcar 'size (walk (root fs))))))

(defun solution-part-2 (fs)
  (let* ((fs-max-size 70000000)
         (update-size 30000000)
         (fs-used (size (root fs)))
         (fs-free (- fs-max-size fs-used))
         (size-needed (- update-size fs-free))
         (dir-sizes (mapcar 'size (walk (root fs))))
         (dirs-that-are-large-enough (remove-if-not (lambda (s) (>= s size-needed)) dir-sizes))
         (sorted (sort dirs-that-are-large-enough '<)))
    (car sorted)))

(defun run-part-1 (input)
  (let* ((events (parse-input input))
         (fs (run-commands events)))
    (solution-part-1 fs)))

(defun run-part-2 (input)
  (let* ((events (parse-input input))
         (fs (run-commands events)))
    (solution-part-2 fs)))

(assert (= (run-part-1 (uiop:read-file-lines "example.txt")) 95437))
(assert (= (run-part-1 (uiop:read-file-lines "input.txt")) 1084134))
(assert (= (run-part-2 (uiop:read-file-lines "example.txt")) 24933642))
(assert (= (run-part-2 (uiop:read-file-lines "input.txt")) 6183184))