From 73c62b0a8f936822c63fba6317f24db91b5d2daa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?David=20P=C3=A4tzel?= <david.paetzel@posteo.de>
Date: Fri, 18 Oct 2019 13:47:03 +0200
Subject: [PATCH] Add better default priorities and fitness

By not having too large default priorities, the GA seems to be more stable.
Instead of inverting the relation induced by fitness using `(1 /)`, we use
`negate` to get more numerical stability (or in this case, less instability
introduced by floating point precision problems).
---
 src/Seminar.hs | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

diff --git a/src/Seminar.hs b/src/Seminar.hs
index 1233237..aab70d6 100644
--- a/src/Seminar.hs
+++ b/src/Seminar.hs
@@ -84,13 +84,17 @@ topics p = topics' ++ padding
     topics' = nub . join $ fmap fst . snd <$> p
 
 {-|
-The priority of topics that have not been assigned a priority is the sum of all
-priorities given by all the students. The priority of 'NoTopic' is one more than
-that value.
+The sum of all priorities given by all students.
+-}
+sumOfAll p = (1 +) . sum $ (sum . fmap snd) . snd <$> p
+
+{-|
+The priority of 'NoTopic' is 101. The priority of topics that have not been
+assigned a priority by a student is one less than this value.
 -}
 prioOf :: Priorities -> Student -> T -> Int
-prioOf p _ NoT = (1 +) . sum $ (sum . fmap snd) . snd <$> p
-prioOf p s t = maybe (prioOf p s NoT) identity $ lookup s p >>= lookup t
+prioOf _ _ NoT = 101
+prioOf p s t = maybe (prioOf p s NoT - 1) identity $ lookup s p >>= lookup t
 
 type Assignment = [(Student, T)]
 
@@ -110,10 +114,10 @@ instance Pretty I where
 instance Individual I where
 
   new (I p _) =
-    sample $ I p . zip (nub $ students p) <$> shuffle (nub $ topics p)
+    sample $ I p . zip (nub $ students p) <$> shuffle (topics p)
 
   fitness (I p a) =
-    return . (fromIntegral (prioOf p undefined NoT) /) . sum
+    return . negate . sum
       $ fromIntegral . uncurry (prioOf p) <$> a
 
   mutate (I p a) = do