Orden superior

Número medio

PorJosé A. Alonso 24-julio-201826-marzo-2022

Un número medio es número natural que es igual a la media aritmética de las permutaciones de sus dígitos. Por ejemplo, 370 es un número medio ya que las permutaciones de sus dígitos es 073, 037, 307, 370, 703 y 730 cuya media es 2220/6 que es igual a 370.

Definir las siguientes funciones

   numeroMedio                :: Integer -> Bool
   densidadesNumeroMedio      :: [Double]
   graficaDensidadNumeroMedio :: Int -> IO ()

numeroMedio :: Integer -> Bool

densidadesNumeroMedio :: [Double]

graficaDensidadNumeroMedio :: Int -> IO ()

tales que

(numeroMedio n) se verifica si n es un número medio. Por ejemplo,

      λ> numeroMedio 370
      True
      λ> numeroMedio 371
      False
      λ> numeroMedio 485596707818930041152263374
      True
      λ> filter numeroMedio [100..600]
      [111,222,333,370,407,444,481,518,555,592]
      λ> filter numeroMedio [3*10^5..6*10^5]
      [333333,370370,407407,444444,481481,518518,555555,592592]

λ> numeroMedio 370

True

λ> numeroMedio 371

False

λ> numeroMedio 485596707818930041152263374

True

λ> filter numeroMedio [100..600]

[111,222,333,370,407,444,481,518,555,592]

λ> filter numeroMedio [3*10^5..6*10^5]

[333333,370370,407407,444444,481481,518518,555555,592592]

densidades es la lista cuyo elemento n-ésimo (empezando a contar en 1) es la densidad de números medios en el intervalo [1,n]; es decir, la cantidad de números medios menores o iguales que n dividida por n. Por ejemplo,

      λ> mapM_ print (take 30 densidades)
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      1.0
      0.9
      0.9090909090909091
      0.8333333333333334
      0.7692307692307693
      0.7142857142857143
      0.6666666666666666
      0.625
      0.5882352941176471
      0.5555555555555556
      0.5263157894736842
      0.5
      0.47619047619047616
      0.5
      0.4782608695652174
      0.4583333333333333
      0.44
      0.4230769230769231
      0.4074074074074074
      0.39285714285714285
      0.3793103448275862
      0.36666666666666664

λ> mapM_ print (take 30 densidades)

1.0

0.9

0.9090909090909091

0.8333333333333334

0.7692307692307693

0.7142857142857143

0.6666666666666666

0.625

0.5882352941176471

0.5555555555555556

0.5263157894736842

0.5

0.47619047619047616

0.5

0.4782608695652174

0.4583333333333333

0.44

0.4230769230769231

0.4074074074074074

0.39285714285714285

0.3793103448275862

0.36666666666666664

(graficaDensidadNumeroMedio n) dibuja la gráfica de las densidades de
los intervalos [1,k] para k desde 1 hasta n. Por ejemplo, (graficaDensidadNumeroMedio 100) dibuja

y (graficaDensidadNumeroMedio 1000) dibuja

Soluciones

Puedes escribir tus soluciones en los comentarios o ver las soluciones propuestas pulsando [expand title=»aquí»]

import Data.List (genericLength, permutations, foldl')
import Test.QuickCheck
import Graphics.Gnuplot.Simple 

-- 1ª definición de numeroMedio
-- ============================

numeroMedio :: Integer -> Bool
numeroMedio n =
  n == media (map digitosAnumero (permutations (digitos n)))

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 425  ==  [4,2,5]
digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo, 
--    digitosAnumero [4,2,5]  ==  425

-- 1ª definición de digitosAnumero
digitosAnumero1 :: [Integer] -> Integer
digitosAnumero1 = aux . reverse
  where aux [] = 0
        aux (x:xs) = x + 10 * aux xs

-- 1ª definición de digitosAnumero
digitosAnumero2 :: [Integer] -> Integer
digitosAnumero2 = foldl' (\x y -> 10*x+y) 0

-- Comparación de eficiencia de definiciones de digitosAnumero
--    λ> length (show (digitosAnumero1 (replicate (10^5) 5)))
--    100000
--    (5.07 secs, 4,317,349,968 bytes)
--    λ> length (show (digitosAnumero2 (replicate (10^5) 5)))
--    100000
--    (0.67 secs, 4,288,054,592 bytes)

-- Se usará la 2ª definición de digitosAnumero
digitosAnumero :: [Integer] -> Integer
digitosAnumero = digitosAnumero2

-- (media xs) es la media aritmética de la lista xs (se supone que su
-- valor es entero). Por ejemplo,
--    media [370,730,73,703,37,307]  ==  370
media :: [Integer] -> Integer
media xs = sum xs `div` genericLength xs

-- 2ª definición de numeroMedio
-- ============================

numeroMedio2 :: Integer -> Bool
numeroMedio2 n =
  (10^k-1)*s == 9*k*n
  where xs = digitos n
        k  = genericLength xs
        s  = sum xs

-- Equivalencia de las definiciones de numeroMedio
-- ===============================================

-- La propiedad es
prop_numeroMedio :: Positive Integer -> Bool
prop_numeroMedio (Positive n) =
  numeroMedio n == numeroMedio2 n

-- La comprobación es
--    λ> quickCheck prop_numeroMedio
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia de las definiciones de numeroMedio
-- ============================================================

--    λ> filter numeroMedio [10000..20000]
--    [11111]
--    (1.74 secs, 1,500,858,904 bytes)
--    λ> filter numeroMedio2 [10000..20000]
--    [11111]
--    (0.11 secs, 213,060,784 bytes)

-- Definición de densidadesNumeroMedio
-- ===================================

densidadesNumeroMedio :: [Double]
densidadesNumeroMedio = 
  [genericLength (filter numeroMedio2 [1..n]) / fromIntegral n | n <- [1..]]

-- Definición de graficaDensidadNumeroMedio
-- ========================================

graficaDensidadNumeroMedio :: Int -> IO ()
graficaDensidadNumeroMedio n =
  plotList [ Title ("graficaDensidadNumeroMedio")
           , Key Nothing
           -- , PNG ("Numero_medio_" ++ show n ++ ".png" )
           , XRange (1, fromIntegral n)]
           (take n densidadesNumeroMedio)

import Data.List (genericLength, permutations, foldl')

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de numeroMedio

-- ============================

numeroMedio :: Integer -> Bool

numeroMedio n =

n == media (map digitosAnumero (permutations (digitos n)))

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 425 == [4,2,5]

digitos :: Integer -> [Integer]

digitos n =

[read [c] | c <- show n]

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por

-- ejemplo,

-- digitosAnumero [4,2,5] == 425

-- 1ª definición de digitosAnumero

digitosAnumero1 :: [Integer] -> Integer

digitosAnumero1 = aux . reverse

where aux [] = 0

aux (x:xs) = x + 10 * aux xs

-- 1ª definición de digitosAnumero

digitosAnumero2 :: [Integer] -> Integer

digitosAnumero2 = foldl' (\x y -> 10*x+y) 0

-- Comparación de eficiencia de definiciones de digitosAnumero

-- λ> length (show (digitosAnumero1 (replicate (10^5) 5)))

-- 100000

-- (5.07 secs, 4,317,349,968 bytes)

-- λ> length (show (digitosAnumero2 (replicate (10^5) 5)))

-- 100000

-- (0.67 secs, 4,288,054,592 bytes)

-- Se usará la 2ª definición de digitosAnumero

digitosAnumero :: [Integer] -> Integer

digitosAnumero = digitosAnumero2

-- (media xs) es la media aritmética de la lista xs (se supone que su

-- valor es entero). Por ejemplo,

-- media [370,730,73,703,37,307] == 370

media :: [Integer] -> Integer

media xs = sum xs `div` genericLength xs

-- 2ª definición de numeroMedio

-- ============================

numeroMedio2 :: Integer -> Bool

numeroMedio2 n =

(10^k-1)*s == 9*k*n

where xs = digitos n

k = genericLength xs

s = sum xs

-- Equivalencia de las definiciones de numeroMedio

-- ===============================================

-- La propiedad es

prop_numeroMedio :: Positive Integer -> Bool

prop_numeroMedio (Positive n) =

numeroMedio n == numeroMedio2 n

-- La comprobación es

-- λ> quickCheck prop_numeroMedio

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de las definiciones de numeroMedio

-- ============================================================

-- λ> filter numeroMedio [10000..20000]

-- [11111]

-- (1.74 secs, 1,500,858,904 bytes)

-- λ> filter numeroMedio2 [10000..20000]

-- [11111]

-- (0.11 secs, 213,060,784 bytes)

-- Definición de densidadesNumeroMedio

-- ===================================

densidadesNumeroMedio :: [Double]

densidadesNumeroMedio =

[genericLength (filter numeroMedio2 [1..n]) / fromIntegral n | n <- [1..]]

-- Definición de graficaDensidadNumeroMedio

-- ========================================

graficaDensidadNumeroMedio :: Int -> IO ()

graficaDensidadNumeroMedio n =

plotList [ Title ("graficaDensidadNumeroMedio")

, Key Nothing

-- , PNG ("Numero_medio_" ++ show n ++ ".png" )

, XRange (1, fromIntegral n)]

(take n densidadesNumeroMedio)

[/expand]

Tren de potencias

PorJosé A. Alonso 23-julio-201824-julio-2018

Si n es el número natural cuya expansión decimal es abc… , el tren de potencias de n es a^bc^d… donde el último exponente es 1, si n tiene un número impar de dígitos. Por ejemplo

   trenDePotencias 2453  = 2^4*5^3     = 2000
   trenDePotencias 24536 = 2^4*5^3*6^1 = 12000

1 2	trenDePotencias 2453 = 2^45^3 = 2000 trenDePotencias 24536 = 2^45^3*6^1 = 12000

Definir las funciones

   trenDePotencias            :: Integer -> Integer
   esPuntoFijoTrenDePotencias :: Integer -> Bool
   puntosFijosTrenDePotencias :: [Integer]
   tablaTrenDePotencias       :: Integer -> Integer -> IO ()

trenDePotencias :: Integer -> Integer

esPuntoFijoTrenDePotencias :: Integer -> Bool

puntosFijosTrenDePotencias :: [Integer]

tablaTrenDePotencias :: Integer -> Integer -> IO ()

tales que

(trenDePotencias n) es el tren de potencia de n. Por ejemplo.

     trenDePotencias 20   ==  1
     trenDePotencias 21   ==  2
     trenDePotencias 24   ==  16
     trenDePotencias 39   ==  19683
     trenDePotencias 623  ==  108

trenDePotencias 20 == 1

trenDePotencias 21 == 2

trenDePotencias 24 == 16

trenDePotencias 39 == 19683

trenDePotencias 623 == 108

(esPuntoFijoTrenDePotencias n) se verifica si n es un punto fijo de trenDePotencias; es decir, (trenDePotencias n) es igual a n. Por ejemplo,

     esPuntoFijoTrenDePotencias 2592                        ==  True
     esPuntoFijoTrenDePotencias 24547284284866560000000000  ==  True

1 2	esPuntoFijoTrenDePotencias 2592 == True esPuntoFijoTrenDePotencias 24547284284866560000000000 == True

puntosFijosTrenDePotencias es la lista de los puntso fijos de trenDePotencias. Por ejemplo,

     take 10 puntosFijosTrenDePotencias  ==  [1,2,3,4,5,6,7,8,9,2592]

1	take 10 puntosFijosTrenDePotencias == [1,2,3,4,5,6,7,8,9,2592]

(tablaTrenDePotencias a b) es la tabla de los trenes de potencias de los números entre a y b. Por ejemplo,

     λ> tablaTrenDePotencias 20 39
     | 20 |     1 |
     | 21 |     2 |
     | 22 |     4 |
     | 23 |     8 |
     | 24 |    16 |
     | 25 |    32 |
     | 26 |    64 |
     | 27 |   128 |
     | 28 |   256 |
     | 29 |   512 |
     | 30 |     1 |
     | 31 |     3 |
     | 32 |     9 |
     | 33 |    27 |
     | 34 |    81 |
     | 35 |   243 |
     | 36 |   729 |
     | 37 |  2187 |
     | 38 |  6561 |
     | 39 | 19683 |
     λ> tablaTrenDePotencias 2340 2359
     | 2340 |        8 |
     | 2341 |       32 |
     | 2342 |      128 |
     | 2343 |      512 |
     | 2344 |     2048 |
     | 2345 |     8192 |
     | 2346 |    32768 |
     | 2347 |   131072 |
     | 2348 |   524288 |
     | 2349 |  2097152 |
     | 2350 |        8 |
     | 2351 |       40 |
     | 2352 |      200 |
     | 2353 |     1000 |
     | 2354 |     5000 |
     | 2355 |    25000 |
     | 2356 |   125000 |
     | 2357 |   625000 |
     | 2358 |  3125000 |
     | 2359 | 15625000 |

λ> tablaTrenDePotencias 20 39

| 20 | 1 |

| 21 | 2 |

| 22 | 4 |

| 23 | 8 |

| 24 | 16 |

| 25 | 32 |

| 26 | 64 |

| 27 | 128 |

| 28 | 256 |

| 29 | 512 |

| 30 | 1 |

| 31 | 3 |

| 32 | 9 |

| 33 | 27 |

| 34 | 81 |

| 35 | 243 |

| 36 | 729 |

| 37 | 2187 |

| 38 | 6561 |

| 39 | 19683 |

λ> tablaTrenDePotencias 2340 2359

| 2340 | 8 |

| 2341 | 32 |

| 2342 | 128 |

| 2343 | 512 |

| 2344 | 2048 |

| 2345 | 8192 |

| 2346 | 32768 |

| 2347 | 131072 |

| 2348 | 524288 |

| 2349 | 2097152 |

| 2350 | 8 |

| 2351 | 40 |

| 2352 | 200 |

| 2353 | 1000 |

| 2354 | 5000 |

| 2355 | 25000 |

| 2356 | 125000 |

| 2357 | 625000 |

| 2358 | 3125000 |

| 2359 | 15625000 |

Comprobar con QuickCheck que entre 2593 y 24547284284866559999999999 la función trenDePotencias no tiene puntos fijos.

Soluciones

Puedes escribir tus soluciones en los comentarios o ver las soluciones propuestas pulsando [expand title=»aquí»]

import Test.QuickCheck
import Text.Printf

-- 1ª definición de trenDePotencias
-- ================================

trenDePotencias :: Integer -> Integer
trenDePotencias = trenDePotenciasLN . digitos

-- (digitos n) es la lista de los dígitos del número n. Por ejemplo,
--    digitos 2018  ==   [2,0,1,8]
digitos :: Integer -> [Integer]
digitos n =
  [read [c] | c <- show n]

-- (trenDePotenciasLN xs) es el tren de potencias de la lista de números
-- xs. Por ejemplo,
--    trenDePotenciasLN [2,4,5,3]    ==   2000
--    trenDePotenciasLN [2,4,5,3,6]  ==   12000
trenDePotenciasLN :: [Integer] -> Integer
trenDePotenciasLN []       = 1
trenDePotenciasLN [x]      = x
trenDePotenciasLN (u:v:ws) = u ^ v * (trenDePotenciasLN ws) 

-- 2ª definición de trenDePotencias
-- ================================

trenDePotencias2 :: Integer -> Integer
trenDePotencias2 = trenDePotenciasLN2 . digitos

-- (trenDePotenciasLN2 xs) es el tren de potencias de la lista de números
-- xs. Por ejemplo,
--    trenDePotenciasLN2 [2,4,5,3]    ==   2000
--    trenDePotenciasLN2 [2,4,5,3,6]  ==   12000
trenDePotenciasLN2 :: [Integer] -> Integer
trenDePotenciasLN2 xs =
  product [x^y | (x,y) <- pares xs]

-- (pares xs) es la lista de los pares de elementos en la posiciones
-- pares y sus siguientes; si la longitud de xs es impar, la segunda
-- componente del último par es 1. Por ejemplo,
--    pares [2,4,5,3]    ==   [(2,4),(5,3)]
--    pares [2,4,5,3,6]  ==   [(2,4),(5,3),(6,1)]
pares :: [Integer] -> [(Integer,Integer)]
pares []       = []
pares [x]      = [(x,1)]
pares (x:y:zs) = (x,y) : pares zs

-- Equivalencia
-- ============

-- La propiedad es
prop_equivalencia :: (Positive Integer) -> Bool
prop_equivalencia (Positive n) =
  trenDePotencias n == trenDePotencias2 n

-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia
-- =========================

--    λ> let n = 2*10^5 in trenDePotencias (read (replicate n '2')) == 2^n
--    True
--    (2.11 secs, 2,224,301,136 bytes)
--    λ> let n = 2*10^5 in trenDePotencias2 (read (replicate n '2')) == 2^n
--    True
--    (2.08 secs, 2,237,749,216 bytes)

-- Definición de esPuntoFijoTrenDePotencias
-- ========================================

esPuntoFijoTrenDePotencias :: Integer -> Bool
esPuntoFijoTrenDePotencias n =
  trenDePotencias n == n

-- Definición de puntosFijosTrenDePotencias
-- ========================================

puntosFijosTrenDePotencias :: [Integer]
puntosFijosTrenDePotencias =
  filter esPuntoFijoTrenDePotencias [1..]

-- Definición de tablaTrenDePotencias
-- ==================================

tablaTrenDePotencias :: Integer -> Integer -> IO ()
tablaTrenDePotencias a b =
  sequence_ [printf cabecera x y | (x,y) <- trenes]
  where trenes  = [(n,trenDePotencias n) | n <- [a..b]]
        m1      = show (1 + length (show b))
        m2      = show (length (show (maximum (map snd trenes))))
        cabecera = concat ["|% ",m1,"d | %", m2,"d |\n"]

-- Comprobación
-- ============

-- La propiedad es
prop_puntosFijos :: Positive Integer -> Property
prop_puntosFijos (Positive n) =
  x < 24547284284866560000000000 ==> not (esPuntoFijoTrenDePotencias x)
  where x = 2593 + n 

-- La comprobación es
--    λ> quickCheck prop_puntosFijos
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

import Test.QuickCheck

import Text.Printf

-- 1ª definición de trenDePotencias

-- ================================

trenDePotencias :: Integer -> Integer

trenDePotencias = trenDePotenciasLN . digitos

-- (digitos n) es la lista de los dígitos del número n. Por ejemplo,

-- digitos 2018 == [2,0,1,8]

digitos :: Integer -> [Integer]

digitos n =

[read [c] | c <- show n]

-- (trenDePotenciasLN xs) es el tren de potencias de la lista de números

-- xs. Por ejemplo,

-- trenDePotenciasLN [2,4,5,3] == 2000

-- trenDePotenciasLN [2,4,5,3,6] == 12000

trenDePotenciasLN :: [Integer] -> Integer

trenDePotenciasLN [] = 1

trenDePotenciasLN [x] = x

trenDePotenciasLN (u:v:ws) = u ^ v * (trenDePotenciasLN ws)

-- 2ª definición de trenDePotencias

-- ================================

trenDePotencias2 :: Integer -> Integer

trenDePotencias2 = trenDePotenciasLN2 . digitos

-- (trenDePotenciasLN2 xs) es el tren de potencias de la lista de números

-- xs. Por ejemplo,

-- trenDePotenciasLN2 [2,4,5,3] == 2000

-- trenDePotenciasLN2 [2,4,5,3,6] == 12000

trenDePotenciasLN2 :: [Integer] -> Integer

trenDePotenciasLN2 xs =

product [x^y | (x,y) <- pares xs]

-- (pares xs) es la lista de los pares de elementos en la posiciones

-- pares y sus siguientes; si la longitud de xs es impar, la segunda

-- componente del último par es 1. Por ejemplo,

-- pares [2,4,5,3] == [(2,4),(5,3)]

-- pares [2,4,5,3,6] == [(2,4),(5,3),(6,1)]

pares :: [Integer] -> [(Integer,Integer)]

pares [] = []

pares [x] = [(x,1)]

pares (x:y:zs) = (x,y) : pares zs

-- Equivalencia

-- ============

-- La propiedad es

prop_equivalencia :: (Positive Integer) -> Bool

prop_equivalencia (Positive n) =

trenDePotencias n == trenDePotencias2 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- λ> let n = 2*10^5 in trenDePotencias (read (replicate n '2')) == 2^n

-- True

-- (2.11 secs, 2,224,301,136 bytes)

-- λ> let n = 2*10^5 in trenDePotencias2 (read (replicate n '2')) == 2^n

-- True

-- (2.08 secs, 2,237,749,216 bytes)

-- Definición de esPuntoFijoTrenDePotencias

-- ========================================

esPuntoFijoTrenDePotencias :: Integer -> Bool

esPuntoFijoTrenDePotencias n =

trenDePotencias n == n

-- Definición de puntosFijosTrenDePotencias

-- ========================================

puntosFijosTrenDePotencias :: [Integer]

puntosFijosTrenDePotencias =

filter esPuntoFijoTrenDePotencias [1..]

-- Definición de tablaTrenDePotencias

-- ==================================

tablaTrenDePotencias :: Integer -> Integer -> IO ()

tablaTrenDePotencias a b =

sequence_ [printf cabecera x y | (x,y) <- trenes]

where trenes = [(n,trenDePotencias n) | n <- [a..b]]

m1 = show (1 + length (show b))

m2 = show (length (show (maximum (map snd trenes))))

cabecera = concat ["|% ",m1,"d | %", m2,"d |\n"]

-- Comprobación

-- ============

-- La propiedad es

prop_puntosFijos :: Positive Integer -> Property

prop_puntosFijos (Positive n) =

x < 24547284284866560000000000 ==> not (esPuntoFijoTrenDePotencias x)

where x = 2593 + n

-- La comprobación es

-- λ> quickCheck prop_puntosFijos

-- +++ OK, passed 100 tests.

[/expand]

Sucesión fractal

PorJosé A. Alonso 12-junio-201825-abril-2021

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, ...

1 2	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, ...

1	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, ...

1	0, 0, 1, 0, 2, 1, 3, 0, 4, 2, 5, 1, 6, 3, 7, ...

Definir las funciones

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

1 2	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

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

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

[schedule expon=’2018-06-19′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 17 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2018-06-19′ at=»06:00″]

-- 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)

-- 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

+ [Fractal sequences and restricted Nim](http://bit.ly/1WX1IjB) por Lionel Levine.
[/schedule]

La regla de los signos de Descartes

PorJosé A. Alonso 30-mayo-20186-junio-2018

Los polinomios pueden representarse mediante listas. Por ejemplo, el polinomio x^5+3x^4-5x^2+x-7 se representa por [1,3,0,-5,1,-7]. En dicha lista, obviando el cero, se producen tres cambios de signo: del 3 al -5, del -5 al 1 y del 1 al -7. Llamando C(p) al número de cambios de signo en la lista de coeficientes del polinomio p(x), tendríamos entonces que en este caso C(p)=3.

La regla de los signos de Descartes dice que el número de raíces reales positivas de una ecuación polinómica con coeficientes reales igualada a cero es, como mucho, igual al número de cambios de signo que se produzcan entre sus coeficientes (obviando los ceros). Por ejemplo, en el caso anterior la ecuación tendría como mucho tres soluciones reales positivas, ya que C(p)=3.

Además, si la cota C(p) no se alcanza, entonces el número de raíces positivas de la ecuación difiere de ella un múltiplo de dos. En el ejemplo anterior esto significa que la ecuación puede tener tres raíces positivas o tener solamente una, pero no podría ocurrir que tuviera dos o que no tuviera ninguna.

Definir las funciones

   cambios :: [Int] -> [(Int,Int)]
   nRaicesPositivas :: [Int] -> [Int]

1 2	cambios :: [Int] -> [(Int,Int)] nRaicesPositivas :: [Int] -> [Int]

tales que

(cambios xs) es la lista de los pares de elementos de xs con signos distintos, obviando los ceros. Por ejemplo,

     cambios [1,3,0,-5,1,-7]  ==  [(3,-5),(-5,1),(1,-7)]

1	cambios [1,3,0,-5,1,-7] == [(3,-5),(-5,1),(1,-7)]

(nRaicesPositivas p) es la lista de los posibles números de raíces positivas del polinomio p (representado mediante una lista) según la regla de los signos de Descartes. Por ejemplo,

     nRaicesPositivas [1,3,0,-5,1,-7]  ==  [3,1]

1	nRaicesPositivas [1,3,0,-5,1,-7] == [3,1]

que significa que la ecuación x^5+3x^4-5x^2+x-7=0 puede tener 3 ó 1 raíz positiva.

Soluciones

-- 1ª definición (por comprensión)
-- ===============================

cambios1 :: [Int] -> [(Int,Int)]
cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]
  where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero. 
-- Por ejemplo,  
--    noCeros [1,3,0,-5,1,-7]  ==  [1,3,-5,1,-7]
noCeros :: [Int] -> [Int]
noCeros = filter (/=0)

-- 2ª definición (por recursión)
-- =============================

cambios2 :: [Int] -> [(Int,Int)]
cambios2 xs = cambios2' (noCeros xs)
  where cambios2' (x:y:xs)
          | x*y < 0   = (x,y) : cambios2' (y:xs)
          | otherwise = cambios2' (y:xs)
        cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]
nRaicesPositivas xs = [n,n-2..0]
  where n = length (cambios1 xs)

-- 1ª definición (por comprensión)

-- ===============================

cambios1 :: [Int] -> [(Int,Int)]

cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]

where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero.

-- Por ejemplo,

-- noCeros [1,3,0,-5,1,-7] == [1,3,-5,1,-7]

noCeros :: [Int] -> [Int]

noCeros = filter (/=0)

-- 2ª definición (por recursión)

-- =============================

cambios2 :: [Int] -> [(Int,Int)]

cambios2 xs = cambios2' (noCeros xs)

where cambios2' (x:y:xs)

| x*y < 0 = (x,y) : cambios2' (y:xs)

| otherwise = cambios2' (y:xs)

cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]

nRaicesPositivas xs = [n,n-2..0]

where n = length (cambios1 xs)

Números taxicab

PorJosé A. Alonso 29-mayo-20185-junio-2018

Los números taxicab, taxi-cab o números de Hardy-Ramanujan son aquellos números naturales que pueden expresarse como suma de dos cubos de más de una forma.

Alternativamente, se define al n-ésimo número taxicab como el menor número que es suma de dos cubos de n formas.

Definir las siguientes sucesiones

   taxicab  :: [Integer]
   taxicab2 :: [Integer]

1 2	taxicab :: [Integer] taxicab2 :: [Integer]

tales que taxicab es la sucesión de estos números según la primera definición y taxicab2 según la segunda. Por ejemplo,

   take 5 taxicab   ==  [1729,4104,13832,20683,32832]
   take 2 taxicab2  ==  [2,1729]

1 2	take 5 taxicab == [1729,4104,13832,20683,32832] take 2 taxicab2 == [2,1729]

Nota 1. La sucesiones taxicab y taxicab2 se corresponden con las sucesiones A001235 y A011541 de la OEIS.

Nota 2: Este ejercicio ha sido propuesto por Ángel Ruiz Campos.

Soluciones

import Data.List  (find)
import Data.Maybe (fromJust)

taxicab :: [Integer]
taxicab = filter ((> 1) . length . descomposiciones) [1..]

-- (descomposiciones n) es la lista de pares (x,y) tal que x³ + y³ = n.
-- Por ejemplo,
--    descomposiciones 1729  ==  [(10,9),(12,1)]
--    descomposiciones 1728  ==  [(12,0)]
descomposiciones :: Integer -> [(Integer,Integer)]
descomposiciones n =
  [(x,y) | x <- [1..round (fromIntegral n ** (1/3))],
           let z = n - x^3,
           let z' = round (fromIntegral z ** (1/3)),
           z'^3 == z,
           let y = z',
           y <= x]

-- 2ª definición de descomposiciones
descomposiciones2 :: Integer -> [(Integer,Integer)]
descomposiciones2 n =
  [(x,y) | x <- [1..raizEnt n 3],
           let z = n - x^3,
           let y = raizEnt z 3,
           y <= x,    
           y^3 == z]

-- (raizEnt x n) es la raíz entera n-ésima de x; es decir, el mayor
-- número entero y tal que y^n <= x. Por ejemplo, 
--    raizEnt  8 3      ==  2
--    raizEnt  9 3      ==  2
--    raizEnt 26 3      ==  2
--    raizEnt 27 3      ==  3
--    raizEnt (10^50) 2 ==  10000000000000000000000000
-- ---------------------------------------------------------------------

raizEnt :: Integer -> Integer -> Integer
raizEnt x n = aux (1,x)
  where aux (a,b) | d == x    = c
                  | c == a    = c
                  | d < x     = aux (c,b)
                  | otherwise = aux (a,c) 
          where c = (a+b) `div` 2
                d = c^n

taxicab2 :: [Integer]
taxicab2 = aux 1 [2..]
  where aux n xs = fx : aux (n+1) [fx+1..]
          where fx = fromJust (find ((== n) . length . descomposiciones) xs)

import Data.List (find)

import Data.Maybe (fromJust)

taxicab :: [Integer]

taxicab = filter ((> 1) . length . descomposiciones) [1..]

-- (descomposiciones n) es la lista de pares (x,y) tal que x³ + y³ = n.

-- Por ejemplo,

-- descomposiciones 1729 == [(10,9),(12,1)]

-- descomposiciones 1728 == [(12,0)]

descomposiciones :: Integer -> [(Integer,Integer)]

descomposiciones n =

[(x,y) | x <- [1..round (fromIntegral n ** (1/3))],

let z = n - x^3,

let z' = round (fromIntegral z ** (1/3)),

z'^3 == z,

let y = z',

y <= x]

-- 2ª definición de descomposiciones

descomposiciones2 :: Integer -> [(Integer,Integer)]

descomposiciones2 n =

[(x,y) | x <- [1..raizEnt n 3],

let z = n - x^3,

let y = raizEnt z 3,

y <= x,

y^3 == z]

-- (raizEnt x n) es la raíz entera n-ésima de x; es decir, el mayor

-- número entero y tal que y^n <= x. Por ejemplo,

-- raizEnt 8 3 == 2

-- raizEnt 9 3 == 2

-- raizEnt 26 3 == 2

-- raizEnt 27 3 == 3

-- raizEnt (10^50) 2 == 10000000000000000000000000

-- ---------------------------------------------------------------------

raizEnt :: Integer -> Integer -> Integer

raizEnt x n = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^n

taxicab2 :: [Integer]

taxicab2 = aux 1 [2..]

where aux n xs = fx : aux (n+1) [fx+1..]

where fx = fromJust (find ((== n) . length . descomposiciones) xs)

Número medio

Soluciones

Tren de potencias

Soluciones

Sucesión fractal

Soluciones

Referencia

La regla de los signos de Descartes

Soluciones

Números taxicab

Soluciones

Entradas recientes

Buscar

Correo electrónico