solver.lisp

;; 
;; kirimochi
;; 

(ql:quickload '(alexandria
                split-sequence))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;    Solver
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun solve-from-file (filename)
  (let (n m start)
    (with-open-file (in filename)
      (let* ((li (read-line in nil nil))
             (nm (mapcar (lambda (l) (parse-integer l :junk-allowed t))
                         (split-sequence:split-sequence #\space li))))
        (setf n (car nm))
        (setf m (cadr nm))
        (setf start (1+ (length li)))))
    (solve n m start (alexandria:read-file-into-byte-vector filename))))

(defmacro ?g (i j)
  `(evenp
    (the (unsigned-byte 8)
         (aref g (+ start (the (unsigned-byte 16) ,j) (* (1+ m) (the (unsigned-byte 16) ,i)))))))

(defmacro ?gn (i j)
  `(oddp
    (the (unsigned-byte 8)
         (aref g (+ start (the (unsigned-byte 16) ,j) (* (1+ m) (the (unsigned-byte 16) ,i)))))))

(defun solve (n m start g)
  (declare (optimize (speed 3) (debug 0) (safety 0) (compilation-speed 0) (space 0)))
  (declare ((unsigned-byte 16) n m start))
  (declare ((simple-array (unsigned-byte 8) (*)) g))
  (format t "N: ~A~%M: ~A~%" n m)
  (let ((kirimochies 0))
    (declare ((unsigned-byte 32) kirimochies))
    (loop :for i fixnum :to (- n 3)
       :do (loop :for j fixnum :to (- m 3)
              :do (block nmblock
                    (cond ((?g i (+ j 2))
                           (incf j 2)
                           (return-from nmblock))

                          ((?g i (1+ j))
                           (incf j)
                           (return-from nmblock))

                          ((?g i j)
                           (return-from nmblock))

                          ((or (?g (1+ i) j)
                               (?g (+ i 2) j))
                           (return-from nmblock)))
                    (let ((maxn 1)
                          (maxm 1))
                      (declare ((unsigned-byte 8) maxn maxm))
                      
                      (loop :for ii fixnum :from (+ i 2) :to (- n 1) :while (?gn ii j)
                         :do (incf maxn))
                      (loop :for jj fixnum :from (+ j 2) :to (- m 1) :while (?gn i jj)
                         :do (incf maxm))

                      (loop :for n+i fixnum :from (+ 2 i) :to (+ maxn i)
                         :do (loop :for m+j fixnum :from j :to (+ maxm j) :while (?gn n+i m+j)
                                :do (when (> (- m+j j) 1)
                                      (loop :for k :from i :to n+i :while (?gn k m+j)
                                         :do (when (= k n+i)
                                               (incf kirimochies))))))))))
    kirimochies))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;    Utilities
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun save-problem (pathname n m p)
  (with-open-file (out pathname :direction :output :if-exists :supersede)
    (format out "~A ~A~%" n m)
    (loop :repeat n
       :do (loop :repeat m
              :do (format out "~A" (if (> p (random 100))
                                       #\#
                                       #\.)))
       (format out "~%"))))

(defun make-problem (n m p)
  (format nil "~A ~A~%~{~A~}" n m
          (loop :repeat n
             :append (append (loop :repeat m
                                :collect (if (> p (random 10))
                                             #\#
                                             #\.)) '(#\newline)))))

(defmacro num-of-kirimoties (n m)
  `(/ (* (- ,m 2)
         (- ,m 1)
         (- ,n 2)
         (- ,n 1))
      4))