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).
This commit is contained in:
		
							parent
							
								
									ec84f84aa8
								
							
						
					
					
						commit
						73c62b0a8f
					
				@ -84,13 +84,17 @@ topics p = topics' ++ padding
 | 
				
			|||||||
    topics' = nub . join $ fmap fst . snd <$> p
 | 
					    topics' = nub . join $ fmap fst . snd <$> p
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{-|
 | 
					{-|
 | 
				
			||||||
The priority of topics that have not been assigned a priority is the sum of all
 | 
					The sum of all priorities given by all students.
 | 
				
			||||||
priorities given by all the students. The priority of 'NoTopic' is one more than
 | 
					-}
 | 
				
			||||||
that value.
 | 
					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 :: Priorities -> Student -> T -> Int
 | 
				
			||||||
prioOf p _ NoT = (1 +) . sum $ (sum . fmap snd) . snd <$> p
 | 
					prioOf _ _ NoT = 101
 | 
				
			||||||
prioOf p s t = maybe (prioOf p s NoT) identity $ lookup s p >>= lookup t
 | 
					prioOf p s t = maybe (prioOf p s NoT - 1) identity $ lookup s p >>= lookup t
 | 
				
			||||||
 | 
					
 | 
				
			||||||
type Assignment = [(Student, T)]
 | 
					type Assignment = [(Student, T)]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -110,10 +114,10 @@ instance Pretty I where
 | 
				
			|||||||
instance Individual I where
 | 
					instance Individual I where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  new (I p _) =
 | 
					  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) =
 | 
					  fitness (I p a) =
 | 
				
			||||||
    return . (fromIntegral (prioOf p undefined NoT) /) . sum
 | 
					    return . negate . sum
 | 
				
			||||||
      $ fromIntegral . uncurry (prioOf p) <$> a
 | 
					      $ fromIntegral . uncurry (prioOf p) <$> a
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  mutate (I p a) = do
 | 
					  mutate (I p a) = do
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user