Permalink
Browse files

Naive implementation of penlty function for tabu optimization

  • Loading branch information...
1 parent 3c90318 commit 5029bb442ca54de037fe5dea3ec546e9645c8e48 @tsu tsu committed Mar 5, 2011
Showing with 51 additions and 10 deletions.
  1. +5 −3 src/lol/algorithm.clj
  2. +20 −6 src/lol/tabu.clj
  3. +8 −1 src/lol/util.clj
  4. +18 −0 test/lol/tabu_test.clj
View
@@ -1,12 +1,14 @@
-(ns lol.algorithm (:use [clojure.contrib.math]))
+(ns lol.algorithm
+ (:use [clojure.contrib.math]
+ [lol.util]))
(defn dimensions-of-item
[item]
(:weight item))
(defn substract-from-limits
[item limits]
- (map (fn [pair] (- (first pair) (last pair))) (map list limits (dimensions-of-item item))))
+ (substract-from-dimensions (dimensions-of-item item) limits))
(defn fill-knapsack
([items limits] (fill-knapsack items limits []))
@@ -15,7 +17,7 @@
knapsack
(let [item (first items)
new-limits (substract-from-limits item limits)]
- (if (some (fn [x] (< x 0)) new-limits)
+ (if (negative-dimensions? new-limits)
(recur (rest items) limits knapsack)
(recur (rest items) new-limits (cons item knapsack)))))))
View
@@ -21,10 +21,24 @@
[mapsack]
(knapsack-value (vals mapsack)))
+(defn mapsack-weight
+ [mapsack]
+ (summed-weight (vals mapsack)))
+
(defn objective
- [mapsack move]
- (let [new-mapsack (move mapsack)]
- (if (> (mapsack-value new-mapsack)
- (mapsack-value mapsack))
- 1
- 0)))
+ [mapsack move]
+ (let [new-mapsack (move mapsack)]
+ (if (> (mapsack-value new-mapsack)
+ (mapsack-value mapsack))
+ 1
+ 0)))
+
+(defn penalty
+ [mapsack limits move]
+ (let [new-mapsack (move mapsack)
+ weight (mapsack-weight new-mapsack)
+ new-weight (substract-from-dimensions weight limits)]
+ (if (negative-dimensions? new-weight)
+ 1
+ 0)))
+
View
@@ -1,11 +1,18 @@
(ns lol.util
- (:use [lol.algorithm])
(:require [org.danlarkin.json :as json]))
(defn weight-of-item
[item]
(:weight item))
+(defn negative-dimensions?
+ [dimensions]
+ (some (fn [x] (< x 0)) dimensions))
+
+(defn substract-from-dimensions
+ [dimensions from]
+ (map (fn [pair] (- (first pair) (last pair))) (map list from dimensions)))
+
(defn summed-weight
[items]
(map
View
@@ -42,4 +42,22 @@
(is (= (objective mapsack (item-on-for item5))
1))
(is (= (objective mapsack (item-off-for item5))
+ 0))))
+
+(deftest test-mapsack-weight
+ (let [mapsack1 {"1" {:id "1" :weight [1 1]} "2" {:weight [2 2]} "3" {:weight [3 3]} "4" {:weight [4 4]}}
+ mapsack2 {"1" {:id "1" :weight [1 1]} "2" {:weight [2 2]} "3" {:weight [3 3]}}]
+ (is (= (mapsack-weight mapsack1)
+ [10 10]))
+ (is (= (mapsack-weight mapsack2)
+ [6 6]))))
+
+(deftest test-penalty
+ (let [item1 {:id "1" :weight [1 1]}
+ item5 {:id "5" :weight [5 5]}
+ limits [12 12]
+ mapsack {(:id item1) item1 "2" {:weight [2 2]} "3" {:weight [3 3]} "4" {:weight [4 4]}}]
+ (is (= (penalty mapsack limits (item-on-for item5))
+ 1))
+ (is (= (penalty mapsack limits (item-off-for item1))
0))))

0 comments on commit 5029bb4

Please sign in to comment.