(ns pokemon.approximate
  (:use pokemon.lpsolve))
;; swank-all
(import 'lpsolve.LpSolve)

(def log-path "./approximations.txt")

(def types
  [:normal :fire :water :electric :grass :ice :fighting :poison
  :ground :flying :psychic :bug :rock :ghost :dragon :dark :steel :fairy])

(def effectiveness-gen-6
  [[1,1,1,1,1,1,1,1,1,1,1,1,1/2,0,1,1,1/2,1],
   [1,1/2,1/2,1,2,2,1,1,1,1,1,2,1/2,1,1/2,1,2,1],
   [1,2,1/2,1,1/2,1,1,1,2,1,1,1,2,1,1/2,1,1,1],
   [1,1,2,1/2,1/2,1,1,1,0,2,1,1,1,1,1/2,1,1,1],
   [1,1/2,2,1,1/2,1,1,1/2,2,1/2,1,1/2,2,1,1/2,1,1/2,1],
   [1,1/2,1/2,1,2,1/2,1,1,2,2,1,1,1,1,2,1,1/2,1],
   [2,1,1,1,1,2,1,1/2,1,1/2,1/2,1/2,2,0,1,2,2,1/2],
   [1,1,1,1,2,1,1,1/2,1/2,1,1,1,1/2,1/2,1,1,0,2],
   [1,2,1,2,1/2,1,1,2,1,0,1,1/2,2,1,1,1,2,1],
   [1,1,1,1/2,2,1,2,1,1,1,1,2,1/2,1,1,1,1/2,1],
   [1,1,1,1,1,1,2,2,1,1,1/2,1,1,1,1,0,1/2,1],
   [1,1/2,1,1,2,1,1/2,1/2,1,1/2,2,1,1,1/2,1,2,1/2,1/2],
   [1,2,1,1,1,2,1/2,1,1/2,2,1,2,1,1,1,1,1/2,1],
   [0,1,1,1,1,1,1,1,1,1,2,1,1,2,1,1/2,1.000,1],
   [1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1/2,0],
   [1,1,1,1,1,1,1/2,1,1,1,2,1,1,2,1,1/2,1.000,1/2],
   [1,1/2,1/2,1/2,1,2,1,1,1,1,1,1,2,1,1,1,1/2,2],
   [1,1/2,1,1,1,1,2,1/2,1,1,1,1,1,1,2,2,1/2,1]])




(def low -999)
(def susceptibility-chart
  (vec (for [row effectiveness-gen-6]
         (for [x row]
           (try
             (int (/ (Math/log x) (Math/log 2)))
               (catch Exception e low))))))


(defn effect [combo]
  (->>
   (for [row susceptibility-chart]
     (reduce + (map * row (for [t types] (get combo t 0)))))
   (zipmap types)
   (remove (comp zero? val))
   (into {})))
  
  ;; (map #(reduce + (map * %  (for [t types] (get combo t 0))))
  ;;      susceptibility-chart)

(defn poke-solve* ;; adapted from pokemon.lpsolve but uses these types 
  ([poke-matrix target objective-function constraint min-num-types]
     ;; must have at least one type
     (let [poke-matrix
	   (concat poke-matrix
		   [(map (constantly 1)
			 (first poke-matrix))])
	   target (concat target [min-num-types])]
       (lp-solve poke-matrix target objective-function
		 (set-constraints lps constraint)
		 ;; must have more than min-num-types
		 (.setConstrType lps (count target) LpSolve/GE)
		 (set-discrete lps)
		 (set-variable-names lps types) ;; dxh again 
		 (results lps))))
  ([poke-matrix target objective-function constraint]
     ;; at least one type
     (poke-solve poke-matrix target objective-function constraint 1)))


(defn vec->type [coll]
  (let [combo
        (into {}
              (for [[type amount] (zipmap types coll) :when (pos? amount)]
                [type amount]))]
    (if (some neg? coll)
      (assoc combo :NEGATIVE true)
      combo)))
    

  
(defn pretty-solution [#^pokemon.lpsolve.LpSolution results]
  (if (not= (:status results) "OPTIMAL")
    nil ;;(:status results)
    (let [m (:solution results)]
      (into {}
            (for [[k v] m
                  :when (not (zero? v))]
              [(keyword (apply str (rest k))) (int v)])))))

(defn bounded-solve
  [upper-bound]
  (let [boundaries
        (into {}
              (for [[monotype index] (zipmap types (range))
                    :when (get upper-bound monotype)]
                [ (assoc (vec (repeat (count types) 0)) index 1)
                  (identity (get upper-bound monotype))])) ;;; inclusive "<=" constraint
        ;;_ (println [:bound upper-bound])
        ;; _ (println boundaries)
        ]

  
  ;; Solve maximize cT * x subject to A*x <= b
  (-> (poke-solve* (concat susceptibility-chart (keys boundaries))        ;; A
                   (concat (map (constantly -1) types) (vals boundaries)) ;; b
                   (map (constantly 1) types) ;; c
                  LpSolve/LE
                  1
                  )
      pretty-solution)))



;; DISTANCES AND POINT COMBINATIONS

(defn dominates? [p q]
  (and (every? true? (map <= p q))
       (some true? (map < p q))))

(defn distance-point-point [p q]
  (reduce max 0 (map - q p)))

(defn distance-point-set [p coll]
  (->> coll
       (map (partial distance-point-point p))
       (reduce min)
       (max 0)))

(defn distance-set-set [coll-1 coll-2]
  (reduce max
          (map #(distance-point-set % coll-2) coll-1)))

(defn uniform-offset
  "Add constant offset to each of the coordinates in point."
  [point offset]
  (mapv (partial + offset) point))



(def sqcup (partial map max))
(def sqcap (partial map min))


;;;; KNEE TREES

(defrecord KneeTree [support point distance
                     extension-bound
                     relevance-bound
                     indexed-children])

(defn extension-merge [support]
  (->> support
       (map-indexed (fn [i point]
                      (assoc point i (Float/POSITIVE_INFINITY))))
       (apply map min)
       (vec)))
  

(defn tree [feasibles support]
  (let [point (apply mapv min support)
        distance (distance-point-set point feasibles)]
    (KneeTree. (vec support) (vec point) distance
               (extension-merge support) ;; extension-bound (h)
               (uniform-offset point distance) ;; relevance-bound (b)
               {} ;; indexed-children index -> tree
               )))
    
(def leaf? (comp empty? :indexed-children))

(defn furthest-leaf
  "Traverse the tree of infeasibles to find the leaf whose distance
from the feasible set is maximal."
  [tree]
  (if-not (leaf? tree)
    (apply max-key :distance 
           (map furthest-leaf (vals (:indexed-children tree))))
    tree))

(defn pretty-tree
  ([node] (pretty-tree 0 node))
  ([indent node]
     (let [padding (clojure.string/join (repeat indent "\t"))]
      (str
       padding
       :tree
       (:point node)
       ;;\newline
      ;; padding
       ;;:Hbound (:extension-bound node)
       \newline
       (clojure.string/join
        (doall (map str (repeat padding) 
                    (:support node)
                    (repeat \newline)
                    )))
       \newline
       (clojure.string/join
       (doall (map (partial pretty-tree (inc indent)) (vals (:indexed-children node)))))))))

(defn pretty-tree-short
  ([node] (str \newline (pretty-tree-short 0 node)))
  ([indent node]
     (let [padding(clojure.string/join (repeat indent "--"))]
       (str padding :Node \newline
            (clojure.string/join (doall (map (partial
  pretty-tree-short (inc indent)) (vals (:indexed-children node)))))))))



;;;;;;; PROPAGATION SUBROUTINES
(defn dissoc-nilvals [m]
  (into {} (remove (comp nil? val) m)))

(defn propagate
  "Apply leaf-fn to each leaf in the node, then recursively update the
values of the node based on the values at the leaves."
  [relevant? leaf-fn node]
  (cond
   (not (relevant? node)) node
   (leaf? node) (leaf-fn node)
   :default
   (let [updated-node
         (loop [node node,
                indexes (keys (:indexed-children node))]
           (if-let [index (first indexes)]
             (let [child*
                   (propagate relevant? leaf-fn
                              (get-in node [:indexed-children index]))
                   node*
                   (if-not (empty? child*)
                     (assoc-in node [:indexed-children index]
                               child*)
                     (update-in node [:indexed-children] #(dissoc % index)))

                   ;;_ (println (vals (:indexed-children node*)) indexes)

                   ]
                (recur node* (rest indexes)))
             node))
         
         children (vals (:indexed-children updated-node))]

     (if-not (empty? children)
       (-> updated-node
           ;;(assoc :indexed-children :stuff)
           (assoc :distance (apply max (map :distance children)))
          ;;; TODO!!!!! SQCUP OR SQCAP of relevance bound???
           (assoc :relevance-bound
             (apply sqcup (map :relevance-bound children))))
       ;; the :extension-bound never changes; it is derived from the
       ;; support.
       )

         )))

(defn propagate-success [node test-point]
  (propagate
   (fn relevant? [node] (dominates? test-point (:relevance-bound node)))
   (fn [leaf]
     (update-in
      leaf [:distance]
      (partial min
               (distance-point-point (:point leaf)
                                     test-point))))
   node
   )) 


(defn propagate-failure [feasibles node test-point]
  (propagate
   (fn relevant? [node] (dominates? (:point node) test-point))
   (fn [leaf]
     (comment println "fail-prop leaf" test-point (:extension-bound leaf) (:point leaf))
     (let [dimension (count test-point)
           indexed-children
           (into {}
                 (for [index (range dimension)
                       :when (< (get test-point index)
                                (get (:extension-bound leaf) index))]
;;
                   
                   [index (tree feasibles
                                (assoc (:support leaf) index
                                       test-point))]))

           
           _ (doall (map println
                         (for [[_ node] indexed-children]
                           [(:distance node) (vec->type (:point node))])))

           _ (spit (java.io.File. log-path)
                   (str
                    (clojure.string/join "\n"
                                         (for [[_ node]
indexed-children]
                                           (str (:distance node)
                                                \tab
                                                (vec->type (:point node)))))

                    "\n") :append true)
           
           ]
       (when-not (empty? indexed-children)
         (assoc leaf :indexed-children indexed-children))
        ))
   node))


(defn map-tree [fn-merge fn-leaf node]
  (if (leaf? node) (fn-leaf node)
      (apply fn-merge
             (map (partial map-tree fn-merge fn-leaf)
                  (vals (:indexed-children node))))))

(def get-leaves (partial map-tree concat (comp list :point)))


;;; THE ALGORITHM

(defn approximate-pareto-frontier [satisfiable?]
  (let [
        _ (spit (java.io.File. log-path)
                (str "APPROXIMATE ALL-RESISTANT POKEMON TYPE COMBINATIONS" "\n") :append false)
        
        high 15, low -1, 
        dimension (count types)
        point-ceiling (vec (repeat dimension high))
        initial-support
        (for [i (range dimension)]
          (assoc (vec (repeat dimension high)) i low))

        initial-feasibles [
                           point-ceiling
                           [0 0 2 0 0 0 0 2 1 1 0 0 0 0 0 1 1 0]
                           ]
        ]
    (loop [tally 0
           feasibles initial-feasibles
           infeasible-tree (tree initial-feasibles initial-support)]
      (when (> (:distance infeasible-tree) 1/2)
        (let [_ (println :tally tally (:distance infeasible-tree) )
              
              infeasible (furthest-leaf infeasible-tree)
           
              test-point (uniform-offset
                          (:point infeasible)
                          (/ (:distance infeasible) 2))

              _ (comment println)
             ;;_  (println (pretty-tree infeasible-tree))
              _ (comment println :selected-knee
                         (:point infeasible)
                         :+
                         (:distance infeasible)
                         :=
                         (:relevance-bound infeasible) :=>
                         :test-point test-point
                         (satisfiable? test-point)
                         )
              ;; result (satisfiable? test-point)
              ]
          (println tally (not (nil? (satisfiable? test-point)))
                   test-point
                   )
          
         

          (if (satisfiable? test-point)
            (recur (inc tally)
                   (conj feasibles test-point)
                   (propagate-success infeasible-tree test-point))

            
            (recur (inc tally)
                   feasibles
                   (propagate-failure feasibles infeasible-tree test-point))))))))
            


(defn contains-resistant-type?
  [point]
  (bounded-solve (zipmap types point)))
  
;; (approximate-pareto-frontier true?)