Google HashCode 2022

(defparameter *people* nil)
(defparameter *projects* nil)
(defparameter *skills* nil)

(defun add-to-table (table data)
  (loop for row in data
        for key = (getf row :name) do
          (setf (gethash key table) row)))

(defun read-input(file)
  (setf *people* (make-hash-table :test 'equal))
  (setf *projects* (make-hash-table :test 'equal))
  (setf *skills* (make-hash-table :test 'equal))

  (with-open-file (f file :direction :input)
    (let ((people-n (read f))
          (projects-n (read f)))
      (let ((people (loop repeat people-n collect (read-people f)))
            (projects (loop repeat projects-n collect (read-project f))))
        (add-to-table *people* people)
        (add-to-table *projects* projects)
        (list :people people
              :projects projects)
        nil))))

("Bob" (("HTML" 5)
        ("CSS" 3)))
("Logging" 5 10 5 1
           (("C++" 3)))

(:name "Bob" :skills (("HTML" 5)
                      ("CSS" 3)))
(:name "Logging"
       :days 5
       :score 10
       :bf 5
       :skills (("C++" 3)))

(defun read-string (file)
  (with-output-to-string (str)
    (loop for char = (read-char file) do
          (if (equal char #\Space)
              (return)
              (write-char char str)))))

(defun register-skill (skill person)
  (let ((s (first skill))
        (l (second skill)))
    (push (list l person)
          (gethash s *skills*))))

(defun read-people (file)
  (let ((name (read-string file))
        (skill-n (read file)))
    (let ((skills (loop repeat skill-n
                        collect (list (read-string file)
                                      (read file)))))
      (let ((person
              (list :name name
                    :skills skills)))
        (loop for skill in skills do
              (register-skill skill person))
        person))))

(defun read-project (file)
  (let ((name (read-string file))
        (days (read file))
        (score (read file))
        (bb (read file))
        (roles-n (read file)))
    (let ((roles (loop repeat roles-n
                        collect (list (read-string file)
                                      (read file)))))
      (list :name name
            :days days
            :score score
            :bb bb
            :skills roles))))

(defun get-people-ge (skill level)
  "return list of people with `skill' level greater than or equal to `level'"
  (loop for (l person) in (gethash skill *skills*)
        when (>= l level)
          collect person))

(defun get-people-e (skill level)
  "return list of people with `skill' level equal to `level'"
  (loop for (l person) in (gethash skill *skills*)
        when (= l level)
          collect person))

(defun solvable? (peoples)
  "return one possible team assignment"
  ;; peoples is in reverse order
  (when (every #'first peoples)
    ;; pick min skilled person strategy
    (let ((assigned nil))
      (loop for (can may) in peoples
            for assigned? = nil do
            (loop for person in can do
              (unless (find person assigned)
                (setf assigned? t)
                (push person assigned)
                (return)))
            (unless assigned?
              (return-from solvable? nil)))
      assigned)))

(defun solvable-projects ()
  "returns list of projects that can be completed"
  (let ((result nil))
    (maphash (lambda (key value)
               (declare (ignore key))
               (let ((peoples nil)
                     (solvable t))
                 (loop for (skill level) in (getf value :skills)
                       for can-people = (get-people-ge skill level)
                       for maybe-people = (get-people-e skill (1- level)) do
                         (if (and (null maybe-people)
                                  (null can-people))
                             (progn (setf solvable nil)
                                    (return))
                             (push (list can-people
                                         maybe-people)
                                   peoples)))
                 (when solvable
                   (let ((soln (solvable? peoples)))
                     (when soln
                       (push (list :project value
                                   :people (reverse peoples)
                                   :one-solution soln)
                             result))))))
             *projects*)
    result))

(defun do-project (project people)
  (loop for (skill l) in (getf project :skills)
        for person in people
        for sk = (find skill (getf person :skills) :test #'string-equal :key #'first) do
          (when (<= (second sk) l)
            ;; level up!!
            (incf (second sk))
            (let* ((levels (gethash skill *skills*))
                   (record (find person levels :key #'second)))
              (incf (first record)))))

  (remhash (getf project :name)
           *projects*))

(defun main (file out)
  (read-input file)
  (let (result)
    (loop for solvable = (solvable-projects) do
      (unless solvable
        (return))
      (let ((assignment (getf (first solvable) :one-solution))
            (project (getf (first solvable) :project)))
        (do-project project assignment)
        (push (list :project (getf (first solvable) :project)
                    :assignment assignment)
              result)))
    (setf result (reverse result))
    (write-output out result)))