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

(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 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)
                  (dec (get upper-bound monotype))]))
        ;;_ (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)))



(defn shrink-solution
  ([solution] (shrink-solution solution 5))
  ([solution max-iters]
     (if-not (pos? max-iters) solution
             (let [upper (zipmap types (map (comp inc #(get solution % 0))
                                            types))
                   _ (println
                      (map #(assoc upper % (get solution % 0)) types)) 
                   ]
               (if-let [better-solution
                        (first (keep (comp bounded-solve #(assoc upper % (get solution % 0))) types))]
                 better-solution
                 solution)))))

(def shrink-solution identity)
            


(defn conj<
  "Returns a new collection with the new elements added, enforcing
a nondomination constraint.
  That is, if (dominates? x y) for any y in the
collection, y will be removed. If (dominates? y x), x will not be
added."
  [dominates? coll x]
  (loop [queue coll, nondescendants [x]]
    (if-let [y (first queue)]
      (cond (dominates? x y)
            (recur (rest queue) nondescendants)

            (dominates? y x)
            coll ;; assuming the invariant holds for coll

            :default
            (recur (rest queue) (conj nondescendants y)))
      nondescendants)))

(defn stricter-bound? [upper-1 upper-2]
  (every?
   #(<= (get upper-1 % Float/POSITIVE_INFINITY)
        (get upper-2 % Float/POSITIVE_INFINITY))
   types))



(def inhabitant (memoize bounded-solve))

(defn search-irreducible-types []
  
  (loop [agenda [{:upper nil, :index 0}]
         irreducibles []]
    (if true ;;(> (count irreducibles) 10) irreducibles
    (when-let [state (peek agenda)]
      (if-let [solution (inhabitant (:upper state))]
        (if (< (:index state) (count irreducibles))
          (let [bounding-type (nth irreducibles (:index state))]
            ;; enforce a new constraint
            #_ (reduce conj
                    (pop agenda)
                    (for [t types] t))

            (recur
             (reduce conj
                  (pop agenda)
                  (for [t types
                        :when (get bounding-type t)]

                    (-> state
                        (update-in [:index] inc) 
                        (assoc-in [:upper t]
                                  (min (bounding-type t)
                                       (get-in state [:upper t]
                                               Float/POSITIVE_INFINITY))))))
             irreducibles))
          (let [solution* (shrink-solution solution)]
            (do (println (inc (count irreducibles)) solution*)
                (spit (java.io.File. "./irreducibles.txt")
                      (str solution* "\n") :append true)
                (recur agenda (conj irreducibles solution*)))))
        (recur (pop agenda) irreducibles))))))
                    


(defn search-irreducible-types-2
  "Generate a list of all maximally efficient type combinations that
resist each monotype."
  ;; use: search with sorted variable assignment designed to fail fast
  ;; use: extended set keyed to state {set of irreducibles accounted
  ;; for, upper bound set}.
  ;; use: cache of known "feasible?" for each upper bound (true,
  ;; false, nil)
  ;; use: it may be a lot of work, but it might be useful to do an
  ;; extra check to see whether a region you would test is strictly
  ;; contained in an infeasible region. csp involves doing a lot of
  ;; bookkeeping in order to avoid exponential blowup.

  ;; use: maybe a tree data structure for storing regions, so you can
  ;; efficiently look up whether your region is contained in another
  ;; using tree search instead of looking through a linear list.
  []
  (let [log-path "./irreducibles.txt"
        canonicalize (fn [irreducibles state] 
                       (assoc state
                         :open-indexes
                         (set (remove (:closed-indexes state)
                                      (range (count irreducibles))))))
        
        _ (spit (java.io.File. log-path)
                (str "MAXIMALLY ECONOMICAL ALL-RESISTANT POKEMON TYPE COMBINATIONS" "\n") :append false)
        ]
  (loop [agenda [{:upper {}, :closed-indexes #{}}]
         irreducibles []
         known-feasible-regions #{}
         known-infeasible-regions #{}
         extended-set #{}]

    ;;(println (peek agenda))
    (if true ;; (> (count irreducibles) 15) irreducibles
        (when-let [state (peek agenda)]
          (cond
           (extended-set (canonicalize irreducibles state))
           (recur (pop agenda) irreducibles
                  known-feasible-regions
                  known-infeasible-regions
                  extended-set)

           (known-infeasible-regions (:upper state))
           (recur (pop agenda) irreducibles
                  known-feasible-regions
                  known-infeasible-regions
                  extended-set)

           :default
           (if-let [solution (inhabitant (:upper state))]
             (let [open-indexes (-> (canonicalize irreducibles state) :open-indexes)
                   next-moves
                   (->>
                    (for [index open-indexes
                          bounding-type [(nth irreducibles index)]
                          t types
                          :when (pos? (get bounding-type t 0))
                          ]
                      {:upper {t (get bounding-type t)}
                       :type t
                       :bounding-amount (get bounding-type t)
                       :closed-indexes
                       (conj (get state :closed-indexes) index)})
                    
                    (sort-by (juxt
                              #(not (nil? (get (:upper state) (:type %))))
                              #(<= (get (:upper state) (:type %)
                                        Float/POSITIVE_INFINITY)
                                   (:bounding-amount %))
                              :bounding-amount))
                    (map #(dissoc % :type :bounding-amount))
                    (map #(update-in % [:upper] (partial merge-with min (:upper state)))))
                   ]
               (if (empty? open-indexes) ;; genuine solution!
                 (do (println :solution solution "\t" (count irreducibles))
                     (spit (java.io.File. log-path)
                           (str solution "\n") :append true)
                     
                     (recur agenda ;; re-insert this state with a new thing to check
                        (conj irreducibles solution)
                        (conj known-feasible-regions (:upper state))
                        known-infeasible-regions
                        (conj extended-set (canonicalize irreducibles state))))
               
                 (recur (vec (concat (reverse next-moves) (pop agenda)))
                        irreducibles
                        (conj known-feasible-regions (:upper state))
                        known-infeasible-regions
                        (conj extended-set (canonicalize irreducibles state)))))
               
             (recur (pop agenda) irreducibles
                    known-feasible-regions
                    (conj known-infeasible-regions (:upper state))
                    (conj extended-set (canonicalize irreducibles state))))))))))
                      



(defn generate-next-states
  "Given a partly assembled bound with at least one solution, divide
that bound into disjunctive tighter bounds that may contain a
  solution.

For example, if there are no further irreducibles to check, return the
state itself.
"
  [irreducibles state]
  (if-let [index (first (:open-indexes state))]
    (for [[monotype amount] (nth irreducibles index)]
      (-> state
          (dissoc :open-indexes)
          (assoc state :closed-indexes
                 (conj (get state :closed-indexes) index))
          
          

    
  
  )

(defn search-irreducible-types-4 []
 (let [log-path "./irreducibles.txt"
       canonicalize (fn [irreducibles state] 
                      (assoc state
                        :open-indexes
                        (set (remove (:closed-indexes state)
                                     (range (count irreducibles))))))
       _ (spit (java.io.File. log-path)
               (str "MAXIMALLY ECONOMICAL ALL-RESISTANT POKEMON TYPE
               COMBINATIONS" "\n") :append false)
       ]

   (loop [tally 0
          agenda [{:upper {}, :closed-indexes #{}}]
          irreducibles []
          extended-set #{}]

     (if (< tally 10)
       (when-let [state (peek agenda)]
         (cond (extended-set (canonicalize irreducibles state))
               (recur (inc tally)
                      (pop agenda)
                      irreducibles
                      extended-set)
               :default
               (if-let [solution (inhabitant (:upper state))]
                 (let [state* (canonicalize irreducibles state)
                       open-indexes (:open-indexes state*)
                       next-states
                       (generate-next-states irreducibles state*)
                       ]
                   [:opens open-indexes]
                   )
                   
                   
                 
                 :no-solution)))
                 
       :out-of-tally))))
 
   
  


(defn search-irreducible-types-3 []
 (let [log-path "./irreducibles.txt"
       canonicalize (fn [irreducibles state] 
                      (assoc state
                        :open-indexes
                        (set (remove (:closed-indexes state)
                                (range (count irreducibles))))))
       
       _ (spit (java.io.File. log-path)
               (str "MAXIMALLY ECONOMICAL ALL-RESISTANT POKEMON TYPE
               COMBINATIONS" "\n") :append false)

       dominated-already? (fn [chroma-infeasibles upper]
                            (first
                             (reduce
                              clojure.set/intersection
                              #{}
                              (for [[color upper] (sort-by val upper)]
                                (reduce
                                 clojure.set/union
                                 #{}
                                 (for [index (range 1 (inc upper))] 
                                   (get-in chroma-infeasibles [color index])))))))
       ]
   (loop [tally 0
          agenda [{:upper {}, :closed-indexes #{}}]
          irreducibles []
          known-infeasible-regions #{}
          chroma-infeasibles {}
          extended-set #{}
          ]
     (println tally (first agenda))
     #_ (println tally :agenda agenda "\n\n" (first agenda) :solve (inhabitant (:upper (first agenda)))  (count irreducibles))
     (if (< tally 100)
     (when-let [state (peek agenda)]
       (cond 
        (extended-set (canonicalize irreducibles state))
        (recur (inc tally) (pop agenda) irreducibles
               known-infeasible-regions
               chroma-infeasibles
               extended-set)

        (dominated-already? chroma-infeasibles (:upper state))
        (recur (inc tally) (pop agenda) irreducibles
               known-infeasible-regions
               chroma-infeasibles
               extended-set)

        
        ;; (known-infeasible-regions (:upper state))
        ;; (recur (pop agenda) irreducibles
        ;;        known-feasible-regions
        ;;        known-infeasible-regions
        ;;        extended-set)
        :default
        (if-let [solution (inhabitant (:upper state))]
          (let [open-indexes (-> (canonicalize irreducibles state) :open-indexes)
                next-moves
                (for [index open-indexes ;; no sorting here
                      bounding-type [(nth irreducibles index)]
                      t types
                      :when (pos? (get bounding-type t 0))
                      ]
                  (assoc state
                    :closed-indexes
                    (conj (get state :closed-indexes) index)
                    :upper
                    (merge-with min
                                (get state :upper)
                                {t (get bounding-type t)})))]
            
            (do
              (if (empty? open-indexes)
                          (println (inc (count irreducibles))
                                   solution))
              (recur (inc tally)
                     (into (if (empty? open-indexes)
                             agenda
                             (pop agenda))
                             (shuffle (distinct
                                            next-moves)))
                     (if (empty? open-indexes)
                       (conj irreducibles solution)
                       irreducibles)
                     known-infeasible-regions
                     chroma-infeasibles
                     (conj extended-set (canonicalize irreducibles state))
                     )))
          
          (recur (inc tally) (pop agenda) irreducibles
                 (conj known-infeasible-regions (:upper state))
                 (reduce (fn ([m [color amount]]
                                (assoc-in m [color amount] (:upper
state)))
                           ([m] m))
                         chroma-infeasibles)
                 (conj extended-set (canonicalize irreducibles state)))
                 
         )))))))



;;-------------------------------------------------
            (if (empty? open-indexes)
              (recur (inc count) agenda
                     (conj irreducibles solution)
                     known-infeasible-regions
                     chroma-infeasibles
                     (conj extended-set (canonicalize irreducibles
state)))
              (do (println next-moves)
                  (recur (inc count) (into (pop agenda)
                                           (distinct next-moves))
                         irreducibles
                         known-infeasible-regions
                         chroma-infeasibles
                     (conj extended-set (canonicalize irreducibles state))))                
                  ) 
                  
                
                   


        
        ;;(canonicalize irreducibles state)

        )))))


    )
  )))


           


(defn farmer-example-2 []
  (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)))))




(def answers (atom {}))
(defn bingo
  "Return the probability of pred if you have num-cards bingo
cards with num-squares grid cells apiece and you fill in num-draws
  squares without replacement."
  ([pred num-cards num-squares num-draws]
     (bingo pred num-cards num-squares num-draws (vec (repeat num-cards 0))))
  ([pred num-cards num-squares num-draws state]
     (println state)
     (if (@answers state)
       (@answers state)

       (let [draws-so-far (reduce + state)
             next-steps (for [index (range num-cards)
                              :when (< (get state index) num-squares)
                              ]
                          (-> state
                              (assoc  index (inc (get state index)))
                              sort vec))
             
             ]
         (do
           (if (>= draws-so-far num-draws)
             (swap! answers #(assoc % state (if (pred state) 1 0)))
             (swap! answers
                  #(assoc % state
                          (/ (reduce + (map (partial bingo pred num-cards num-squares
                                                     num-draws) next-steps))
                             (count next-steps)))))
           (@answers state))))))
                  

          
            
(defn pythonic
  "Convert a string representing a pythonic map into a clojure map"
  [str]
  (-> str
      (clojure.string/replace ":" "")
      (clojure.string/replace "' " " ")
      (clojure.string/replace "'" ":")
      read-string))


(defn choose [k coll]
  (comment println k coll)
  (cond (<= k 0) nil
        (> k (count coll)) nil
        (= 1 k) (map vector coll)
        :default
        (lazy-seq 
         (for [index (range (count coll))
               coll* (choose (dec k) (drop (inc index) coll))
               ]
           (cons (nth coll index) coll*)))))
          
  
(defn variety-combos [num-types]
  (remove nil?
          (doall 
          (for [allowed-types (map set (choose num-types types))]
            (let [upper (zipmap (remove allowed-types types)
                                (repeat 1))
                  _ (println upper)
                  solution (bounded-solve upper)
                 
                  ]

              (when solution
                [allowed-types solution]))))))



        


  
;;(bingo (partial every? pos?) 10 25)