0votos

Números especiales en Haskell

por josejuan hace 4 años

No consigo concretar una solución elegante basada en los incrementos exponenciales. Ésta en Haskell es la misma estrategia que en C.

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
{- 
    Si Xn son el nº de nºs con 1 por debajo de 10^n e Yn los de sin 1, 
    sospecho que existe una estrategia muy sencilla que avanza exponencialmente 
    (incrementos tipo 10^n) pero no consigo concretarla; así, uso la misma 
    estrategia que la versión de C, ir incrementando dígitos. 
     
    Usámos una mónada para ir almacenando los especiales sin acarrear 
    explícitamente la salida. 
     
    Aunque no es eficiente ir trasegando dígitos como es O(log n) es rápido. 
     
    `ds` almacena los dígitos más significativos según se incrementan. 
    `ps` almacena los dígitos menos significativos ya incrementados. 
     
    `run` avanza un paso (+1) pero será exponencial en media (en `intento`). 
    `inc` incrementa los dígitos. 
-} 
import Control.Monad 
import Control.Monad.Writer 
import Data.Word 
 
x n = 10^n - 9^n 
 
digits2Number :: [Word8] -> Integer 
digits2Number [] = 0 
digits2Number (d:ds) = fromIntegral d + 10 * digits2Number ds 
 
especiales :: Int -> Writer [Integer] () 
especiales maxDigits = run [] 0 0 
    where run :: [Word8] -> Integer -> Integer -> Writer [Integer] () 
          run ps con sin = if length ps >= maxDigits then return () else inc (reverse ps) [] 0 con sin 
          inc :: [Word8] -> [Word8] -> Int -> Integer -> Integer -> Writer [Integer] () 
          inc [] ps pot con sin = inc [0] ps pot con sin 
          inc (0:ds) ps pot con sin = do 
            let con2 = con + 10^pot 
            when (con < sin && sin <= con2) 
                 (tell [digits2Number (reverse ps ++ [1] ++ ds) + sin - con - 1]) 
            let ps_ = map (const 9) ps 
                intento (_, (j, conj, sinj)) _ = let sinj_ = sinj + 10^pot - x pot 
                                                 in  (sinj_ < con2, (j + 1, conj + x pot, sinj_)) 
                (_, (j, con_, sin_)) = last $ takeWhile fst $ scanl intento (True, (1, con2, sin)) [2..9] 
            run (reverse ds ++ [j] ++ ps_) con_ sin_ 
          inc (9:ds) ps pot con sin = inc ds (0:ps) (pot + 1) con sin 
          inc (d:ds) ps 0 con sin = do 
            let ic = 9 - d 
                sin2 = sin + fromIntegral ic 
            when (sin < con && con <= sin2) 
                 (tell [digits2Number (reverse ps ++ [d] ++ ds) + con - sin]) 
            run (reverse ds ++ [9] ++ ps) con sin2 
          inc (d:ds) ps pot con sin = do 
            let sin_ = sin + 1 
            when (con == sin_) 
                 (tell [digits2Number (reverse ps ++ [d + 1] ++ ds)]) 
            run (reverse ds ++ [d + 1] ++ ps) con sin_ 
                                     
{- 
    Revisando hasta 10^23 (sin compilar) 
     
    *Main> :set +s 
    *Main> execWriter $ especiales 23 
    [2,16,24,160,270,272,1456,3398,3418,3420,3422,13120,44686,118096,674934,1062880] 
 
    (1.86 secs, 145229036 bytes) 
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.