core.logic crops planification POC

playground.clj

(ns playground
  (:refer-clojure :exclude [==])
  (:use clojure.core.logic)
  (:require [java-time :as jt]
            [clojure.core.logic.fd :as fd]))

;; INITIAL DATA
(def nb-parcells 4)
(def days-to-plan 10)
(def crop-growth-days 3)
(def orders
  [{:parcells-count 2 :day 3}
   {:parcells-count 2 :day 5}
   {:parcells-count 1 :day 8}
   {:parcells-count 3 :day 9}])
(defn quantity-for-day [d]
  (-> (filter #(= (:day %) d) orders)
      first
      :parcells-count
      (or 0)))

(defn init-matrix []
  (into []
    (repeatedly
      nb-parcells
      #(into [] (repeatedly days-to-plan lvar)))))

; utility func to support multiple arguments in fd/+
(defn add* [vars qty]
  (and*
    (loop [[lvarh & lvars] (rest vars)
              constraints []
              last-sumvar (first vars)]
      (if (nil? lvarh)
        ; end of recursion, fix the sum to quantity and return the constraints
        (conj constraints (== last-sumvar qty))
        ; constrain a new sum var
        (let [sumvar (lvar)]
          (recur
            lvars
            (concat 
              constraints 
              [(fd/in sumvar (fd/interval 0 (inc qty))) ; assign the domain
               (fd/+ lvarh last-sumvar sumvar)]) ;fix the intermediary sum
            sumvar))))))

;; @param matrix is a parcells-orders matrix
;; @param day-i
;; @param quantity comes from the order requirement
;;        it should be specified at 0 if no order that day
;; 
;; we constrain the total sum of a column (the sum of parcells ready orders for 1 given day)
;; to equal the quantity given as argument
(defn total-parcells-for-day== [matrix day-i qty]
  (let [orders-ready (map #(nth % day-i) matrix)]
    (add* orders-ready qty)))

;; @param matrix-assignments the matrix of every assignments
;; @param matrix-orders the matrix of orders wanted
;; @param day (the matrix column) theoretically we could do it for all days
;;        but it's useless for the columns where we know there is no orders
;;
;; we need the two matrices because we're creating a relation constraint between both.
;; The story: "if I need an order on a parcell this day, the parcell needs to be assigned
;; for at least the crop growing period before"
(defn can-harvest-parcell-constraint [matrix-assignments matrix-orders day-i]
  (and*
    (for [parcell-i (range 0 nb-parcells)
          :let [assignments (nth matrix-assignments parcell-i)
                orders (nth matrix-orders parcell-i)
                parcell-day-assignment (nth assignments day-i)
                parcell-day-order (nth orders day-i)
                last? (= day-i (dec days-to-plan))]]
      (conde
        [(== parcell-day-order 0)]
        [(== parcell-day-order 1) 
         (== parcell-day-assignment 1) 
         (if last? succeed (== (nth assignments (inc day-i)) 0))
         (if (< day-i (dec crop-growth-days)) 
           fail
           (and* (map #(== % 1) (subvec assignments (- day-i (dec crop-growth-days)) day-i))))
         ]))))

; the actual solving      
(defn main []
  (let [parcells-assignments (init-matrix)
        parcells-orders (init-matrix)]
    (run 1 [assignments-planning orders-planning]
      ; every matrix el is either 0 or 1
      (and* (map (fn [var] (fd/in var (fd/domain 0 1))) (flatten parcells-assignments)))
      (and* (map (fn [var] (fd/in var (fd/domain 0 1))) (flatten parcells-orders)))
      ; bind assignments constraints every day we have an order
      (and*
        (for [{:keys [day]} orders]
          (can-harvest-parcell-constraint parcells-assignments parcells-orders day)))
      ; bind expected parcell order quantities for each day
      (and*
        (for [day-i (range 0 days-to-plan)
              :let [qty (quantity-for-day day-i)]]
          (total-parcells-for-day== parcells-orders day-i qty)))
      ; bind the return
      (== assignments-planning parcells-assignments)
      (== orders-planning parcells-orders)
      )))