core.logic - resource allocation - try 4

bench.clj

(ns server-cons.bench
  (:require [server-cons.core :refer [allocate-machines allocate-machines*]]))

(def machines [{:id 1 :cpu-avg 22}
               {:id 2 :cpu-avg 17}
               {:id 3 :cpu-avg 6}
               {:id 4 :cpu-avg 17}
               {:id 5 :cpu-avg 6}
               {:id 6 :cpu-avg 17}
               {:id 7 :cpu-avg 6}
               {:id 8 :cpu-avg 17}
               {:id 9 :cpu-avg 6}
               {:id 10 :cpu-avg 17}
               {:id 11 :cpu-avg 6}
               {:id 12 :cpu-avg 17}
               {:id 13 :cpu-avg 6}
               {:id 14 :cpu-avg 6}
               {:id 15 :cpu-avg 17}
               {:id 16 :cpu-avg 6}
               {:id 17 :cpu-avg 17}
               {:id 18 :cpu-avg 6}
               {:id 19 :cpu-avg 17}
               {:id 20 :cpu-avg 6}
               {:id 21 :cpu-avg 11}
               {:id 22 :cpu-avg 7}])

(declare best-solution)

(defn bench-lazy-solutions
  [solutions-fn]
  (time
    (let [solutions (solutions-fn)]
      (do
        (time (println "solutions: " (count solutions)))
        (println "first: ")
        (println (first solutions))
        (println "best: ")
        (time (println (best-solution 60 solutions)))))))

(defn bench-comb
  [n]
  (println "benchmark partition " n " machines")
  (let [machines (take n machines)
        partitions #(comb/allocate-by-partitions 60 machines)]
    (bench-lazy-solutions partitions)))

(defn bench-logic
  [n]
  (println "benchmark logic solutions " n " machines")
  (let [machines (take n machines)
        partitions #(allocate-machines* machines 60)]
    (bench-lazy-solutions partitions)))

(defn score
  "Calculates a solution score. The lower the better"
  [max-cpu solution]
  (count solution))

(defn best-solution
  [max-cpu solutions]
  (->> solutions
       (map (juxt identity (partial score max-cpu)))
       (reduce #(if (> (second %1) (second %2)) %2 %1))
       first))

(comment

  (bench-logic 4)

  (bench-logic 8)
  ;; solutions: 3500
  ;; time: 24.7s

  (bench-comb 8)
  ;; solutions: 3500
  ;; time: 114ms

  (bench-comb 9)
  ;; solutions: 17952
  ;; time: 594ms

  (bench-comb 10)
  ;; solutions: 91662
  ;; time: 4141ms

  (bench-comb 11)
  ;; solutions: 538928
  ;; time: 29s

  (let [machines (take 1 machines)]
    (allocate-machines machines 60))

  (let [machines (take 2 machines)]
    (allocate-machines machines 60))

  (let [machines (take 6 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 8 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 9 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 10 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 11 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 12 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 13 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 14 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 15 machines)]
    (time (allocate-machines machines)))

  (let [machines (take 18 machines)]
    (time (allocate-machines machines))))

combinatorics.clj

(ns server-cons.combinatorics
  (:require [clojure.math.combinatorics :as combo]))

(defn enoughcpu
  [max-cpu [machine & more]]
  (if machine
    (let [cpu (:cpu-avg machine)]
      (and
        (<= cpu max-cpu)
        (enoughcpu (- max-cpu cpu) more)))
    true))

(defn all-groups-enough-cpu?
  [max-cpu groups]
  (every? (partial enoughcpu max-cpu) groups)
  )

(defn allocate-by-partitions
  [max-cpu machines]
  (->> machines
       (combo/partitions)
       (filter (partial all-groups-enough-cpu? max-cpu))))

core.clj

(ns server-cons.core
  (:refer-clojure :exclude [==])
  (:use [clojure.core.logic])
  (:require [clojure.core.logic.fd :as fd]) )

(defn getcpuo
  [all-machines id cpu]
  (fresh [machine]
         (membero machine all-machines)
         (featurec machine {:id id :cpu-avg cpu})))

;; alternative 4
;;
(defn enoughcpuo
  [all-machines id max-cpu remaining-cpu]
  (fresh [cpu]
         (getcpuo all-machines id cpu)
         (fd/- max-cpu cpu remaining-cpu)
         (fd/>= remaining-cpu 0)))

(defn machinesgroupo
  ([all-machines machine-ids final-rest-ids min-id max-cpu group]
   (conda
     ;; no machines -> finish here
     [(emptyo machine-ids) (== machine-ids final-rest-ids) (emptyo group)]
     ;; no more cpu -> finish here
     [(== 0 max-cpu) (== machine-ids final-rest-ids) (emptyo group)]

     [(conde
        ;; branch 1: close group here
        [(== machine-ids final-rest-ids) (emptyo group)]

        ;; branch 2: try to add a machine to the group
        [(fresh [id rest-group rest-ids remaining-cpu]
                (rembero id machine-ids rest-ids)
                (fd/> id min-id)

                (enoughcpuo all-machines id max-cpu remaining-cpu)

                (conso id rest-group group)

                (machinesgroupo all-machines rest-ids final-rest-ids id remaining-cpu rest-group))])])))

(defn make-groups4
  ([all-machines machine-ids max-cpu groups]
   (make-groups4 all-machines 0 machine-ids max-cpu groups))

  ([all-machines min-id machine-ids max-cpu groups]
   (conda
     [(emptyo machine-ids) (emptyo groups)]
     [(fresh [group first-id rest-groups rest-ids]

             (machinesgroupo all-machines machine-ids rest-ids min-id max-cpu group)

             (!= group [])
             (conso group rest-groups groups)
             (firsto group first-id)
             (make-groups4 all-machines first-id rest-ids max-cpu rest-groups)
             )])))

(defn ids-partition->machines-partition
  [all-machines ids-partition]
  (let [machines-index (->> all-machines
                          (map (juxt :id identity))
                          (into {}))]
    (map (partial map machines-index) ids-partition)))

(defn allocate-machines*
  ([machines max-cpu]
   (when (some #(> (:cpu-avg %) max-cpu) machines)
     (throw (Exception. "Some machines exceed max-cpu, no allocation possible")))

   (->>
     (run* [q]
          (make-groups4 machines (map :id machines) max-cpu q))
     (map (partial ids-partition->machines-partition machines)))))

(defn allocate-machines
  ([machines]
   (allocate-machines machines 60))
  ([machines max-cpu]
   (first (allocate-machines* machines max-cpu))))