Menu Close

Sucesión fractal

La sucesión fractal

   0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, 0, 8, 4, 9, 2, 
   10, 5, 11, 1, 12, 6, 13, 3, 14, 7, 15, ...

está construida de la siguiente forma:

  • los términos pares forman la sucesión de los números naturales
     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ...
  • los términos impares forman la misma sucesión original
     0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

   sucFractal     :: [Integer]
   sumaSucFractal :: Integer -> Integer

tales que

  • sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,
     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000
  • (sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,
     sumaSucFractal 10      ==  13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

Soluciones

-- 1ª definición de sucFractal
-- ===========================
 
sucFractal1 :: [Integer]
sucFractal1 = 
    map termino [0..]
 
-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
    | even n    = n `div` 2
    | otherwise = termino (n `div` 2)
 
-- 2ª definición de sucFractal
-- ===========================
 
sucFractal2 :: [Integer]
sucFractal2 =
    0 : 0 : mezcla [1..] (tail sucFractal2)
 
-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
    x:y:mezcla xs ys
 
-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================
 
--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)
 
-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2
 
-- 1ª definición de sumaSucFractal
-- ===============================
 
sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
    sum (map termino [0..n-1])
 
-- 2ª definición de sumaSucFractal
-- ===============================
 
sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
    sum (take (fromIntegral n) sucFractal)
 
-- 3ª definición de sumaSucFractal
-- ===============================
 
sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
    | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
    | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
    where sumaN n = (n*(n-1)) `div` 2
 
-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================
 
--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

Referencia

Avanzado

7 soluciones de “Sucesión fractal

  1. josejuan
    {-
     
        Si `p` es la posición, `x` un natural y `n` las veces que aparece es
     
             p + 1
           -------- = 2^n
            2x + 1
     
        no consigo evitar el logaritmo para reducir toda la suma a una expresión,
        sería bonito reducir el problema a O(1).
     
        Así, usando la propia definición, para una longitud `s` tenemos que la
        mitad son 1..s/2 que se suman fácil, la otra mitad, resultan ser la suma
        fractal de la mitad de la longitud, basta aplicar recursivamente ajustando
        la paridad de s.
     
        El coste de dicho algoritmo es logarítmico O(log s) al dividir por dos en
        cada paso.
     
    -}
    sucFractal :: [Integer]
    sucFractal = 0: f sucFractal [1..] where f (x:xs) (y:ys) = x: y: f xs ys
     
    sumaSucFractal  :: Integer -> Integer
    sumaSucFractal = i . subtract 1
        where i 0 = 0
              i s = let (s', r) = s `divMod` 2
                    in  (s' * (s' + 1)) `div` 2 + i  (s' - 1 + r)
     
    {-
     
    > length (show (sumaSucFractal (10^15000))) == 30000
    True
    (14.36 secs, 1,605,548,048 bytes)
    > sumaSucFractal (10^15000) `mod` (10^9)    == 455972157
    True
    (14.34 secs, 1,606,220,312 bytes)
     
    -}
    • josejuan

      Pues debe poderse encontrar una expresión, ignorando los problemas de paridad y usando la misma reducción recursiva, puede expresarse la suma como:
      imagen
      Algo como:

      sumaRec s = (1/2)**(logBase 2 s + 1) * s - s / 2  - (1/6) * (1/4)**(logBase 2 s) * s**2 + s**2 / 6

      Falta pulirla…

  2. abrdelrod

    Muy parecida a la de josejuan:

    sucFractal :: [Integer]
    sucFractal = 0:xs
       where xs = 0:trenza [1..] xs
             trenza (x:xs) (y:ys) = x:y: trenza xs ys
     
    sumaSucFractal :: Integer -> Integer
    sumaSucFractal 1 = 0
    sumaSucFractal n = div (m*(m+1)) 2 + sumaSucFractal k
          where m = if even n then k-1 else k
                k = div n 2
  3. manvermor
    -- Algunos ejemplos no los consigue calcular
    sucFractal :: [Integer]
    sucFractal = 0:0: aux 2 [1..] (tail sucFractal)
     where aux n (x:xs) (y:ys) | even n = x : aux (n+1) xs (y:ys)
                               | otherwise = y : aux (n+1) (x:xs) ys
     
    sumaSucFractal :: Integer -> Integer
    sumaSucFractal n = aux 0 sucFractal
      where aux m (x:xs) | m == n = 0
                         | otherwise = x + aux (m+1) xs
  4. fracruzam
    sucFractal :: [Integer]
    sucFractal = 0: fractal
      where fractal = 0: concat [[x,y] | (x,y) <- zip [1..] fractal]
     
    sumaSucFractal :: Integer -> Integer
    sumaSucFractal = sum . flip take sucFractal . fromIntegral
    • fracruzam

      Mejora del rendimiento

      sucFractal2 :: [Integer]
      sucFractal2 = 0: fractal
        where fractal = 0: (concat $ zipWith (x y -> [x,y]) [1..] fractal)
  5. erisan
    sucFractal :: [Integer]
    sucFractal = map fractal [0..]
     
    fractal :: (Integral a1, Num a) => a1 -> a
    fractal 0 = 0
    fractal n | even n    = (fractal (n-2)) + 1
              | otherwise = fractal (impar n)
     
    impar :: (Enum a, Enum a1, Eq a1, Num a, Num a1) => a1 -> a
    impar x = head [y | (z,y) <- zip [1,3..x] [0..], z == x]
     
    sumaSucFractal :: Integer -> Integer
    sumaSucFractal 1 = 0
    sumaSucFractal n 
        | even n    = ((z-1)*((z-1)+1)) `div` 2 + sumaSucFractal z
        | otherwise = (z*(z+1)) `div` 2 + sumaSucFractal z
        where z = div n 2

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.