From 6e139370a573ff0e88baad395d52f2bb2a006f9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20P=C3=A4tzel?= Date: Tue, 27 Apr 2021 15:00:44 +0200 Subject: [PATCH] Fix solution validity check for seminar problem Invalid solutions where one topic was assigned multiple times were evaluated as valid; this issue arose whenever there were less students than topics. --- src/Seminar.hs | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Seminar.hs b/src/Seminar.hs index 7ed9924..44b06e4 100644 --- a/src/Seminar.hs +++ b/src/Seminar.hs @@ -6,7 +6,7 @@ module Seminar where import Data.List ((!!), (\\), lookup, zipWith3) -import Data.List.Extra (nubOrd, nubOrdOn) +import Data.List.Extra (delete, nubOrd, nubOrdOn) import Data.Random import qualified Data.Text as T import GA @@ -177,18 +177,16 @@ switch i' j' xs {-| Whether the given assignment is valid (every student occurs at most once, as does every topic; also, there is only no topic given to students if there are -less topics then students). +less topics than students). Assumes that the priorities are well-formed. -} valid :: Priorities -> Assignment -> Bool valid p a = + -- all students must be part of the solution sort (students p) == sort studentsAssigned - -- either there are less students than topics … - && ( length (students p) < length (topics p) - -- … or every existing topic needs to be assigned - || sort (topics p) == (sort . catMaybes) topicsAssigned - ) + -- each actual topic (i.e. not “no topic”) is assigned at most once + && nubOrd (delete Nothing topicsAssigned) == delete Nothing topicsAssigned where studentsAssigned = fmap fst a topicsAssigned = fmap snd a