0votos

Numero Persistente (con recursividad en cualquier lenguaje) en Haskell

por josejuan hace 4 años

.

Multiplicando los dígitos de un número entero y continuando el proceso nos encontramos el sorprendente resultado de que la secuencia de productos llega siempre a un número de un solo digito. 715 – 35 – 15 - 5, 88 – 64 - 24 – 8, 27 -14 -4.

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
{-# LANGUAGE BangPatterns #-} 
import Data.Char 
import Data.Vector ((!))  
import qualified Data.Vector as V 
import Data.List 
import System.Environment 
import Control.Applicative 
import Control.Monad 
import System.TimeIt 
 
-- Evidente 
reduce1 :: Integer -> Integer 
reduce1 = product . map (toInteger . digitToInt) . show 
 
-- Es lenta por los `divMod` pero rápida por el precacheado y poda, 
-- dado que el número de números que NO contienen el dígito 0 decrece 
-- exponencialmente 
reduce2 :: Integer -> Integer 
reduce2 !n | n < 10000000 = r4c!(fromIntegral n) 
           | otherwise   = if r4c!j == 0 then 0 else r4c!j * reduce2 d 
                           where (d, r) = n `divMod` 10000000 
                                 j      = fromIntegral r 
r4c :: V.Vector Integer 
r4c = V.fromList $ map reduce1 [0..9999999] 
 
 
-- Cálculo de la persistencia 
persistencia :: (Integer -> Integer) -> Integer -> Integer 
persistencia reduce = head . dropWhile (>9) . iterate reduce 
 
-- Enumeración de las persistencias 
persistencias :: (Integer -> Integer) -> Integer -> [Integer] 
persistencias reduce from = map (persistencia reduce) [from..] 
 
-- Checksum 
checkPersistencias :: Int -> (Integer -> Integer) -> Integer -> Integer 
checkPersistencias n reduce = foldl1' (+) . take n . persistencias reduce 
 
main = do 
 
    putStrLn $ "Precalculando: " ++ show (V.length r4c) 
 
    (t:d:n:_) <- map read <$> getArgs 
    let r = case t of 
             1 -> reduce1 
             _ -> reduce2 
 
    when (t /= 0) $ timeIt $ putStrLn $ "Checksum: " ++ show (checkPersistencias n r (read $ take d ['1','1'..])) 
 
{- 
 
    josejuanSolveet$ ./persistentes 1 3000 20000 
    Precalculando: 10000000 
    Checksum: 28139 
    CPU time:  29.60s 
 
    josejuanSolveet$ ./persistentes 2 3000 20000 
    Precalculando: 10000000 
    Checksum: 28139 
    CPU time:  17.63s 
 
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.