0votos

Subsecuencias de Wirth en Haskell

por josejuan hace 6 años

Una propiedad interesante de las secuencias Wirth es que el conjunto n-wirth se puede generar a partir del (n-1)-wirth tan sólo añadiendo un carácter a cada elemento (A, B o C en el enunciado) y ver si el prefijo de 1, 2, 3, ... caracteres queda repetido al principio del nuevo elemento generado. El conjunto 0-wirth es la cadena vacía, claro.

Encontrar todas las cadenas de N caracteres "A", "B" o "C" tales que no contengan dos subsecuencias consecutivas.

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
94
95
96
97
-- Una forma completa y rápida de generar el conjunto n-wirth es: 
wsec 0 = [""] 
wsec n = filter (not.pfx (n `div` 2)) $ map (:) "ABC" <*> wsec (n - 1) 
  where pfx 0 _  = False 
        pfx n xs = pfx (n - 1) xs || (uncurry isPrefixOf . splitAt n) xs 
 
 
-- Una forma elegante de generar los infinitos conjuntos: 0-wirth, 1-wirth, ... 
-- de un alfabeto cualquiera, sería ésta; pero genera mucha memoria (el conjunto 
-- wirth crece a velocidad exponencial). 
wirthList abc = [""] : inf 1 
  where inf n = (filter (chkPrefix n) $ map (:) abc <*> ((wirthList abc)!!(n - 1))): 
                inf (n + 1) 
 
 
 
 
-- El código verbose sería: 
 
{-# LANGUAGE ScopedTypeVariables #-} 
import Control.Applicative ((<*>), (<$>)) 
import Data.List (isPrefixOf, splitAt) 
import System.Environment (getArgs) 
 
-- Las infinitas listas de secuencias wirth de diccionario arbitrario: 
wirthList :: String -> [[String]] 
wirthList abc = [""] : inf 1 
  where inf n = (filter (chkPrefix n) $ map (:) abc <*> ((wirthList abc)!!(n - 1))): inf (n + 1) 
 
 
 
-- Añadiendo un único símbolo, la secuencia es válida si no se repite consecutivamente, 
-- el primer caracter, los dos primeros caracteres, los tres ...  
chkPrefix :: Int -> String -> Bool 
chkPrefix n = not . prefixsDup (n `div` 2) 
 
-- Indica si el primer caracter se repite con el segundo, si el primero y segundo con 
-- el tercero y cuarto, el primero, segundo y tercero con el cuarto, quinto y sexto, etc... 
prefixsDup :: Int -> String -> Bool 
prefixsDup 0 _  = False 
prefixsDup n xs = prefixsDup (n - 1) xs || prefixDup n xs 
 
-- Indica si el prefijo indicado se repite consecutivamente (sólo al inicio) 
prefixDup :: Int -> String -> Bool 
prefixDup s = uncurry isPrefixOf . splitAt s 
 
-- Dado un diccionario (eg. "ABC") y dos números A y B, calcula el número de elementos de cada 
-- conjunto Wirth con número de caracteres A, A+1, A+2, .. B-1, B. 
main = do 
  (w:a:b:_) <- getArgs 
  let r :: [Int] = [read a .. read b] 
      abcWirthLength n = length $ (wirthList w)!!n 
  mapM_ (\n -> putStrLn ("#" ++ show n ++ " -> " ++ show (abcWirthLength n))) r 
 
 
{-- 
 
En mi Atom D510 el código anterior genera los primeros 30 conjuntos Wirth en menos de 8 segundos. 
 
(En realidad puede generarse con una constante multiplicativa mucho más pequeña, porque hay 
estrategias más eficientes de realizar las comparaciones que usando las funciones genéricas que 
yo he usado) 
 
solveet$ time -f "%E, %M" ./wsec ABC 0 29 
#0 -> 1 
#1 -> 3 
#2 -> 6 
#3 -> 12 
#4 -> 18 
#5 -> 30 
#6 -> 42 
#7 -> 60 
#8 -> 78 
#9 -> 108 
#10 -> 144 
#11 -> 204 
#12 -> 264 
#13 -> 342 
#14 -> 456 
#15 -> 618 
#16 -> 798 
#17 -> 1044 
#18 -> 1392 
#19 -> 1830 
#20 -> 2388 
#21 -> 3180 
#22 -> 4146 
#23 -> 5418 
#24 -> 7032 
#25 -> 9198 
#26 -> 11892 
#27 -> 15486 
#28 -> 20220 
#29 -> 26424 
0:07.62, 57876 
 
--} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.