@@ -1,86 +1,35 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Reporting.Suggest
4− ( findPotentialTypos, findTypoPairs, vetTypos
5− , nearbyNames, distance
4+ ( distance
5+ , sort
66 )
77 where
88
99
10−import Data.Function (on)
10+import qualified Data.Char as Char
1111import qualified Data.List as List
12−import qualified Data.Map as Map
13−import qualified Data.Maybe as Maybe
14−import qualified Data.Set as Set
1512import qualified Text.EditDistance as Dist
1613
1714
1815
19−-- FIND TYPOS
20−
21−
22−findPotentialTypos :: [String] -> String -> [String]
23−findPotentialTypos knownNames badName =
24− filter (\name -> distance badName name == 1) knownNames
25−
26−
27−findTypoPairs :: [String] -> [String] -> [(String, String)]
28−findTypoPairs leftOnly rightOnly =
29− let
30− veryNear leftName =
31− map ((,) leftName) (findPotentialTypos rightOnly leftName)
32− in
33− concatMap veryNear leftOnly
34−
35−
36−vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)
37−vetTypos potentialTypos =
38− let
39− tallyNames (ln, rn) (lc, rc) =
40− ( Map.insertWith (+) ln 1 lc
41− , Map.insertWith (+) rn 1 rc
42− )
43−
44− (leftCounts, rightCounts) =
45− foldr tallyNames (Map.empty, Map.empty) potentialTypos
46−
47− acceptable :: Map.Map String Int -> Bool
48− acceptable counts =
49− not (Map.null counts)
50− &&
51− Map.foldr (\n unique -> n < 2 && unique) True counts
52− in
53− if acceptable leftCounts && acceptable rightCounts then
54− Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
55−
56− else
57− Nothing
16+-- DISTANCE
5817
5918
19+distance :: String -> String -> Int
20+distance x y =
21+ Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
6022
61−-- NEARBY NAMES
6223
6324
64−nearbyNames :: (a -> String) -> a -> [a] -> [a]
65−nearbyNames toString value possibleValues =
66− let
67− name =
68− toString value
25+-- SORT
6926
70− editDistance =
71− if length name < 3 then 1 else 2
7227
73− getDistance pValue =
74− let
75− dist = abs (distance name (toString pValue))
76− in
77− if dist <= editDistance then Just (dist, pValue) else Nothing
78− in
79− map snd $
80− List.sortBy (compare `on` fst) $
81− Maybe.mapMaybe getDistance possibleValues
28+sort :: String -> (a -> String) -> [a] -> [a]
29+sort target toString values =
30+ List.sortOn (distance (toLower target) . toLower . toString) values
8231
8332
84−distance :: String -> String -> Int
85−distance x y =
86− Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
33+toLower :: String -> String
34+toLower string =
35+ map Char.toLower string