0votos

Descomposición fibonaccial en Haskell

por josejuan hace 6 años

Gracias al crecimiento exponencial de fibonacci, es posible descomponer (eg.) 10^300 en escasos milisegundos. Lo de que el problema sea fácil es otra cosa...

Descomponer un número como una suma de números de Fibonacci decrecientes y no consecutivos.

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
-- La función en cuestión es: 
fial s = f s $ bif s where f s n = if s == s' then [n] else n:(f z $ bif z) where {s' = fib n; z = s - s'} 
 
 
 
-- Que en mi caso he preferido que devuelva los ordinales en lugar de los números en sí. 
-- Por ejemplo, para 10^307 la descomposición es (en menos de 10 milisegundos sin compilar) 
[1470,1467,1465,1463,1460,1458,1455,1453,1447,1443,1437,1428,1426,1423,1421, 
1418,1416,1413,1411,1407,1405,1403,1399,1396,1394,1390,1388,1386,1377,1372, 
1363,1360,1353,1350,1347,1344,1338,1333,1328,1326,1324,1322,1318,1313,1310, 
1306,1304,1301,1299,1294,1292,1289,1285,1281,1277,1273,1269,1267,1265,1255, 
1249,1244,1241,1239,1236,1232,1229,1226,1221,1216,1213,1201,1198,1195,1193, 
1186,1184,1176,1171,1168,1166,1164,1159,1152,1150,1146,1144,1132,1129,1125, 
1121,1113,1111,1106,1101,1099,1090,1088,1085,1083,1081,1078,1076,1074,1072, 
1070,1068,1066,1063,1060,1058,1055,1052,1050,1048,1045,1043,1041,1038,1036, 
1034,1032,1028,1026,1024,1022,1018,1012,1010,1005,1002,1000,996,993,990,988, 
986,984,982,973,971,968,964,962,956,941,939,935,931,929,926,924,921,917,914, 
909,907,905,903,900,898,893,886,882,877,874,867,865,855,852,850,848,846,843, 
836,832,830,827,817,813,810,804,802,800,797,794,792,788,776,772,769,763,760, 
757,755,752,749,747,741,738,735,731,726,718,715,712,709,704,700,698,695,693, 
688,686,680,676,667,661,659,654,645,643,638,632,628,625,617,612,610,607,604, 
592,589,587,584,582,580,578,563,560,557,555,551,547,544,542,540,537,531,528, 
519,516,512,510,508,506,504,502,500,498,495,493,491,489,481,478,476,473,470, 
467,464,462,460,458,455,450,448,446,444,442,439,437,431,429,426,423,421,417, 
411,407,402,400,395,390,388,382,380,376,373,371,366,359,354,348,346,344,342, 
338,334,332,328,323,319,317,314,312,308,302,299,294,292,289,284,274,269,266, 
263,260,257,254,249,245,243,239,234,231,226,220,212,210,207,204,202,199,194, 
192,190,188,186,184,180,176,171,168,166,162,160,157,154,151,149,146,143,140, 
137,135,133,131,129,126,124,120,115,109,105,102,100,98,92,90,85,82,78,76,73, 
70,67,63,61,56,53,49,45,38,34,32,30,27,24,22,17,13,10,6,4,2] 
 
--=============================================================== 
-- El código completo: 
 
-- raíz de 5 
s5 :: Double 
s5 = sqrt 5 
 
-- número aureo 
gold :: Double 
gold = (1 + s5) / 2 
 
-- fibonacci 
fib :: Int -> Integer 
fib = (map f [0 ..] !!) 
   where f 0 = 0 
         f 1 = 1 
         f n = fib (n-2) + fib (n-1) 
 
-- la inversa de fibonacci 
-- aunque haya pérdida de precisión, siempre devolverá una cota inferior 
bif :: Integer -> Int 
bif f = fromIntegral $ floor (logBase gold ((fromIntegral f) * s5 + 1/2)) 
 
-- dado un número, devuelve los índices (no consecutivos y no repetidos) de los fibonaccis que sumados, dan ese número 
fial :: Integer -> [Int] 
fial s = f s $ bif s where f s n = if s == s' then [n] else n:(f z $ bif z) where {s' = fib n; z = s - s'} 
 
-- para usar con QuickCheck 
check :: Integer -> Bool 
check n = all (1/=) $ zipWith (-) (0:l) l where l = fial $ if n <= 0 then 1 - n else n 
 
-- si se quieren ver los fibonaccis en lugar de los índices 
verFibs :: [Int] -> [Integer] 
verFibs = map fib 
 
-- simple entrada por consola 
main = do 
    l <- getLine 
    print $ fial $ read l 
    main 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.