From 83dbc9c259a399c81323e4fc549651f291fa73fe Mon Sep 17 00:00:00 2001 From: Georgi Angelov Date: Mon, 25 Oct 2021 17:44:42 +0300 Subject: [PATCH 1/3] Refactored helper functions into Utils.hs --- Server.hs | 22 +++------------------- Utils.hs | 19 +++++++++++++++++++ 2 files changed, 22 insertions(+), 19 deletions(-) create mode 100644 Utils.hs diff --git a/Server.hs b/Server.hs index f66c2b6..8cdcc76 100644 --- a/Server.hs +++ b/Server.hs @@ -1,9 +1,9 @@ - import Happstack.Server import Solver +import Utils import Control.Monad (msum) -myConf = Conf +serverConf = Conf { port = 5001 , validator = Nothing , logAccess = Just logMAccess @@ -11,7 +11,7 @@ myConf = Conf , threadGroup = threadGroup nullConf } -main = simpleHTTP myConf $ msum [ dir "solve" $ path $ \clue -> path $ \wordLength +main = simpleHTTP serverConf $ msum [ dir "solve" $ path $ \clue -> path $ \wordLength -> ok $ show (solveReturn (clue, wordLength)) , dir "solveAll" $ path $ \clue -> path $ \wordLength -> ok $ show (solveAllReturn (clue, wordLength)) @@ -20,19 +20,3 @@ main = simpleHTTP myConf $ msum [ dir "solve" $ path $ \clue -> path $ \wordLeng , dir "solveWithAnswers" $ path $ \clue -> path $ \wordLength -> path $ \answers -> ok $ show (solveAnswers clue wordLength answers) ] - -solveAnswers clue wordLength answers - = solveEach clue wordLength (wordsWhen (==',') answers) - where - solveEach _ _ [] = [] - solveEach clue wordLength (a:as) - | null (solveWithAnswerReturn (clue, wordLength) a) - = solveEach clue wordLength as - | otherwise - = head (solveWithAnswerReturn (clue, wordLength) a) : solveEach clue wordLength as - -wordsWhen :: (Char -> Bool) -> String -> [String] -wordsWhen p s = case dropWhile p s of - "" -> [] - s' -> w : wordsWhen p s'' - where (w, s'') = break p s' diff --git a/Utils.hs b/Utils.hs new file mode 100644 index 0000000..7e7bb3c --- /dev/null +++ b/Utils.hs @@ -0,0 +1,19 @@ +import Solver + +-- Receives a list of possible answers to a clue and returns a list of all valid answers +solveAnswers clue wordLength answers + = solveEach clue wordLength (wordsWhen (==',') answers) + where + solveEach _ _ [] = [] + solveEach clue wordLength (a:as) + | null (solveWithAnswerReturn (clue, wordLength) a) + = solveEach clue wordLength as + | otherwise + = head (solveWithAnswerReturn (clue, wordLength) a) : solveEach clue wordLength as + +-- Helper function to split string by character into a list of strings +wordsWhen :: (Char -> Bool) -> String -> [String] +wordsWhen p s = case dropWhile p s of + "" -> [] + s' -> w : wordsWhen p s'' + where (w, s'') = break p s' -- GitLab From 43dfac7b6e9dc6ee27dd8087b45cf6d3e20f3359 Mon Sep 17 00:00:00 2001 From: gga19 Date: Mon, 25 Oct 2021 20:33:46 +0300 Subject: [PATCH 2/3] Utils is now a module --- Utils.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Utils.hs b/Utils.hs index 7e7bb3c..25acbe0 100644 --- a/Utils.hs +++ b/Utils.hs @@ -1,3 +1,5 @@ +module Utils where + import Solver -- Receives a list of possible answers to a clue and returns a list of all valid answers -- GitLab From cf46aa0f6a947cdd3b4e10459c3a9d088cc52fe4 Mon Sep 17 00:00:00 2001 From: Georgi Angelov Date: Mon, 25 Oct 2021 17:58:15 +0300 Subject: [PATCH 3/3] Update latest files from Tony's master branch --- Databases.hs | 118 ++++++++++++++++++++++++++++++++++++++++++++-- Evaluation.hs | 4 +- Indicators.hs | 79 +++++++++++++++++++++++++------ interesting-clues | 40 ++++++++++++++++ 4 files changed, 221 insertions(+), 20 deletions(-) diff --git a/Databases.hs b/Databases.hs index be76526..846a3e2 100644 --- a/Databases.hs +++ b/Databases.hs @@ -309,9 +309,12 @@ manualSynsTable manualSynonyms = concat [[(w, w'), (w', w)] | (w, ws) <- synList, w' <- ws] +-- +-- Note: These largely align with definition noise words (links) +-- prefixNoiseWords - = ["a","an","one","the","this","that","that is", - "that's","these","they","it's","what's","what is"] + = ["a","an","it","it's","one","that","that is","that's","the", + "there's","these","they","this","what's","what is","who","who's"] -- -- Used to filter out bad definitions @@ -734,6 +737,7 @@ indirectSynonymsTable ("swimmers", "fish"), ("very large", "enormous"), ("very big", "enormous"), + ("veg", "vegetable"), ("volume", "amount"), ("volumes", "amounts"), ("winger", "bird"), @@ -2389,6 +2393,7 @@ synList ("atrium", ["entrance","entrace hall"]), ("atria", ["entrances","entrace halls"]), ("award", ["diploma"]), + ("awful", ["bum"]), ("badly made", ["gimcrack"]), ("ballet", ["cinderella","giselle","nutcracker","spartacus", "swanlake","coppelia","firebird","manon","esmerelda", @@ -2542,6 +2547,8 @@ synList ("craft", ["art"]), ("crockery", ["pots"]), ("cry of pain", ["ow","ouch"]), + ("cup", ["bra"]), + ("cups", ["bra","bras"]), ("cur", map (++" dog") ["angry","aggressive","unkempt","vicious"]), ("currency", ["lire","krone","cent"]), ("current", ["i"]), @@ -2703,7 +2710,8 @@ synList ("japanese sash", ["obi"]), ("keep going", ["presson"]), ("keynote", ["mese"]), - ("king", ["lear"]), + ("king", ["henry","lear","richard","stephen","tut", + "william"]), ("knocks", ["poohpoohs"]), ("l", ["large-size","large-sized"]), ("lack of restraint", ["licence"]), @@ -2815,6 +2823,7 @@ synList ("per year", ["pa"]), ("philosopher", ["plato","bacon"]), ("piece", ["bit","pawn","man"]), + ("plant", ["moss"]), ("planted", ["under"]), ("polar", ["n","s"]), ("pompous", ["selfimportant"]), @@ -2888,6 +2897,7 @@ synList ("small intenstine", ["ileum"]), ("small space", ["alcove"]), ("small worker", ["ant"]), + ("small bit", ["mote"]), ("smarter", ["brainier"]), ("sober", ["tt"]), ("social worker", ["ant","bee"]), @@ -2915,14 +2925,17 @@ synList "villa","wolves","gunners","reds","blades", "clarets","blues","foxes","magpies"]), ("term", ["hilary","michaelmas","trinity"]), + ("terrible", ["bum"]), ("that place", ["there"]), ("theme", ["leitmotif"]), ("therapy", ["treatment"]), ("this evening", ["tonight"]), ("this place", ["here"]), ("time", ["t","h","m","s","am","pm","ms","ns","ps","fs"]), + ("tiny bit", ["mote"]), ("tobacco", ["fag","nicotiana"]), ("took", ["denuded"]), + ("track", ["ry"]), ("trains", ["ry"]), ("traffic light", ["red","amber","green"]), ("tree", ["tooart"]), @@ -3500,6 +3513,101 @@ abbreviationsTable allAbbreviations = [("666", ["mb"]), +-- Name abbreviations... + ("abigail", ["abig"]), + ("abraham", ["abe"]), + ("agnes", ["agn"]), + ("alexander", ["alex"]), + ("alfred,", ["alf"]), + ("alphonse", ["alf"]), + ("ambrose", ["amb"]), + ("andrew", ["andy"]), + ("anthony", ["ant","tony"]), + ("arthur", ["art"]), + ("augustus", ["aug"]), + ("barbara", ["barb","babs"]), + ("bartholomew", ["bart"]), + ("benjamin", ["benj"]), + ("catherine", ["cath","cathy"]), + ("charles", ["chas"]), + ("christian", ["chr"]), + ("clement", ["clem"]), + ("constance", ["const"]), + ("cornelius", ["corn"]), + ("daniel", ["dan"]), + ("david", ["dave"]), + ("deborah", ["deb","debs"]), + ("dennis", ["den"]), + ("douglas", ["doug"]), + ("dorothy", ["dot"]), + ("edmund", ["ed"]), + ("edward", ["ed","ted","eddy","eddie"]), + ("edward", ["ed"]), + ("elizabeth", ["liz"]), + ("frederick", ["fred"]), + ("francis", ["fs"]), + ("gabriel", ["gabby"]), + ("geoffrey", ["geoff"]), + ("godfrey", ["godf"]), + ("gregory", ["greg"]), + ("hannah", ["han"]), + ("henry", ["hal","hy","hen"]), + ("helen", ["hel"]), + ("herbert", ["herb"]), + ("isabel", ["izzy"]), + ("james", ["jim","jas"]), + ("jeremiah", ["jerry"]), + ("jeremy", ["jerry"]), + ("johathan", ["jon"]), + ("johathon", ["jon"]), + ("joseph", ["jos"]), + ("joshua", ["josh"]), + ("josiah", ["josh"]), + ("judith", ["jude"]), + ("laurence", ["larry"]), + ("lawrence", ["larry"]), + ("leonard", ["leon"]), + ("lydia", ["lyd"]), + ("margaret", ["maggy"]), + ("matthias", ["math"]), + ("matthew", ["matt"]), + ("michael", ["mick"]), + ("millicent", ["milly"]), + ("mary", ["my"]), + ("nathaniel", ["nath","natt"]), + ("nicholas", ["nick"]), + ("oliver", ["ol","oli","olly"]), + ("patrick", ["pat"]), + ("penelope", ["pen","penny"]), + ("peter", ["pet"]), + ("philip", ["phil"]), + ("phineas", ["phin"]), + ("phyllis", ["phyl"]), + ("priscilla", ["prisc"]), + ("prudence", ["pru"]), + ("raymond", ["ray"]), + ("rebecca", ["becky"]), + ("reginald", ["reg"]), + ("richard", ["rich","rick"]), + ("robert", ["rob"]), + ("roger", ["rog"]), + ("sally", ["sal"]), + ("samuel", ["sam"]), + ("sylvester", ["silv"]), + ("solomon", ["sol"]), + ("stephen", ["steve"]), + ("susan", ["sue"]), + ("theodore", ["theo"]), + ("thomas", ["tom"]), + ("timothy", ["tim"]), + ("valentine", ["val"]), + ("vincent", ["vince","vinny"]), + ("walter", ["walt"]), + ("winifred", ["win","winnie"]), + ("william", ["bill","wm","will"]), + ("christopher", ["chris"]), + ("zachariah", ["zach"]), +-- END ("a follower", ["b"]), ("able seaman", ["ab"]), ("about", ["ca","re","c"]), @@ -3533,7 +3641,7 @@ allAbbreviations ("alternating current", ["ac"]), ("alto", ["a"]), ("aluminium", ["al"]), - ("amateur", ["l"]), + ("amateur", ["a","l"]), ("ambassador", ["he"]), ("america", ["us","usa","am"]), ("american", ["am","amer","us"]), @@ -3654,6 +3762,7 @@ allAbbreviations ("before christ", ["ac","bc"]), ("before food", ["ac"]), ("before the day", ["ad"]), + ("beginner", ["l"]), ("beginning", ["alpha"]), ("being broadcast", ["on"]), ("bel", ["b"]), @@ -5123,6 +5232,7 @@ allAbbreviations ("square root of 1", ["j","i"]), ("stand in", ["sub"]), ("standard", ["par"]), + ("starter", ["l"]), ("starting price", ["sp"]), ("state", ["s","st","ak","al","ar","az","be","ca","cf","co", diff --git a/Evaluation.hs b/Evaluation.hs index cd4ceb8..383606f 100644 --- a/Evaluation.hs +++ b/Evaluation.hs @@ -76,7 +76,7 @@ evaluate ps pCache clue@(clueText, n) answer evalCacheOn let evalCandidate cand = if evalCacheOn && null answer then indexEvalCache evCache i j k cand else evalB cand t UseAllSyns evalCacheOn nullAnagramText, - rt <- trace (show tnum ++ " " ++ show nTrees) $ + rt <- -- trace (show tnum ++ " " ++ show nTrees) $ -- -- Uncomment one of the following. The first uses the cache; -- the second doesn't. The False argument ensures that all @@ -344,7 +344,7 @@ evaluate ps pCache clue@(clueText, n) answer evalCacheOn -- i.e. TRIBE. With these in, we can't solve for UNKEMPT. -- evalSubtextB t matchType matcherM matcherC generator - | True = rawTextMatches + -- | True = rawTextMatches | expander == UseTextSyns = rawTextMatches | isSynonymTree t || isHyponymTree t diff --git a/Indicators.hs b/Indicators.hs index a329b08..d251993 100644 --- a/Indicators.hs +++ b/Indicators.hs @@ -35,6 +35,7 @@ defNoise "that", "that's", "the", + "there's", "these", "they", "this", @@ -145,6 +146,8 @@ anagramNoise "all", "an", "be", + "been", + "being", "by", "but", "for", @@ -1683,6 +1686,8 @@ anagramInd2 "suspect", "swagger", "sway", + "sweep", + "swept", "swilled", "swim", "swimming", @@ -2031,17 +2036,34 @@ oddsInd1 oddsInd2 = ["50-50", - "alternately", - "at odds", + "alternately", + "at odds", + "brokenly", + "disconnectedly", + "discontinuously", "even go", + "even gone", "even missing", - "every other", - "no even", - "not even", - "oddly", + "even without", + "every other", + "every so often", + "fitfully", + "haphazardly", + "infrequently", + "intermittently", + "irregularly", + "no even", + "not even", + "occasionally", + "oddly", + "randomly", "regularly", "skipping", - "uneven"] + "skippingly", + "sporadically", + "uneven", + "willy-nilly", + "without even"] evensNoise = oddsNoise @@ -2051,17 +2073,32 @@ evensInd1 evensInd2 = ["50-50", - "alternately", - "even", - "every other", + "alternately", + "brokenly", + "disconnectedly", + "discontinuously", + "even", + "every other", + "every so often", + "fitfully", + "haphazardly", + "infrequently", + "intermittently", + "irregularly", "no odds", - "not odd", + "not odd", + "occasionally", "odd go", "odd missing", "odds removed", + "randomly", "regularly", "removed odds", - "skipping"] + "skipping", + "skippingly", + "sporadically", + "willy-nilly", + "without odd"] firstLettersNoise = ["a", @@ -2225,6 +2262,7 @@ firstLetterWords "nearly", "nip", "north", + "not entirely", "not half", "not quite", "onset", @@ -2813,7 +2851,9 @@ lessableEndLetterWords "wing"] endLetterWords - = ["bare", + = ["bandage", + "binder", + "bare", "barren", "blank", "borderland", @@ -2826,7 +2866,7 @@ endLetterWords "circumference", "circumscription", "coat", - "covering", + "cover", "crust", "curtains", "devoid", @@ -2838,6 +2878,7 @@ endLetterWords "empty-minded", "empty-skulled", "endmost", + "envelope", "environment", "environs", "epidermis", @@ -2854,6 +2895,7 @@ endLetterWords "half hearted", "hollow", "inside out", + "jacket", "janus-like", "left and right", "margins", @@ -2889,6 +2931,7 @@ endLetterWords "vacuum", "verges", "void", + "wrapper", "walls"] endLettersInd2 @@ -2943,6 +2986,8 @@ homophoneNoise "about", "as", "be", + "been", + "being", "by", "but", "come", @@ -3046,6 +3091,8 @@ hyponymNoise "an", "as", "be", + "been", + "being", "for", "he", "has", @@ -3520,6 +3567,7 @@ insertionWords "bury", "buy", "centre", + "choke", "coated", "countersink", "countersunk", @@ -3652,6 +3700,7 @@ envelopingWords "camouflages", "carry", "casing", + "choke", "cloaking", "concealing", "cover", @@ -3763,6 +3812,7 @@ surroundingWords "delimit", "deploy", "deposit", + "describe", "devouring", "digest", "discern", @@ -4374,6 +4424,7 @@ charadeNoise "an", "as", "be", + "been", "being", "came", "come", diff --git a/interesting-clues b/interesting-clues index 2befb4a..5a46441 100644 --- a/interesting-clues +++ b/interesting-clues @@ -155,3 +155,43 @@ engaged in politics -> ELECTIONEERING(E=european + LECT(first letters[with brief] lecture) + IONEE(anagram[about] IEONE(IE=that is + one)) + RING=group) The longest clue and answer: 522K parses. Should use insertion rather than anagram. + +("Removing wrappers to use gas over, Lloyd prepared food", 7) 28575 +prepared food -> SAVELOY(middle letters[removing wrappers to] USE GAS OVER LLOYD(use + gas + over + lloyd)) + +("Sacred work is a tiny bit tacky at the outset", 5) 28577 +sacred work ->[is] MOTET(MOTE=a tiny bit + T(first letters[at the outset] tacky)) + +(I made it into one word)... + ("Cups in large boxes right? That's a mental lapse",9) 28578 +that's a mental lapse -> BRAINFART(BRA=cups + in + FART(insert[boxes] R=right into FAT=large)) + +("Athenian's dip in defeat, alas, a marathon backfiring", 12) 28578 +athenian's dip -> TARAMASALATA(middle letters[in] NOHTARAM A SALA TAEFED(reversal[backfiring] DEFEATALASAMARATHON(defeat + alas + a + marathon))) + +("Adolescent growth, terrible mistake",8) 28578 +adolescent growth -> BUMFLUFF(BUM=terrible + FLUFF=mistake) + +("Fungus by the sea gets wet, finally", 5) 28578 +fungus -> YEAST(last letters[finally] BY SEA GETS WET(by + SEA=the sea + gets + wet)) + +("Quite forgetting to count",5) 28575 +count -> TALLY(subtract[forgetting] to from TOTALLY=quite) + +Ambiguity... +*Solver> solveAll ("Sets of offices",8) 28560 +sets -> REPLACES(RE=of + PLACES=offices) +sets ->[of] BACKINGS=offices +sets ->[of] STATIONS=offices +sets ->[of] CABINETS=offices +sets ->[of] SERVICES=offices +sets ->[of] SECTIONS=offices + +odds/evens... +*Solver> solve ("Wet track limits Asians every so often", 5) G28569 +wet -> RAINY(insert[limits] AIN(odd letters[asians]) into RY=track) + +*Solver> solve ("Left old university? Not entirely true",5) G28569 Needs +indirection +true -> LOYAL(L=left + O=old + YAL(first letters[not entirely] YALE=university)) + -- GitLab