Skip to content

GitLab

Commit c3850bbc authored by Angelov, Georgi's avatar Angelov, Georgi
Browse files

Merge branch 'refactor_and_update' into 'master' 

Refactor and update

See merge request !1
parents 7d5cd2f4 cf46aa0f
Hide whitespace changes
Inline Side-by-side
Databases.hs
View file @ c3850bbc
......@@ -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",
......
Evaluation.hs
View file @ c3850bbc
......@@ -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
......
Indicators.hs
View file @ c3850bbc
......@@ -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",
......
Server.hs
View file @ c3850bbc
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'
Utils.hs 0 → 100644
View file @ c3850bbc
module Utils where
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'
interesting-clues
View file @ c3850bbc
......@@ -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))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment