0votos

Números especiales en Haskell

por josejuan hace 4 años

Una elegante (o todo lo elegante que yo he podido, claro).

Un número es especial cuando el número de números mayores que 1 y menores o iguales a él mismo que contienen algún dígito con uno es el mismo que aquellos que no contienen ningún dígito 1.

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
import Data.List (sort) 
 
-- con y sin bajo potencias de 10 
x n = 10^n - 9^n 
y n =  9^n - 1 
 
-- con y sin bajo un dígito por una potencia de 10 (ej. bajo 40000) 
s 0 p = x p 
s d p = d * x p + 10^p 
t d p = (d + 1) * 10^p - 1 - s d p 
 
-- los que empiezan por uno son fáciles, porque crecen linealmente en su potencia 
especialesEmpezandoEn1 maxPotencia = 
    [ 10^(p - 1) + sinA - conA - 1 | p <- [1..maxPotencia] 
        , let conA = x (p - 1)        -- antes de empezar todos los 1 
              sinA = y (p - 1) 
              conB = x p              -- al terminar todos los 1 de la potencia 
        , conA < sinA && sinA <= conB -- si hay salto 
 
-- dígito y potencia candidata sobre la que se produce un posible corte 
--      similar al anterior, pero recursivamente en base a un conteo de potencia previa 
candidatos n baseCon baseSin maxPotencia = 
    [(n + d * 10^p, conA, sinA + 1, p) 
            | d <- [2..9], p <- [0..maxPotencia] 
            , let conA = baseCon + s (d - 1) p 
                  sinA = baseSin + t (d - 1) p 
                  conB = baseCon + s  d      p 
                  sinB = baseSin + t  d      p 
            , (conA < sinA && sinA <= conB) || 
              (sinA < conA && conA <= sinB) 
 
-- recursivamente todas las expansiones candidatas 
todosCandidatos n c s 0 = candidatos n c s 0 
todosCandidatos n c s p = 
    let cs = candidatos n c s p 
    in  cs ++ concat [ todosCandidatos n c s (p - 1) | (n, c, s, p) <- cs ] 
 
-- especiales que no empiezan en 1, hay de dos tipos 
especialesEmpezandoEnOtro p = 
    let cs = todosCandidatos 0 0 0 p 
    in  -- aquellos que *no* contienen el 1 
        [n | (n, c, s, _) <- cs, c == s] ++ 
        -- aquellos que *si* contienen el 1 
        [n + z1 + z2 | (n, c, s, p) <- cs, p > 0 
                        , let c' = c + x (p - 1)  -- si tenemos 550000 subimos a 550999 (revisaremos el 1 siguiente) 
                              s' = s + y (p - 1) 
                              z1 = 10^(p - 1) - 1 -- vamos de 550000 a 550999 ¿cuantos 1 faltan? 
                              z2 = s' - c' 
                        , 0 < z2 && z2 < 10^(p - 1)] 
                         
-- juntamos los especiales revisando hasta la potencia `p` 
especiales p = sort $ especialesEmpezandoEn1 p ++ especialesEmpezandoEnOtro p 
 
{- 
 
    Revisando que no haya especiales hasta 10^100 (aunque sabemos que no hay encima de 10^23) 
 
    *Main> :set +s 
    *Main> especiales 100 
    [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880] 
 
    (0.14 secs, 16507344 bytes) 
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.