(ns pokemon.lpsolve
  (:import lpsolve.LpSolve)
  (:require pokemon.types)
  ;;(:require incanter.core)
  (:require rlm.map-utils))
(import 'lpsolve.LpSolve)
(in-ns 'pokemon.lpsolve)




(def -inf (Double/NEGATIVE_INFINITY))
(def -inf -1e4)

(def susceptibility-8

  [[0 0 0 0 0 -1 0 -inf -1 0 0 0 0 0 0 0 0 0]
   [1 0 -1 -1 0 1 -1 -inf 1 0 0 0 0 -1 1 0 1 -1]
   [0 1 0 0 0 -1 1 0 -1 0 0 1 -1 0 0 0 0 0]
   [0 0 0 -1 -1 -1 0 -1 -inf 0 0 1 0 0 0 0 0 1]
   [0 0 -inf 1 0 1 -1 0 1 1 0 -1 1 0 0 0 0 0]
   [0 -1 1 0 -1 0 1 0 -1 1 0 0 0 0 1 0 0 0]
   [0 -1 -1 -1 0 0 0 -1 -1 -1 0 1 0 1 0 0 1 -1]
   [-inf 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 -1 0]
   [0 0 0 0 0 1 0 0 -1 -1 -1 0 -1 0 1 0 0 1]
   [0 0 0 0 0 -1 1 0 1 -1 -1 1 0 0 1 -1 0 0]
   [0 0 0 0 1 1 0 0 0 1 -1 -1 0 0 0 -1 0 0]
   [0 0 -1 -1 1 1 -1 0 -1 -1 1 -1 0 0 0 -1 0 0]
   [0 0 1 0 -inf 0 0 0 0 0 1 -1 -1 0 0 -1 0 0]
   [0 1 0 1 0 0 0 0 -1 0 0 0 0 -1 0 0 -inf 0]
   [0 0 1 0 1 0 0 0 -1 -1 -1 1 0 0 -1 1 0 0]
   [0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 1 0 -inf]
   [0 -1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 -1 -1]
   [0 1 0 -1 0 0 0 0 -1 -1 0 0 0 0 0 1 1 0]])

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




;; deal with automatic memory management for LpSolve instance.
(declare linear-program)

;; functional interface to LpSolve
(declare lp-solve)

;; immutable output from lp-solve
(declare solve get-results)
(in-ns 'pokemon.lpsolve)
(defmacro linear-program
  "solve a linear programming problem using LpSolve syntax.
   within the macro, the variable =lps= is bound to the LpSolve instance."
  [& statements]
  (list 'let '[lps (LpSolve/makeLp 0 0)]
	(concat '(try)
		statements
		;; always free the =C= data structures.
		'((finally (.deleteLp lps))))))
(in-ns 'pokemon.lpsolve)

(defrecord LpSolution
  [objective-value
   optimal-values
   variable-names
   solution
   status
   model])

(defn model
  "Returns a textual representation of the problem suitable for
  direct input to the =lp_solve= program (lps format)"
  [#^LpSolve lps]
  (let [target (java.io.File/createTempFile "lps" ".lp")]
    (.writeLp lps (.getPath target))
    (slurp target)))

(defn results
  "Given an LpSolve object, solves the object and returns a map of the
  essential values which compose the solution."
  [#^LpSolve lps]
  (locking lps
    (let [status (solve lps)
	  number-of-variables (.getNcolumns lps)
	  optimal-values (double-array number-of-variables)
	  optimal-values (do (.getVariables lps optimal-values)
			     (seq optimal-values))
	  variable-names
	  (doall 
           ;; The doall is necessary since the lps object might
	   ;; soon be deleted.
	   (map
	    #(.getColName lps (inc %))
	    (range number-of-variables)))
	  model (model lps)]
      (LpSolution.
       (.getObjective lps)
       optimal-values
       variable-names
       (zipmap variable-names optimal-values)
       status
       model))))

(in-ns 'pokemon.lpsolve)

(defn static-integer?
  "does the field represent a static integer constant?"
  [#^java.lang.reflect.Field field]
  (and (java.lang.reflect.Modifier/isStatic (.getModifiers field))
       (integer? (.get field nil))))

(defn integer-constants [class]
  (filter static-integer? (.getFields class)))

(defn constant-map
  "Takes a class and creates a map of the static constant integer
  fields with their names.  This helps with C wrappers where they have
  just defined a bunch of integer constants instead of enums."
  [class]
     (let [integer-fields (integer-constants class)]
       (into (sorted-map)
	     (zipmap (map #(.get % nil) integer-fields)
		     (map #(.getName %) integer-fields)))))

(alter-var-root #'constant-map memoize)
	     
(defn solve
  "Solve an instance of LpSolve and return a string representing the
  status of the computation. Will only solve a particular LpSolve
  instance once."
  [#^LpSolve lps]
  ((constant-map LpSolve)
   (.solve lps)))

(in-ns 'pokemon.lpsolve)
(defn farmer-example []
  (linear-program
   (results
    (doto lps
      ;; name the columns
      (.setColName 1 "wheat")
      (.setColName 2 "barley")
      (.setAddRowmode true)
      ;; row 1 : 120x + 210y <= 15000
      (.addConstraintex 2
			(double-array [120 210])
			(int-array [1 2])
			LpSolve/LE
			15e3)
      ;; row 2 : 110x + 30y <= 4000
      (.addConstraintex 2
			(double-array [110 30])
			(int-array [1 2])
			LpSolve/LE
			4e3)
      ;; ;; row 3 : x + y <= 75
      (.addConstraintex 2
			(double-array [1 1])
			(int-array [1 2])
			LpSolve/LE
			75)
      (.setAddRowmode false)

      ;; add constraints
      (.setObjFnex 2
		   (double-array [143 60])
		   (int-array [1 2]))
            
      ;; set this as a maximization problem
      (.setMaxim)))))

(in-ns 'pokemon.lpsolve)
(defn initialize-lpsolve-row-oriented
  "fill in an lpsolve instance using a constraint matrix =A=, the
  objective function =c=, and the right-hand-side =b="
  [#^lpsolve.LpSolve lps A b c]
  ;; set the name of the last column to _something_
  ;; this appears to be necessary to ensure proper initialization.
  (.setColName lps (count c) (str "C" (count c)))

  ;; This is the recommended way to "fill-in" an lps instance from the 
  ;; documentation. First, set row mode, then set the objective
  ;; function, then set each row of the problem, and then turn off row
  ;; mode. 
  (.setAddRowmode lps true)
  (.setObjFnex lps (count c)
	       (double-array c)
	       (int-array (range 1 (inc (count c)))))
  (dorun
   (for [n (range (count A))]
     (let [row (nth A n)
	   row-length (int (count row))]
       (.addConstraintex lps
			 row-length
			 (double-array row)
			 (int-array (range 1 (inc row-length)))
			 LpSolve/LE
			 (double (nth b n))))))
  (.setAddRowmode lps false)
  lps)


(defmacro lp-solve
  "by default:,
   minimize (* c x), subject to (<= (* A x) b),
   using continuous variables.  You may set any number of
   other options as in the LpSolve API." 
  [A b c & lp-solve-forms]
  ;; assume that A is a vector of vectors
  (concat
   (list 'linear-program
	 (list 'initialize-lpsolve-row-oriented 'lps A b c))
   `~lp-solve-forms))
(in-ns 'pokemon.lpsolve)
(defn better-farmer-example []
  (lp-solve  [[120 210]
	      [110 30]
	      [1 1]]
	     [15000
	      4000
	      75]
	     [143 60]
	     (.setColName lps 1 "wheat")
	     (.setColName lps 2 "barley")
	     (.setMaxim lps)
	     (results lps)))
(in-ns 'pokemon.lpsolve)

(defn log-clamp-matrix [matrix]
  ;; we have to clamp the Infinities to a more reasonable negative
  ;; value because lp_solve does not play well with infinities in its
  ;; constraint matrix.
  (map (fn [row] (map #(if (= Double/NEGATIVE_INFINITY %) -1e3 %) 
                      (map #(/ (Math/log %) (Math/log 2)) row)))
	(apply mapv vector ;; transpose
               matrix))) 

;; constraint matrices
(defn log-defense-matrix []
  (log-clamp-matrix
   (doall (map (pokemon.types/defense-strengths)
	       (pokemon.types/type-names)))))




(defn log-attack-matrix []
  (apply mapv vector (log-defense-matrix)))

;; target vectors
(defn all-resistant []
  (doall (map (constantly -1) (pokemon.types/type-names))))

(defn all-weak []
  (doall (map (constantly 1) (pokemon.types/type-names))))

(defn all-neutral []
  (doall (map (constantly 0) (pokemon.types/type-names))))

;; objective functions
(defn number-of-types []
  (doall (map (constantly 1) (pokemon.types/type-names))))



;; DXH OVERWRITE
;; (defn log-defense-matrix []
;;   susceptibility-8)

;; (defn number-of-types []
;;   (doall (map (constantly 1) types-8)))

;; (defn all-resistant []
;;   (doall (map (constantly -1) types-8)))




(defn set-constraints
  "sets all the constraints for an lpsolve instance to the given
  constraint. =constraint= here is one of the LpSolve constants such
  as LpSolve/EQ."
  [#^LpSolve lps constraint]
  (dorun (map (fn [index] (.setConstrType lps index constraint))
	      ;; ONE based indexing!!!
	      (range 1 (inc (.getNrows lps))))))

(defn set-discrete
  "sets every variable in an lps problem to be a discrete rather than
  continuous variable"
  [#^LpSolve lps]
  (dorun (map (fn [index] (.setInt lps index true))
	      ;; ONE based indexing!!!
	      (range 1 (inc (.getNcolumns lps))))))

(defn set-variable-names
  "sets the variable names of the problem given a vector of names"
  [#^LpSolve lps names]
  (dorun
   (keep-indexed
    (fn [index name]
      (.setColName lps  (inc index) (str name)))
    ;; ONE based indexing!!!
    names)))

(defn poke-solve 
  ([poke-matrix target objective-function constraint min-num-types]
     ;; must have at least one type
     (let [poke-matrix
	   (concat poke-matrix
		   [(map (constantly 1)
			 (range (count (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-8) ;; DXH (pokemon.types/type-names)
		 (results lps))))
  ([poke-matrix target objective-function constraint]
     ;; at least one type
     (poke-solve poke-matrix target objective-function constraint 1)))

(defn solution 
  "If the results of an lpsolve operation are feasible, returns the
  results. Otherwise, returns the error."
  [results]
  (if (not (= (:status results) "OPTIMAL"))
    (:status results)
    (:solution results)))
(in-ns 'pokemon.lpsolve)

(defn best-defense-type
  "finds a type combination which is resistant to all attacks."
  []
  (poke-solve 
   (log-defense-matrix) (all-resistant) (number-of-types) LpSolve/LE))

(defn worst-attack-type
  "finds the attack type which is not-very-effective against all pure
  defending types (each single defending type is resistant to this
  attack combination"
  []
  (poke-solve
   (log-attack-matrix)  (all-resistant) (number-of-types) LpSolve/LE))

(defn worst-defense-type
  "finds a defending type that is weak to all single attacking types."
  []
  (poke-solve
   (log-defense-matrix) (all-weak) (number-of-types) LpSolve/GE))

(defn best-attack-type
  "finds an attack type which is super effective against all single
defending types"
  []
  (poke-solve
   (log-attack-matrix) (all-weak) (number-of-types) LpSolve/GE))

(defn solid-defense-type
  "finds a defense type which is either neutral or resistant to all
  single attacking types"
  []
  (poke-solve
   (log-defense-matrix) (all-neutral) (number-of-types) LpSolve/LE))

(defn solid-attack-type
  "finds an attack type which is either neutral or super-effective to
  all single attacking types."
  []
  (poke-solve
   (log-attack-matrix) (all-neutral) (number-of-types) LpSolve/GE))

(defn weak-defense-type
  "finds a defense type which is either neutral or weak to all single
  attacking types"
  []
  (poke-solve
   (log-defense-matrix) (all-neutral) (number-of-types) LpSolve/GE))

(defn neutral-defense-type
  "finds a defense type which is perfectly neutral to all attacking
  types."
  []
  (poke-solve
   (log-defense-matrix) (all-neutral) (number-of-types) LpSolve/EQ))

(in-ns 'pokemon.lpsolve)

(defmacro attack-mode [& forms]
  `(let [attack-strengths# pokemon.types/attack-strengths
	 defense-strengths# pokemon.types/defense-strengths]
     (binding [pokemon.types/attack-strengths
	       defense-strengths#
	       pokemon.types/defense-strengths
	       attack-strengths#]
       ~@forms)))