1votos

Numero Vampiro en Haskell

por josejuan hace 2 años

Una forma de generarlos rápidamente es usar una variante de la forma tradicional de multiplicar para ir obteniendo los dígitos de derecha a izquierda sin tener que conocer los dígitos que aún no hemos añadido (ej. multiplicar XXX34 * XXX29 sin saber las XXXX aún). Con ello, podemos hacer backtracking para obtener rápidamente todos los vampiros de decenas de dígitos.

Dado un numero retornar "Si" o "No" dependiendo si es o no un numero vampiro

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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
import Data.List (permutations, delete) 
import Control.Arrow ((***)) 
import Control.Monad (guard, when) 
import System.Environment 
 
-- realiza un paso típico de la multiplicación de toda la vida pero sumando 
-- de columna en columna para obtener los dígitos de der a izq sin conocer 
-- los dígitos restantes que se van añadiendo por la izq 
-- 
--             #N  ···   #3   #2   #1 
--                        a    b    c 
--          x             d    e    f 
--          -------------------------- 
--             ~   ···   a·f  b·f  c·f 
--             ~   ···   b·e  e·c 
--             ~   ···   a·d 
--          -------------------------- 
--             dN        d3   d2   d1 
-- 
-- 
-- una multiplicación completa es un pliegue de los pares de der a izq 
-- (c,f), (b,e), (a,d), ... 
-- 
--   > foldl mulStep (0,[],[]) [(9,9),(9,9),(9,9),(9,9),(0,0),(0,0),(0,0),(0,0)] 
--   (0,[9,9,9,8,0,0,0,1],[(0,0),(0,0),(0,0),(0,0),(9,9),(9,9),(9,9),(9,9)]) 
--   > 9999 * 9999 
--   99980001 
-- 
--   > foldl mulStep (0,[],[]) [(4,8),(3,7),(2,6),(1,5),(0,0),(0,0),(0,0),(0,0)] 
--   (0,[0,7,0,0,6,6,5,2],[(0,0),(0,0),(0,0),(0,0),(1,5),(2,6),(3,7),(4,8)]) 
--   > 1234 * 5678 
--   7006652 
-- 
-- 
mulStep :: Integral a ⇒ (a, [a], [(a, a)]) → (a, a) → (a, [a], [(a, a)]) 
mulStep (r, ds, ms) n = 
    let ms' = n: ms 
        (r', d) = (r + ∑(zipWith (×) (fst ↥ ms') (snd ↥ reverse ms'))) `divMod` 10 
    in  (r', d: ds, ms') 
 
-- buscamos vía backtracking 
vampiros sz = do 
  p ← [(a, b) | a ← [0…9], b ← [0…9], a + b > 0] 
  busca (2 × sz) (0, [], []) [] [] p 
 
  where busca 0 (_, (0:_),  _) _ _ _ = [] 
        busca 0 (_,   ds , ms) _ _ _ = η (ds, ms) 
        busca i rds fs ps p@(a, b) = let (r', ds'@(d:_), ms') = mulStep rds p 
                                         (fs', ps')           = if d ∈ ps 
                                                                  then (fs, delete d ps)        -- se esperaba este dígito 
                                                                  else (d: fs, ps)              -- no se esperaba, se guarda 
                                         (fs'', ps'')         = if a ∈ fs' 
                                                                  then (delete a fs', ps')      -- podemos asociar `a` 
                                                                  else (fs', if i ≤ sz then ps' else a: ps')            -- `a` espera el dígito 
                                         (fs''', ps''')       = if b ∈ fs'' 
                                                                  then (delete b fs'', ps'')    -- podemos asociar `b` 
                                                                  else (fs'', if i ≤ sz then ps'' else b: ps'')          -- `b` espera el dígito 
                                     in  do 
                                            -- el nº de pendientes no puede superar los dígitos que faltan por generar 
                                            guard (length ps''' < i) 
                                            -- los pares posibles son todos o sólo (0,0) si terminamos 
                                            p ← case i `compare` (sz + 2) of 
                                                  LT → [(0,0)] 
                                                  EQ → [(a, b) | a ← [1…9], b ← [a…9]] 
                                                  GT → [(a, b) | a ← [0…9], b ← [0…9]] 
                                            busca (i - 1) (r', ds', ms') fs''' ps''' p 
 
-- generar y mostrar 
showDigits :: [Int] → ℤ 
showDigits = read ∘ concatMap show 
printVampiro (ds, ms) = let v = showDigits ds 
                            a = showDigits (fst ↥ ms) 
                            b = showDigits (snd ↥ ms) 
                        in  when (a < b) $ putStrLn $ show v ⧺ " = " ⧺ show a ⧺ " * " ⧺ show b 
 
main = getArgs ↪ ↱_printVampiro ∘ vampiros ∘ read ∘ head 
 
{- 
 
[josejuan@centella centella]$ for i in `seq 2 10`; do time -f "%E, %M" ../vampiros $i | head -n 5; done 
1530 = 30 * 51 
6880 = 80 * 86 
1260 = 21 * 60 
1827 = 21 * 87 
1435 = 35 * 41 
... 
0:00.01, 3900 
150300 = 300 * 501 
105210 = 210 * 501 
156240 = 240 * 651 
140350 = 350 * 401 
104260 = 260 * 401 
... 
0:00.23, 4096 
15003000 = 3000 * 5001 
10502100 = 2100 * 5001 
18062100 = 2100 * 8601 
15602400 = 2400 * 6501 
14003500 = 3500 * 4001 
... 
0:02.99, 4468 
1500030000 = 30000 * 50001 
1050021000 = 21000 * 50001 
1806021000 = 21000 * 86001 
1560024000 = 24000 * 65001 
1400035000 = 35000 * 40001 
... 
0:02.87, 4392 
150000300000 = 300000 * 500001 
105000210000 = 210000 * 500001 
180600210000 = 210000 * 860001 
156000240000 = 240000 * 650001 
140000350000 = 350000 * 400001 
... 
0:03.80, 4424 
15000003000000 = 3000000 * 5000001 
10500002100000 = 2100000 * 5000001 
18060002100000 = 2100000 * 8600001 
15600002400000 = 2400000 * 6500001 
14000003500000 = 3500000 * 4000001 
... 
0:08.05, 4644 
1500000030000000 = 30000000 * 50000001 
1050000021000000 = 21000000 * 50000001 
1806000021000000 = 21000000 * 86000001 
1560000024000000 = 24000000 * 65000001 
1400000035000000 = 35000000 * 40000001 
... 
0:10.45, 4500 
150000000300000000 = 300000000 * 500000001 
105000000210000000 = 210000000 * 500000001 
180600000210000000 = 210000000 * 860000001 
156000000240000000 = 240000000 * 650000001 
140000000350000000 = 350000000 * 400000001 
... 
0:11.58, 4728 
15000000003000000000 = 3000000000 * 5000000001 
10500000002100000000 = 2100000000 * 5000000001 
18060000002100000000 = 2100000000 * 8600000001 
15600000002400000000 = 2400000000 * 6500000001 
14000000003500000000 = 3500000000 * 4000000001 
... 
0:13.30, 5460 
 
--} 
3 comentarios
0votos

Escrito por josejuan hace 2 años

NOTA: en (por ejemplo) los 13 segundos indicados se están obteniendo todos los vampiros de 20 dígitos aunque ahí sólo se estén mostrando los 5 primeros.
0votos

Escrito por AverageUser hace 2 años

que significa ℤ ?
0votos

Escrito por josejuan hace 2 años

"El conjunto de todos los números enteros se representa por la letra = {..., −3, −2, −1, 0, +1, +2, +3, ...}, letra inicial del vocablo alemán Zahlen («números», pronunciado [ˈtsaːlən])." Número entero

Uso conceal para los símbolos y como casi nadie (desde hace 4 años) lanza mi código pues los pongo en las soluciones porque queda más bonito :)

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.