0votos

Corrección de errores ortográficos en Haskell

por josejuan hace 11 meses

Es un bonito ejercicio. Se implementa totalmente la solución permitiendo buscar eficientemente TODAS las palabras del diccionario que pueden formarse con no más de X inserciones e Y eliminaciones aportando el peso de importancia de cada palabra del resultado.

Encontrar la palabra P (que estaría en un diccionario) mas "apropiada" al haber un usuario ingresado una palabra P' , que inicialmente, no se encuentra en él (dicc.)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
{-# LANGUAGE TupleSections #-} 
import Data.Map (Map) 
import Control.Arrow 
import Data.Function 
import Data.Tuple 
import qualified Data.Map as M 
 
-- por simplicidad se omiten las marcas de fin de palabra, 
-- por lo que se consideran palabras válidas todos los 
-- prefijos posibles, para evitarlo, al final del todo hay 
-- un pequeño hack 
 
-- árbol de prefijos 
newtype Pre = Pre { m :: M.Map Char Pre } 
 
-- un tesaurus vacío 
∅ :: Pre 
∅ = Pre M.∅ 
 
-- insertar una palabra en el tesaurus 
insert :: 𝐒 → Pre → Pre 
insert    []   p      = p 
insert (x:xs) (Pre m) = case M.lookup x m of 
                          𝑁   → Pre $ M.insert x (        insert xs ∅)   m 
                          𝐽 p → Pre $ M.adjust   (const $ insert xs p) x m 
 
-- crear un tesaurus a partir de una lista de palabras 
fromList :: [𝐒] → Pre 
fromList = foldr insert ∅ 
 
-- busca todas las palabras a una distancia menor que las reglas de ajuste 
-- indicadas 
search :: Int → Int → Pre → 𝐒 → [(Int, 𝐒)] 
search del ins _                []  = [(del + ins, [])] -- hemos conseguido la palabra y quedan x cambios 
search del ins p@(Pre m) xss@(x:xs) = eq ⧺ dels ⧺ inss 
  where eq = case M.lookup x m of 
               𝑁   → [] 
               𝐽 p → map (second (x:)) $ search del ins p xs 
        dels = if del < 1 then [] else search (del - 1) ins p xs 
        inss = if ins < 1 then [] else concat [map (second (c:)) (search del (ins - 1) p xss) | (c, p) ← M.assocs m, c ≢ x] 
 
-- ya está 
 
 
 
 
 
-- hack para encontrar sólo palabras válidas eliminando los prefijos 
data Diccionario = Diccionario { palabras :: M.Map 𝐒 (), prefijos :: Pre } 
makeDiccionario :: [𝐒] → Diccionario 
makeDiccionario ws = Diccionario (M.fromList $ (, ()) ↥ ws) (fromList ws) 
 
search' :: Int → Int → Diccionario → 𝐒 → [(𝐒, Int)] 
search' ins del (Diccionario ws ps) p = M.assocs $ M.fromListWith max $ map swap $ filter (λ(_, w) → M.member w ws) $ search ins del ps p 
 
-- ya está 
 
 
 
 
 
 
 
 
-- por ejemplo, tomando las 80.379 palabras del diccionario: 
-- 
--    http://www.solveet.com/artefactos/kata_anagramas_wordlist.zip 
-- 
-- se ve que aun cuando no está tuneada la solución y no está compilada 
-- obtiene de forma inmediata todas las palabras del diccionario que pueden 
-- formarse con no más de X inserciones y X eliminaciones junto con el peso 
-- de cada una de ellas 
-- 
{- 
 
> :set +s 
> dic <- (makeDiccionario . words) <$> readFile "kata_anagramas_wordlist.txt" 
(0.01 secs, 0 bytes) 
> length $ M.assocs $ palabras dic 
80379 
(0.50 secs, 234,067,704 bytes) 
> search' 2 2 dic "cabalaza" 
[("abalada",1),("acabalar",0),("alcabala",0),("balanza",1),("cabalar",1),("cabalgada",1),("cabalgar",0),("cabalgata",1),("caballa",1),("caballada",1),("caballar",0),("caballazo",1),("cabaza",2),("calabaza",0),("cambalada",1),("chalaza",1),("sacabala",0),("tabalada",0)] 
(0.90 secs, 262,210,784 bytes) 
> search' 2 2 dic "cabalaza" 
[("abalada",1),("acabalar",0),("alcabala",0),("balanza",1),("cabalar",1),("cabalgada",1),("cabalgar",0),("cabalgata",1),("caballa",1),("caballada",1),("caballar",0),("caballazo",1),("cabaza",2),("calabaza",0),("cambalada",1),("chalaza",1),("sacabala",0),("tabalada",0)] 
(0.11 secs, 26,750,032 bytes) 
> search' 2 2 dic "papatanas" 
[("alpatana",1),("apantanar",0),("apatanado",0),("aplatanar",0),("papanatas",0)] 
(0.12 secs, 34,667,496 bytes) 
 
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.