fix(exams): exam-auto-occurrence introduced spurious MappingSpecial

This commit is contained in:
Gregor Kleen 2020-01-30 13:33:02 +01:00
parent 91e1bf9996
commit a1d547990d

View File

@ -197,7 +197,7 @@ data ExamAutoOccurrenceConfig = ExamAutoOccurrenceConfig
instance Default ExamAutoOccurrenceConfig where instance Default ExamAutoOccurrenceConfig where
def = ExamAutoOccurrenceConfig def = ExamAutoOccurrenceConfig
{ eaocMinimizeRooms = False { eaocMinimizeRooms = False
, eaocFinenessCost = 0.2 , eaocFinenessCost = 0.1
} }
makeLenses_ ''ExamAutoOccurrenceConfig makeLenses_ ''ExamAutoOccurrenceConfig
@ -467,7 +467,6 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
, Just maxA <- nsA ^? _last , Just maxA <- nsA ^? _last
, Just minB <- nsB ^? _head , Just minB <- nsB ^? _head
= let common = maxA `lcp` minB = let common = maxA `lcp` minB
mayRange' = mayRange . max 1 . succ $ length common
suffA = CI.foldedCase <$> drop (length common) maxA suffA = CI.foldedCase <$> drop (length common) maxA
suffB = CI.foldedCase <$> drop (length common) minB suffB = CI.foldedCase <$> drop (length common) minB
in if in if
@ -495,9 +494,10 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
= Just $ c' : cs = Just $ c' : cs
| otherwise | otherwise
= go cs = go cs
in (occA, Set.insert (ExamOccurrenceMappingRange minA break') . Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ length common)) . Set.filter (not . mayRange') $ Set.fromList nsA) : accRes succBreak ((occB, nsB) : xs) commonLength = max 1 . succ . length $ minA `lcp` break'
in (occA, Set.insert (ExamOccurrenceMappingRange minA break') . Set.map (ExamOccurrenceMappingSpecial . take commonLength) . Set.filter (not . mayRange commonLength) $ Set.fromList nsA) : accRes succBreak ((occB, nsB) : xs)
| otherwise | otherwise
-> (occA, Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ length common)) $ Set.fromList nsA) : accRes prevEnd ((occB, nsB) : xs) -> (occA, Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ maybe 0 length prevEnd)) $ Set.fromList nsA) : accRes prevEnd ((occB, nsB) : xs)
| null nsA | null nsA
= accRes prevEnd $ (occB, nsB) : xs = accRes prevEnd $ (occB, nsB) : xs
| otherwise -- null nsB | otherwise -- null nsB
@ -506,7 +506,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
| Just minAlpha <- Set.lookupMin rangeAlphabet | Just minAlpha <- Set.lookupMin rangeAlphabet
, Just maxAlpha <- Set.lookupMax rangeAlphabet , Just maxAlpha <- Set.lookupMax rangeAlphabet
, minZ <- fromMaybe (pure minAlpha) prevEnd , minZ <- fromMaybe (pure minAlpha) prevEnd
= let commonLength = max 1 $ length minZ = let commonLength = max 1 . succ . length $ takeWhile (== maxAlpha) minZ
in pure (occZ, Set.insert (ExamOccurrenceMappingRange minZ $ replicate commonLength maxAlpha) . Set.map (ExamOccurrenceMappingSpecial . take commonLength) . Set.filter (not . mayRange commonLength) $ Set.fromList nsZ) in pure (occZ, Set.insert (ExamOccurrenceMappingRange minZ $ replicate commonLength maxAlpha) . Set.map (ExamOccurrenceMappingSpecial . take commonLength) . Set.filter (not . mayRange commonLength) $ Set.fromList nsZ)
| otherwise | otherwise
= pure (occZ, Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ maybe 0 length prevEnd)) $ Set.fromList nsZ) = pure (occZ, Set.map (ExamOccurrenceMappingSpecial . take (max 1 $ maybe 0 length prevEnd)) $ Set.fromList nsZ)