(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:defconstant-eqx opt
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0))
    #'equal)
  #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t)))))
#+swank (set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader)

(macrolet ((def-int (b)
             `(progn (deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))
                     (deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))))
           (defs (&rest bits) `(progn ,@(mapcar (lambda (b) `(def-int ,b)) bits))))
  (defs 2 4 7 8 15 16 31 32 62 63 64))

(defconstant +mod+ 1000000007)

(defmacro dbg (&rest forms)
  #+swank (if (= (length forms) 1)
              `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
              `(format *error-output* "~A => ~A~%" ',forms `(,,@forms)))
  #-swank (declare (ignore forms)))

(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format* 'double-float))
    (prog1 (princ obj stream) (terpri stream))))

;; BEGIN_INSERTED_CONTENTS
(defpackage :cp/max-flow
  (:use :cl)
  (:export #:edge #:add-edge #:reinitialize-flow-network #:max-flow-overflow
           #:edge-to #:edge-capacity #:edge-default-capacity #:edge-reversed))
(in-package :cp/max-flow)

(define-condition max-flow-overflow (error)
  ((graph :initarg :graph :reader max-flow-overflow-graph))
  (:report
   (lambda (condition stream)
     (format stream "MOST-POSITIVE-FIXNUM or more units can flow on graph ~W."
             (max-flow-overflow-graph condition)))))

(defstruct (edge (:constructor %make-edge
                     (to capacity reversed
                      &aux (default-capacity capacity))))
  (to nil :type (integer 0 #.most-positive-fixnum))
  (capacity 0 :type (integer 0 #.most-positive-fixnum))
  (default-capacity 0 :type (integer 0 #.most-positive-fixnum))
  (reversed nil :type (or null edge)))

(defmethod print-object ((edge edge) stream)
  (let ((*print-circle* t))
    (call-next-method)))

(defun add-edge (graph from-idx to-idx capacity &key bidirectional)
  "FROM-IDX, TO-IDX := index of vertex
GRAPH := vector of lists of all the edges that goes from each vertex

If BIDIRECTIONAL is true, ADD-EDGE adds the reversed edge of the same
capacity in addition."
  (declare (optimize (speed 3))
           ((simple-array list (*)) graph))
  (let* ((dep (%make-edge to-idx capacity nil))
         (ret (%make-edge from-idx
                          (if bidirectional capacity 0)
                          dep)))
    (setf (edge-reversed dep) ret)
    (push dep (aref graph from-idx))
    (push ret (aref graph to-idx))))

(declaim (inline reinitialize-flow-network))
(defun reinitialize-flow-network (graph)
  "Sets the current CAPACITY of every edge in GRAPH to the default
capacity. That is, this function reinitialize the graph network to the state
prior to sending flow."
  (loop for edges across graph
        do (dolist (edge edges)
             (setf (edge-capacity edge) (edge-default-capacity edge)))))

;;;
;;; Minimum cost flow (SSP)
;;;

(defpackage :cp/min-cost-flow
  (:use :cl :cp/max-flow)
  (:export #:cedge #:cedge-p #:copy-cedge #:add-cedge #:+inf-cost+ #:cost-type
           #:cedge-reversed #:cedge-cost #:cedge-capacity #:cedge-to #:cedge-default-capacity
           #:not-enough-capacity-error #:not-enough-capacity-error-graph
           #:not-enough-capacity-error-flow #:not-enough-capacity-error-score))
(in-package :cp/min-cost-flow)

;; COST-TYPE and +INF-COST+ may be changed. (A supposed use case is to adopt
;; bignum).

(deftype cost-type () 'fixnum)
(defconstant +inf-cost+ most-positive-fixnum)
(assert (and (typep +inf-cost+ 'cost-type)
             (subtypep 'cost-type 'integer)))

(defstruct (cedge (:constructor %make-cedge)
                  (:include edge))
  (cost 0 :type cost-type))

(define-condition not-enough-capacity-error (error)
  ((graph :initarg :graph :reader not-enough-capacity-error-graph)
   (flow :initarg :flow :reader not-enough-capacity-error-flow)
   (score :initarg :score :reader not-enough-capacity-error-score))
  (:report
   (lambda (c s)
     (format s "Cannot send ~A units of flow on graph ~A due to not enough capacity."
             (not-enough-capacity-error-flow c)
             (not-enough-capacity-error-graph c)))))

(defmethod print-object ((cedge cedge) stream)
  (let ((*print-circle* t))
    (call-next-method)))

(defun add-cedge (graph from-idx to-idx cost capacity)
  "FROM-IDX, TO-IDX := index of vertex
GRAPH := vector of list of all the edges that goes from the vertex"
  (declare ((simple-array list (*)) graph)
           (cost-type cost))
  (let* ((dep (%make-cedge :to to-idx :capacity capacity :cost cost))
         (ret (%make-cedge :to from-idx :capacity 0 :cost (- cost) :reversed dep)))
    (setf (cedge-reversed dep) ret)
    (push dep (aref graph from-idx))
    (push ret (aref graph to-idx))))

(defpackage :cp/ssp
  (:use :cl :cp/min-cost-flow)
  (:export #:min-cost-flow!))
(in-package :cp/ssp)

;; binary heap for Dijkstra's algorithm
(defstruct (heap (:constructor make-heap
                     (size
                      &aux (costs (make-array (1+ size) :element-type 'cost-type))
                           (vertices (make-array (1+ size) :element-type 'fixnum))))
                 (:copier nil)
                 (:predicate nil))
  (costs nil :type (simple-array cost-type (*)))
  (vertices nil :type (simple-array fixnum (*)))
  (position 1 :type (integer 1 #.most-positive-fixnum)))

(defun heap-push (cost vertex heap)
  (declare (optimize (speed 3)))
  (symbol-macrolet ((position (heap-position heap)))
    (when (>= position (length (heap-costs heap)))
      (setf (heap-costs heap)
            (adjust-array (heap-costs heap) (* position 2))
            (heap-vertices heap)
            (adjust-array (heap-vertices heap) (* position 2))))
    (let ((costs (heap-costs heap))
          (vertices (heap-vertices heap)))
      (labels ((heapify (pos)
                 (declare (optimize (safety 0)))
                 (unless (= pos 1)
                   (let ((parent-pos (ash pos -1)))
                     (when (< (aref costs pos) (aref costs parent-pos))
                       (rotatef (aref costs pos) (aref costs parent-pos))
                       (rotatef (aref vertices pos) (aref vertices parent-pos))
                       (heapify parent-pos))))))
        (setf (aref costs position) cost
              (aref vertices position) vertex)
        (heapify position)
        (incf position)
        heap))))

(defun heap-pop (heap)
  (declare (optimize (speed 3)))
  (symbol-macrolet ((position (heap-position heap)))
    (let ((costs (heap-costs heap))
          (vertices (heap-vertices heap)))
      (labels ((heapify (pos)
                 (declare (optimize (safety 0))
                          ((integer 1 #.most-positive-fixnum) pos))
                 (let* ((child-pos1 (+ pos pos))
                        (child-pos2 (1+ child-pos1)))
                   (when (<= child-pos1 position)
                     (if (<= child-pos2 position)
                         (if (< (aref costs child-pos1) (aref costs child-pos2))
                             (unless (< (aref costs pos) (aref costs child-pos1))
                               (rotatef (aref costs pos) (aref costs child-pos1))
                               (rotatef (aref vertices pos) (aref vertices child-pos1))
                               (heapify child-pos1))
                             (unless (< (aref costs pos) (aref costs child-pos2))
                               (rotatef (aref costs pos) (aref costs child-pos2))
                               (rotatef (aref vertices pos) (aref vertices child-pos2))
                               (heapify child-pos2)))
                         (unless (< (aref costs pos) (aref costs child-pos1))
                           (rotatef (aref costs pos) (aref costs child-pos1))
                           (rotatef (aref vertices pos) (aref vertices child-pos1))))))))
        (multiple-value-prog1 (values (aref costs 1) (aref vertices 1))
          (decf position)
          (setf (aref costs 1) (aref costs position)
                (aref vertices 1) (aref vertices position))
          (heapify 1))))))

(declaim (inline heap-empty-p))
(defun heap-empty-p (heap)
  (= (heap-position heap) 1))

(declaim (inline heap-reinitialize))
(defun heap-reinitialize (heap)
  (setf (heap-position heap) 1)
  heap)

(defmacro the-cost-type (form)
  (reduce (lambda (x y) `(,(car form) (the cost-type ,x) (the cost-type ,y)))
          (cdr form)))

(defun min-cost-flow! (graph src-idx dest-idx flow &key edge-count (if-overflow :error) bellman-ford)
  "Returns the minimum cost to send FLOW units from SRC-IDX to DEST-IDX in
GRAPH. This function destructively modifies GRAPH.

EDGE-COUNT := initial reserved size for heap (it should be the number of edges)
IF-OVERFLOW := :error | nil

If BELLMAN-FORD is true, this function does Bellman-Ford before all. It should
be enabled for a graph that contains negative edges: Currently this function
returns a correct result for a graph that contains negative edges, even when
BELLMAN-FORD is disabled (only if no negative **cycles** are contained, of
course). In this case, however, the worst-case time complexity is
exponential.

As a special case, if an input network is for a weighted bipartite matching that
contains negative weights, this function works without Bellman-Ford."
  (declare (optimize (speed 3))
           ((integer 0 #.most-positive-fixnum) flow src-idx dest-idx)
           ((simple-array list (*)) graph))
  (let* ((size (length graph))
         (edge-count (or edge-count (* size 2)))
         (prev-vertices (make-array size :element-type 'fixnum :initial-element 0))
         (prev-edges (locally
                         (declare (sb-ext:muffle-conditions style-warning))
                       (make-array size :element-type 'cedge)))
         (potential (make-array size :element-type 'cost-type :initial-element 0))
         (dists (make-array size :element-type 'cost-type))
         (pqueue (make-heap edge-count))
         (res 0))
    (declare (fixnum edge-count)
             (cost-type res))
    (labels ((update-potential ()
               (when (= (aref dists dest-idx) +inf-cost+)
                 (if if-overflow
                     (error 'not-enough-capacity-error :flow flow :graph graph :score res)
                     (return-from min-cost-flow! res)))
               (dotimes (v size)
                 (setf (aref potential v)
                       (min +inf-cost+ (+ (aref potential v) (aref dists v)))))))
      (when bellman-ford
        (fill dists +inf-cost+)
        (setf (aref dists src-idx) 0)
        (dotimes (_ (- size 1))
          (dotimes (v size)
            (let ((dist (aref dists v)))
              (when (< dist +inf-cost+)
                (dolist (cedge (aref graph v))
                  (when (> (cedge-capacity cedge) 0)
                    (let ((to (cedge-to cedge)))
                      (setf (aref dists to)
                            (min (aref dists to) (+ dist (cedge-cost cedge)))))))))))
        (update-potential))
      (loop (when (<= flow 0)
              (return-from min-cost-flow! res))
            (fill dists +inf-cost+)
            (setf (aref dists src-idx) 0)
            (heap-reinitialize pqueue)
            (heap-push 0 src-idx pqueue)
            (loop until (heap-empty-p pqueue)
                  do (multiple-value-bind (cost v) (heap-pop pqueue)
                       (declare (cost-type cost)
                                (fixnum v))
                       (when (<= cost (aref dists v))
                         (dolist (edge (aref graph v))
                           (let* ((next-v (cedge-to edge))
                                  (next-cost (the-cost-type
                                              (+ (aref dists v)
                                                 (cedge-cost edge)
                                                 (aref potential v)
                                                 (- (aref potential next-v))))))
                             (when (and (> (cedge-capacity edge) 0)
                                        (> (aref dists next-v) next-cost))
                               (setf (aref dists next-v) next-cost
                                     (aref prev-vertices next-v) v
                                     (aref prev-edges next-v) edge)
                               (heap-push next-cost next-v pqueue)))))))
            (update-potential)
            (let ((max-flow flow))
              (declare ((integer 0 #.most-positive-fixnum) max-flow))
              (do ((v dest-idx (aref prev-vertices v)))
                  ((= v src-idx))
                (setq max-flow (min max-flow (cedge-capacity (aref prev-edges v)))))
              (decf flow max-flow)
              (incf res (the cost-type (* max-flow (aref potential dest-idx))))
              (do ((v dest-idx (aref prev-vertices v)))
                  ((= v src-idx))
                (decf (cedge-capacity (aref prev-edges v)) max-flow)
                (incf (cedge-capacity (cedge-reversed (aref prev-edges v))) max-flow)))))
    (error "Reached unreachable line")))

;; BEGIN_USE_PACKAGE
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/ssp :cl-user))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package :cp/min-cost-flow :cl-user))
(in-package :cl-user)

;;;
;;; Body
;;;

(defun main ()
  (let* ((n (read))
         (m (read))
         (graph (make-array (+ 2 (* n m)) :element-type 'list :initial-element nil))
         (plan (make-array (list n m) :element-type 'base-char :initial-element #\.))
         (src (* n m))
         (dest (+ 1 (* n m))))
    (dotimes(i n)
      (let ((line (read-line)))
        (dotimes (j m)
          (setf (aref plan i j) (aref line j)))))
    (labels ((encode (i j) (+ j (* i m)))
             (add (i1 j1 i2 j2)
               (when (and (<= 0 i1 (- n 1))
                          (<= 0 j1 (- m 1))
                          (<= 0 i2 (- n 1))
                          (<= 0 j2 (- m 1))
                          (char/= #\# (aref plan i1 j1))
                          (char/= #\# (aref plan i2 j2)))
                 (let ((p1 (encode i1 j1))
                       (p2 (encode i2 j2)))
                   (add-cedge graph p1 p2 -1 100)
                   ;; (add-cedge graph p2 p1 1 100)
                   ;; (add-cedge graph src p2 0 100)
                   ;; (add-cedge graph p1 dest 0 100)
                   )))
             (add-s (i j)
               (when (and (<= 0 i (- n 1))
                          (<= 0 j (- m 1))
                          (char= #\o (aref plan i j)))
                 (add-cedge graph src (encode i j) 0 1)))
             (add-t (i j)
               (when (and (<= 0 i (- n 1))
                          (<= 0 j (- m 1))
                          (char/= #\# (aref plan i j)))
                 (add-cedge graph (encode i j) dest 0 1))))
      (dotimes (i n)
        (dotimes (j m)
          (add-s i j)
          (add-t i j)
          (add i j (+ i 1) j)
          (add i j i (+ j 1))))
      (let ((res (min-cost-flow! graph src dest
                                 (count #\o (array-storage-vector plan))
                                 :bellman-ford t)))
        (println (abs res))))))

#-swank (main)

;;;
;;; Test and benchmark
;;;

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    #+os-windows (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)
    #+os-unix (run-program "xsel" '("-b" "-o") :output out :search t)))

#+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname))
#+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*))

#+swank
(defun run (&optional thing (out *standard-output*))
  "THING := null | string | symbol | pathname

null: run #'MAIN using the text on clipboard as input.
string: run #'MAIN using the string as input.
symbol: alias of FIVEAM:RUN!.
pathname: run #'MAIN using the text file as input."
  (let* ((*standard-output* (or out (make-string-output-stream)))
         (res (etypecase thing
                (null
                 (with-input-from-string (*standard-input* (delete #\Return (get-clipbrd)))
                   (main)))
                (string
                 (with-input-from-string (*standard-input* (delete #\Return thing))
                   (main)))
                (symbol (5am:run! thing))
                (pathname
                 (with-open-file (*standard-input* thing)
                   (main))))))
    (if out res (get-output-stream-string *standard-output*))))

#+swank
(defun gen-dat ()
  (uiop:with-output-file (out *dat-pathname* :if-exists :supersede)
    (format out "")))

#+swank
(defun bench (&optional (out (make-broadcast-stream)))
  (time (run *dat-pathname* out)))

#-swank
(eval-when (:compile-toplevel)
  (when (and (boundp 'sb-c::*compiler-warning-count*)
             (> sb-c::*compiler-warning-count* 0))
    (sb-ext:quit :unix-status 1)))

;; To run: (5am:run! :sample)
#+swank
(it.bese.fiveam:test :sample
  (5am:is
   (equal "4
"
          (run "3 3
o..
...
o.#
" nil)))
  (5am:is
   (equal "24
"
          (run "9 10
.#....o#..
.#..#..##o
.....#o.##
.###.#o..o
#.#...##.#
..#..#.###
#o.....#..
....###..o
o.......o#
" nil))))


Measured memory_bytes: 27820