iterate – Página 2

Máximo de las rotaciones restringidas

PorJosé A. Alonso 6-diciembre-201713-diciembre-2017

Rotar un número a la iquierda significa pasar su primer dígito al final. Por ejemplo, rotando a la izquierda el 56789 se obtiene 67895.

Las rotaciones restringidas del número 56789 se obtienen como se indica a continución:

Se inicia con el propio número: 56789
El anterior se rota a la izquierda y se obtiene el 67895.
Del anterior se fija el primer dígito y se rota a la iquierda los otros. Se obtiene 68957.
Del anterior se fijan los 2 primeros dígito y se rota a la iquierda los otros. Se obtiene 68579.
Del anterior se fijan los 3 primeros dígito y se rota a la iquierda los otros. Se obtiene 68597.

El proceso ha terminado ya que conservando los cuatro primeros queda sólo un dígito que al girar es él mismo. Por tanto, la sucesión de las rotaciones restringidas de 56789 es

   56789 -> 67895 -> 68957 -> 68579 -> 68597

1	56789 -> 67895 -> 68957 -> 68579 -> 68597

y su mayor elemento es 68957.

Definir la función

   maxRotaciones :: Integer -> Integer

1	maxRotaciones :: Integer -> Integer

tal que (maxRotaciones n) es el máximo de las rotaciones restringidas del número n. Por ejemplo,

   maxRotaciones 56789       ==  68957
   maxRotaciones 1347902468  ==  3790246814
   maxRotaciones 6           ==  6
   maxRotaciones 2017        ==  2017

maxRotaciones 56789 == 68957

maxRotaciones 1347902468 == 3790246814

maxRotaciones 6 == 6

maxRotaciones 2017 == 2017

Soluciones

-- 1ª solución
-- ===========

maxRotaciones :: Integer -> Integer
maxRotaciones = read . aux . show
  where aux n@[_]        = n
        aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

-- 2ª solución
-- ===========

maxRotaciones2 :: Integer -> Integer
maxRotaciones2 n
  | n < 10    = n
  | otherwise = maximum [ read (us ++ vs)
                        | (us,vs) <- take m (iterate siguiente ("",xs)) ]
  where xs = show n
        m  = length xs

-- siguiente ("","56789")  ==  ("6","7895")
-- siguiente ("6","7895")  ==  ("68","957")
-- siguiente ("68","957")  ==  ("685","79")
-- siguiente ("685","79")  ==  ("6859","7")
-- siguiente ("6859","7")  ==  ("6859","7")
siguiente :: (String,String) -> (String,String)
siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])
siguiente (xs,[a])    = (xs,[a])

-- 3ª solución
-- ===========

maxRotaciones3 :: Integer -> Integer
maxRotaciones3 = read . aux . show
  where aux (x:y:xs) | x > y     = x : y : xs
                     | otherwise = y : (aux $ xs ++ [x])
        aux [x]                  = [x]
        aux _                    = []

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

--    λ> length (show (maxRotaciones (n (5*10^3))))
--    5001
--    (2.74 secs, 802,282,616 bytes)
--    λ> length (show (maxRotaciones2 (n (5*10^3))))
--    5001
--    (18.23 secs, 12,375,579,216 bytes)
--    λ> length (show (maxRotaciones3 (n (5*10^3))))
--    5001
--    (0.67 secs, 729,155,056 bytes)

-- 1ª solución

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

maxRotaciones :: Integer -> Integer

maxRotaciones = read . aux . show

where aux n@[_] = n

aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

-- 2ª solución

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

maxRotaciones2 :: Integer -> Integer

maxRotaciones2 n

| n < 10 = n

| otherwise = maximum [ read (us ++ vs)

| (us,vs) <- take m (iterate siguiente ("",xs)) ]

where xs = show n

m = length xs

-- siguiente ("","56789") == ("6","7895")

-- siguiente ("6","7895") == ("68","957")

-- siguiente ("68","957") == ("685","79")

-- siguiente ("685","79") == ("6859","7")

-- siguiente ("6859","7") == ("6859","7")

siguiente :: (String,String) -> (String,String)

siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])

siguiente (xs,[a]) = (xs,[a])

-- 3ª solución

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

maxRotaciones3 :: Integer -> Integer

maxRotaciones3 = read . aux . show

where aux (x:y:xs) | x > y = x : y : xs

| otherwise = y : (aux $ xs ++ [x])

aux [x] = [x]

aux _ = []

-- Comparación de eficiencia

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

-- λ> length (show (maxRotaciones (n (5*10^3))))

-- 5001

-- (2.74 secs, 802,282,616 bytes)

-- λ> length (show (maxRotaciones2 (n (5*10^3))))

-- 5001

-- (18.23 secs, 12,375,579,216 bytes)

-- λ> length (show (maxRotaciones3 (n (5*10^3))))

-- 5001

-- (0.67 secs, 729,155,056 bytes)

Sucesión contadora

PorJosé A. Alonso 22-noviembre-201726-marzo-2022

Definir las siguientes funciones

   numeroContado           :: Integer -> Integer
   contadora               :: Integer -> [Integer]
   lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

numeroContado :: Integer -> Integer

contadora :: Integer -> [Integer]

lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

tales que

(numeroContado n) es el número obtenido al contar las repeticiones de cada una de las cifras de n. Por ejemplo,

     numeroContado 1                 == 11
     numeroContado 114213            == 31121314
     numeroContado 1111111111111111  == 161
     numeroContado 555555555500      == 20105

numeroContado 1 == 11

numeroContado 114213 == 31121314

numeroContado 1111111111111111 == 161

numeroContado 555555555500 == 20105

(contadora n) es la sucesión cuyo primer elemento es n y los restantes se obtienen contando el número anterior de la sucesión. Por ejemplo,

     λ> take 14 (contadora 1)
     [1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,
      31221324,21322314,21322314]
     λ> take 14 (contadora 5)
     [5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,
      3132132415,3122331415,3122331415,3122331415,3122331415]

λ> take 14 (contadora 1)

[1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314,

31221324,21322314,21322314]

λ> take 14 (contadora 5)

[5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415,

3132132415,3122331415,3122331415,3122331415,3122331415]

(lugarPuntoFijoContadora n k) es el menor i <= k tal que son iguales los elementos en las posiciones i e i+1 de la sucesión contadora que cominza con n. Por ejemplo,

      λ> lugarPuntoFijoContadora 1 100
      Just 12
      λ> contadora 1 !! 11
      31221324
      λ> contadora 1 !! 12
      21322314
      λ> contadora 1 !! 13
      21322314
      λ> lugarPuntoFijoContadora 1 10
      Nothing
      λ> lugarPuntoFijoContadora 5 20
      Just 10
      λ> lugarPuntoFijoContadora 40 200
      Nothing

λ> lugarPuntoFijoContadora 1 100

Just 12

λ> contadora 1 !! 11

31221324

λ> contadora 1 !! 12

21322314

λ> contadora 1 !! 13

21322314

λ> lugarPuntoFijoContadora 1 10

Nothing

λ> lugarPuntoFijoContadora 5 20

Just 10

λ> lugarPuntoFijoContadora 40 200

Nothing

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

Soluciones

import Data.List ( genericLength
                 , genericTake
                 , group
                 , nub
                 , sort
                 )

-- Definición de numeroContado
numeroContado :: Integer -> Integer
numeroContado n =
  (read . concat . map concat) [[(show . length) m,nub m]
                               | m <- (group . sort . show) n]

-- 1ª definición de contadora
contadora :: Integer -> [Integer]
contadora n = n : map numeroContado (contadora n)

-- 2ª definición de contadora
contadora2 :: Integer ->  [Integer]
contadora2 = iterate numeroContado 

-- Definición de lugarPuntoFijoContadora
lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer
lugarPuntoFijoContadora n k
  | m == k-1  = Nothing
  | otherwise = Just m
  where xs = genericTake k (contadora n)
        ds = zipWith (-) xs (tail xs)
        m  = genericLength (takeWhile (/=0) ds)

import Data.List ( genericLength

, genericTake

, group

, nub

, sort

)

-- Definición de numeroContado

numeroContado :: Integer -> Integer

numeroContado n =

(read . concat . map concat) [[(show . length) m,nub m]

| m <- (group . sort . show) n]

-- 1ª definición de contadora

contadora :: Integer -> [Integer]

contadora n = n : map numeroContado (contadora n)

-- 2ª definición de contadora

contadora2 :: Integer -> [Integer]

contadora2 = iterate numeroContado

-- Definición de lugarPuntoFijoContadora

lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer

lugarPuntoFijoContadora n k

| m == k-1 = Nothing

| otherwise = Just m

where xs = genericTake k (contadora n)

ds = zipWith (-) xs (tail xs)

m = genericLength (takeWhile (/=0) ds)

Rotaciones divisibles por 4

PorJosé A. Alonso 3-abril-201710-abril-2017

Las rotaciones de 928160 son 928160, 281609, 816092, 160928, 609281 y 92816. De las cuales, las divisibles por 4 son 928160, 816092, 160928 y 92816.

Definir la función

   nRotacionesDivisibles :: Integer -> Int

1	nRotacionesDivisibles :: Integer -> Int

tal que (nRotacionesDivisibles n) es el número de rotaciones del número n divisibles por 4. Por ejemplo,

   nRotacionesDivisibles 928160          ==  4
   nRotacionesDivisibles 44              ==  2
   nRotacionesDivisibles (1234^50000)    ==  38684
   nRotacionesDivisibles (1234^300000)   ==  231853

nRotacionesDivisibles 928160 == 4

nRotacionesDivisibles 44 == 2

nRotacionesDivisibles (1234^50000) == 38684

nRotacionesDivisibles (1234^300000) == 231853

Soluciones

import Data.Char (digitToInt)

-- 1ª definición
-- =============

nRotacionesDivisibles :: Integer -> Int
nRotacionesDivisibles n =
  length [x | x <- rotacionesNumero n, x `mod` 4 == 0]


-- (rotacionesNumero) es la lista de la rotaciones del número n. Por
-- ejemplo,
--    rotacionesNumero 235  ==  [235,352,523]
rotacionesNumero :: Integer -> [Integer]
rotacionesNumero = map read . rotaciones . show

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones :: [a] -> [[a]]
rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al
-- final. Por ejemplo, 
--    rota [3,2,5,7]  ==  [2,5,7,3]
rota :: [a] -> [a]
rota (x:xs) = xs ++ [x]

-- 2ª definición
-- =============

nRotacionesDivisibles2 :: Integer -> Int
nRotacionesDivisibles2 n = 
  length [x | x <- pares n, x `mod` 4 == 0]

-- (pares n) es la lista de pares de elementos consecutivos, incluyendo
-- el último con el primero. Por ejemplo,
--    pares 928160  ==  [9,92,28,81,16,60]
pares :: Integer -> [Int]
pares n =
  read [last ns,head ns] : [read [a,b] | (a,b) <- zip ns (tail ns)]
  where ns = show n

-- 3ª definición
-- =============

nRotacionesDivisibles3 :: Integer -> Int
nRotacionesDivisibles3 n =
  ( length
  . filter (0 ==)
  . map (`mod` 4)
  . zipWith (\x y -> 2*x + y) d
  . tail
  . (++[i])) d
  where
    d@(i:dn) = (map digitToInt . show) n

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

--    λ> nRotacionesDivisibles (123^1500)
--    803
--    (8.15 secs, 7,109,852,800 bytes)
--    λ> nRotacionesDivisibles2 (123^1500)
--    803
--    (0.05 secs, 0 bytes)
--    λ> nRotacionesDivisibles3 (123^1500)
--    803
--    (0.02 secs, 0 bytes)
--
--    λ> nRotacionesDivisibles2 (1234^50000)
--    38684
--    (2.24 secs, 1,160,467,472 bytes)
--    λ> nRotacionesDivisibles3 (1234^50000)
--    38684
--    (0.31 secs, 68,252,040 bytes)

import Data.Char (digitToInt)

-- 1ª definición

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

nRotacionesDivisibles :: Integer -> Int

nRotacionesDivisibles n =

length [x | x <- rotacionesNumero n, x `mod` 4 == 0]

-- (rotacionesNumero) es la lista de la rotaciones del número n. Por

-- ejemplo,

-- rotacionesNumero 235 == [235,352,523]

rotacionesNumero :: Integer -> [Integer]

rotacionesNumero = map read . rotaciones . show

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando

-- el primer elemento xs al final. Por ejemplo,

-- rotaciones [2,3,5] == [[2,3,5],[3,5,2],[5,2,3]]

rotaciones :: [a] -> [[a]]

rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al

-- final. Por ejemplo,

-- rota [3,2,5,7] == [2,5,7,3]

rota :: [a] -> [a]

rota (x:xs) = xs ++ [x]

-- 2ª definición

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

nRotacionesDivisibles2 :: Integer -> Int

nRotacionesDivisibles2 n =

length [x | x <- pares n, x `mod` 4 == 0]

-- (pares n) es la lista de pares de elementos consecutivos, incluyendo

-- el último con el primero. Por ejemplo,

-- pares 928160 == [9,92,28,81,16,60]

pares :: Integer -> [Int]

pares n =

read [last ns,head ns] : [read [a,b] | (a,b) <- zip ns (tail ns)]

where ns = show n

-- 3ª definición

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

nRotacionesDivisibles3 :: Integer -> Int

nRotacionesDivisibles3 n =

( length

. filter (0 ==)

. map (`mod` 4)

. zipWith (\x y -> 2*x + y) d

. tail

. (++[i])) d

where

d@(i:dn) = (map digitToInt . show) n

-- Comparación de eficiencia

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

-- λ> nRotacionesDivisibles (123^1500)

-- 803

-- (8.15 secs, 7,109,852,800 bytes)

-- λ> nRotacionesDivisibles2 (123^1500)

-- 803

-- (0.05 secs, 0 bytes)

-- λ> nRotacionesDivisibles3 (123^1500)

-- 803

-- (0.02 secs, 0 bytes)

-- λ> nRotacionesDivisibles2 (1234^50000)

-- 38684

-- (2.24 secs, 1,160,467,472 bytes)

-- λ> nRotacionesDivisibles3 (1234^50000)

-- 38684

-- (0.31 secs, 68,252,040 bytes)

Cálculo de pi usando la fórmula de Vieta

PorJosé A. Alonso 14-febrero-201725-abril-2021

La fórmula de Vieta para el cálculo de pi es la siguiente

Definir las funciones

   aproximacionPi :: Int -> Double
   errorPi :: Double -> Int

1 2	aproximacionPi :: Int -> Double errorPi :: Double -> Int

tales que

(aproximacionPi n) es la aproximación de pi usando n factores de la fórmula de Vieta. Por ejemplo,

     aproximacionPi  5  ==  3.140331156954753
     aproximacionPi 10  ==  3.1415914215112
     aproximacionPi 15  ==  3.141592652386592
     aproximacionPi 20  ==  3.1415926535886207
     aproximacionPi 25  ==  3.141592653589795

aproximacionPi 5 == 3.140331156954753

aproximacionPi 10 == 3.1415914215112

aproximacionPi 15 == 3.141592652386592

aproximacionPi 20 == 3.1415926535886207

aproximacionPi 25 == 3.141592653589795

(errorPi x) es el menor número de factores de la fórmula de Vieta necesarios para obtener pi con un error menor que x. Por ejemplo,

     errorPi 0.1        ==  2
     errorPi 0.01       ==  4
     errorPi 0.001      ==  6
     errorPi 0.0001     ==  7
     errorPi 1e-4       ==  7
     errorPi 1e-14      ==  24
     pi                 ==  3.141592653589793
     aproximacionPi 24  ==  3.1415926535897913

errorPi 0.1 == 2

errorPi 0.01 == 4

errorPi 0.001 == 6

errorPi 0.0001 == 7

errorPi 1e-4 == 7

errorPi 1e-14 == 24

pi == 3.141592653589793

aproximacionPi 24 == 3.1415926535897913

Soluciones

-- 1ª definición de aproximacionPi
aproximacionPi :: Int -> Double
aproximacionPi n = product [2 / aux x | x <- [0..n]]
  where
    aux 0 = 1
    aux 1 = sqrt 2
    aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi
aproximacionPi2 :: Int -> Double
aproximacionPi2 n = product [2/x | x <- 1 : xs] 
  where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi
aproximacionPi3 :: Int -> Double
aproximacionPi3 n =  product (2 : take n (map (2/) xs))
  where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi
errorPi :: Double -> Int
errorPi x = head [n | n <- [1..]
                    , abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi
errorPi2 :: Double -> Int
errorPi2 x = until aceptable (+1) 1
  where aceptable n = abs (pi - aproximacionPi n) < x

-- 1ª definición de aproximacionPi

aproximacionPi :: Int -> Double

aproximacionPi n = product [2 / aux x | x <- [0..n]]

where

aux 0 = 1

aux 1 = sqrt 2

aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = product [2/x | x <- 1 : xs]

where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi

aproximacionPi3 :: Int -> Double

aproximacionPi3 n = product (2 : take n (map (2/) xs))

where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi

errorPi :: Double -> Int

errorPi x = head [n | n <- [1..]

, abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi

errorPi2 :: Double -> Int

errorPi2 x = until aceptable (+1) 1

where aceptable n = abs (pi - aproximacionPi n) < x

Máxima potencia que divide al factorial

PorJosé A. Alonso 26-enero-20172-febrero-2017

La máxima potencia de 2 que divide al factorial de 5 es 3, ya que 5! = 120, 120 es divisible por 2^3 y no lo es por 2^4.

Definir la función

   maxPotDivFact :: Integer -> Integer -> Integer

1	maxPotDivFact :: Integer -> Integer -> Integer

tal que (maxPotDivFact p n), para cada primo p, es el mayor k tal que p^k divide al factorial de n. Por ejemplo,

   maxPotDivFact 2 5       ==  3
   maxPotDivFact 3 6       ==  2
   maxPotDivFact 2 10      ==  8
   maxPotDivFact 3 10      ==  4
   maxPotDivFact 2 (10^2)  ==  97
   maxPotDivFact 2 (10^3)  ==  994
   maxPotDivFact 2 (10^4)  ==  9995
   maxPotDivFact 2 (10^5)  ==  99994
   maxPotDivFact 2 (10^6)  ==  999993
   maxPotDivFact 3 (10^5)  ==  49995
   maxPotDivFact 3 (10^6)  ==  499993
   maxPotDivFact 7 (10^5)  ==  16662
   maxPotDivFact 7 (10^6)  ==  166664
   length (show (maxPotDivFact 2 (10^20000)))  ==  20000

maxPotDivFact 2 5 == 3

maxPotDivFact 3 6 == 2

maxPotDivFact 2 10 == 8

maxPotDivFact 3 10 == 4

maxPotDivFact 2 (10^2) == 97

maxPotDivFact 2 (10^3) == 994

maxPotDivFact 2 (10^4) == 9995

maxPotDivFact 2 (10^5) == 99994

maxPotDivFact 2 (10^6) == 999993

maxPotDivFact 3 (10^5) == 49995

maxPotDivFact 3 (10^6) == 499993

maxPotDivFact 7 (10^5) == 16662

maxPotDivFact 7 (10^6) == 166664

length (show (maxPotDivFact 2 (10^20000))) == 20000

Soluciones

import Data.List (genericIndex, genericTake)
import Data.Numbers.Primes (primes)
import Test.QuickCheck

-- 1ª definición
maxPotDivFact :: Integer -> Integer -> Integer
maxPotDivFact p n =
  head [k | k <- [0..], f `mod` (p^k) /= 0] - 1
  where f = product [1..n]

-- 1ª definición
maxPotDivFact2 :: Integer -> Integer -> Integer
maxPotDivFact2 p n
  | n < p     = 0
  | otherwise = m + maxPotDivFact2 p m
  where m = n `div` p  
  
-- 3ª definición
maxPotDivFact3 :: Integer -> Integer -> Integer
maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia
--    λ> maxPotDivFact 2 (10^4)
--    9995
--    (5.47 secs, 161,040,624 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--    λ> maxPotDivFact2 2 (10^4)
--    9995
--    (0.01 secs, 0 bytes)
--
--    λ> length (show (maxPotDivFact2 2 (10^20000)))
--    20000
--    (1.93 secs, 592,168,544 bytes)
--    λ> length (show (maxPotDivFact3 2 (10^20000)))
--    20000
--    (2.93 secs, 861,791,504 bytes)

import Data.List (genericIndex, genericTake)

import Data.Numbers.Primes (primes)

import Test.QuickCheck

-- 1ª definición

maxPotDivFact :: Integer -> Integer -> Integer

maxPotDivFact p n =

head [k | k <- [0..], f `mod` (p^k) /= 0] - 1

where f = product [1..n]

-- 1ª definición

maxPotDivFact2 :: Integer -> Integer -> Integer

maxPotDivFact2 p n

| n < p = 0

| otherwise = m + maxPotDivFact2 p m

where m = n `div` p

-- 3ª definición

maxPotDivFact3 :: Integer -> Integer -> Integer

maxPotDivFact3 p = sum . takeWhile (> 0) . tail . iterate (`div` p)

-- Comparación de eficiencia

-- λ> maxPotDivFact 2 (10^4)

-- 9995

-- (5.47 secs, 161,040,624 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> maxPotDivFact2 2 (10^4)

-- 9995

-- (0.01 secs, 0 bytes)

-- λ> length (show (maxPotDivFact2 2 (10^20000)))

-- 20000

-- (1.93 secs, 592,168,544 bytes)

-- λ> length (show (maxPotDivFact3 2 (10^20000)))

-- 20000

-- (2.93 secs, 861,791,504 bytes)

La sucesión «Mira y di»

PorJosé A. Alonso 24-enero-201731-enero-2017

La sucesión «Mira y di» (en inglés, Look-and-Say) es una sucesión de números naturales en donde cada término se obtiene agrupando las cifras iguales del anterior y recitándolas. Por ejemplo, si x(0) = 1 se lee como «un uno» y por tanto x(1) = 11. Análogamente,

   x(1) = 11     ("dos unos                          --> "21")
   x(2) = 21     ("un dos un uno                     --> "1211")
   x(3) = 1211   ("un uno un dos dos unos            --> "111221")
   x(4) = 111221 ("tres unos dos doses un uno        --> "312211")
   x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

x(1) = 11 ("dos unos --> "21")

x(2) = 21 ("un dos un uno --> "1211")

x(3) = 1211 ("un uno un dos dos unos --> "111221")

x(4) = 111221 ("tres unos dos doses un uno --> "312211")

x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221")

Definir la función

  sucMiraYDi :: Integer -> [Integer]

1	sucMiraYDi :: Integer -> [Integer]

tal que (sucMiraYDi n) es la sucesión «Mira y di» cuyo primer término es n. Por ejemplo,

   λ> take 9 (sucMiraYdi 1)
   [1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]
   λ> take 5 (sucMiraYdi 2017)
   [2017,12101117,111211103117,31123110132117,1321121321101113122117]
   λ> take 7 (sucMiraYDi 22)
   [22,22,22,22,22,22,22]
   λ> (sucMiraYDi 1) !! 11
   3113112221232112111312211312113211
   λ> (sucMiraYDi 1) !! 12
   1321132132111213122112311311222113111221131221

λ> take 9 (sucMiraYdi 1)

[1,11,21,1211,111221,312211,13112221,1113213211,31131211131221]

λ> take 5 (sucMiraYdi 2017)

[2017,12101117,111211103117,31123110132117,1321121321101113122117]

λ> take 7 (sucMiraYDi 22)

[22,22,22,22,22,22,22]

λ> (sucMiraYDi 1) !! 11

3113112221232112111312211312113211

λ> (sucMiraYDi 1) !! 12

1321132132111213122112311311222113111221131221

Independientemente del término inicial x(0) elegido (con la única salvedad del 22), la sucesión diverge y la razón entre el número de cifras de x(n) y el de x(n-1) tiende a un valor fijo que es la constante de Conway λ ≈ 1.303577269. Por ejemplo, para x(0) = 1, las razones son

   2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

1	2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3

Definir la función

   aproximacionConway :: Integer -> Double -> Int

1	aproximacionConway :: Integer -> Double -> Int

tal que (aproximacionConway n e) es el menor k tal que la diferencia entre la constante de Conway y la razón entre el número de cifras de x(k) x(k-1) es, en valor absoluto, menor que e. Por ejemplo,

   aproximacionConway 1 0.3     ==  3
   aproximacionConway 1 0.1     ==  5
   aproximacionConway 1 0.01    ==  9
   aproximacionConway 1 0.001   ==  24
   aproximacionConway 1 0.0001  ==  43
   aproximacionConway 2 0.0001  ==  47

aproximacionConway 1 0.3 == 3

aproximacionConway 1 0.1 == 5

aproximacionConway 1 0.01 == 9

aproximacionConway 1 0.001 == 24

aproximacionConway 1 0.0001 == 43

aproximacionConway 2 0.0001 == 47

Nota: Este ejercicio ha sido propuesto por Elías Guisado.

Soluciones

import Data.List (genericLength, group)

-- 1ª solución
-- ===========

sucMiraYdi :: Integer -> [Integer]
sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.
--    di 1       ==  11
--    di 11      ==  21
--    di 21      ==  1211
--    di 1211    ==  111221
--    di 111221  ==  312211
--    di 312211  ==  13112221
di :: Integer -> Integer
di = read . concatMap aux . group . show
  where aux s = show (length s) ++ [head s]

-- 2ª solución
-- ===========

sucMiraYdi2 :: Integer -> [Integer]
sucMiraYdi2 = iterate (read . concatMap aux . group . show)
  where aux s = show (length s) ++ [head s]

-- Constante de Conway
-- ===================

aproximacionConway :: Integer -> Double -> Int
aproximacionConway n e =
  length (takeWhile aux (razonesMiraYdi n))
  where aux x = abs (x - constanteConway) > e 

constanteConway :: Double
constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada
-- elemento de la sucesión "Mira y di" con elemento inicial n y su
-- anterior. Por ejemplo,
--    λ> take 10 (razonesMiraYdi 1)
--    [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]
--    λ> take 7 (razonesMiraYdi 10)
--    [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]
razonesMiraYdi :: Integer -> [Double]
razonesMiraYdi n =
  zipWith (/) (tail xs) xs
  where xs = map (genericLength . show) (sucMiraYdi n)

import Data.List (genericLength, group)

-- 1ª solución

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

sucMiraYdi :: Integer -> [Integer]

sucMiraYdi = iterate di

-- (di x) es el número correspondiente a la lectura de x. Por ejemplo.

-- di 1 == 11

-- di 11 == 21

-- di 21 == 1211

-- di 1211 == 111221

-- di 111221 == 312211

-- di 312211 == 13112221

di :: Integer -> Integer

di = read . concatMap aux . group . show

where aux s = show (length s) ++ [head s]

-- 2ª solución

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

sucMiraYdi2 :: Integer -> [Integer]

sucMiraYdi2 = iterate (read . concatMap aux . group . show)

where aux s = show (length s) ++ [head s]

-- Constante de Conway

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

aproximacionConway :: Integer -> Double -> Int

aproximacionConway n e =

length (takeWhile aux (razonesMiraYdi n))

where aux x = abs (x - constanteConway) > e

constanteConway :: Double

constanteConway = 1.303577269

-- (razonesMiraYdi n) es la sucesión de las razones entre de cada

-- elemento de la sucesión "Mira y di" con elemento inicial n y su

-- anterior. Por ejemplo,

-- λ> take 10 (razonesMiraYdi 1)

-- [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3]

-- λ> take 7 (razonesMiraYdi 10)

-- [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714]

razonesMiraYdi :: Integer -> [Double]

razonesMiraYdi n =

zipWith (/) (tail xs) xs

where xs = map (genericLength . show) (sucMiraYdi n)

Sucesión de cuadrados reducidos

PorJosé A. Alonso 5-enero-201712-enero-2017

La sucesión de cuadrados de orden n definida a partir de un número x se forma iniciándola en x y, para cada término z el siguiente es el número formado por los n primeros dígitos del cuadrado de z. Por ejemplo, para n = 4 y x = 1111, el primer término de la sucesión es 1111, el segundo es 1234 (ya que 1111^2 = 1234321) y el tercero es 1522 (ya que 1234^2 = 1522756).

Definir la función

   sucCuadrados :: Int -> Integer -> [Integer]

1	sucCuadrados :: Int -> Integer -> [Integer]

tal que (sucCuadrados n x) es la sucesión de cuadrados de orden n definida a partir de x. Por ejemplo,

   λ> take 10 (sucCuadrados 4 1111)
   [1111,1234,1522,2316,5363,2876,8271,6840,4678,2188]
   λ> take 10 (sucCuadrados 3 457)
   [457,208,432,186,345,119,141,198,392,153]
   λ> take 20 (sucCuadrados 2 55)
   [55,30,90,81,65,42,17,28,78,60,36,12,14,19,36,12,14,19,36,12]

λ> take 10 (sucCuadrados 4 1111)

[1111,1234,1522,2316,5363,2876,8271,6840,4678,2188]

λ> take 10 (sucCuadrados 3 457)

[457,208,432,186,345,119,141,198,392,153]

λ> take 20 (sucCuadrados 2 55)

[55,30,90,81,65,42,17,28,78,60,36,12,14,19,36,12,14,19,36,12]

Soluciones

sucCuadrados :: Int -> Integer -> [Integer]
sucCuadrados n x = iterate (siguiente n) x

siguiente :: Int -> Integer -> Integer
siguiente n x = read (take n (show (x^2)))

sucCuadrados :: Int -> Integer -> [Integer]

sucCuadrados n x = iterate (siguiente n) x

siguiente :: Int -> Integer -> Integer

siguiente n x = read (take n (show (x^2)))

Números de Perrin

PorJosé A. Alonso 29-diciembre-201625-abril-2021

Los números de Perrin se definen por la relación de recurrencia

   P(n) = P(n - 2) + P(n - 3) si n > 2,

1	P(n) = P(n - 2) + P(n - 3) si n > 2,

con los valores iniciales

   P(0) = 3, P(1) = 0 y P(2) = 2.

1	P(0) = 3, P(1) = 0 y P(2) = 2.

Definir la sucesión

   sucPerrin :: [Integer]

1	sucPerrin :: [Integer]

cuyos elementos son los números de Perrin. Por ejemplo,

   λ> take 15 sucPerrin
   [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]
   λ> length (show (sucPerrin !! (2*10^5)))
   24425

λ> take 15 sucPerrin

[3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]

λ> length (show (sucPerrin !! (2*10^5)))

24425

Comprobar con QuickCheck si se verifica la siguiente propiedad: para todo entero n > 1, el n-ésimo término de la sucesión de Perrin es divisible por n si y sólo si n es primo.

Soluciones

import Data.List (genericIndex, unfoldr)
import Data.Numbers.Primes (isPrime)
import Test.QuickCheck

-- 1ª definición
sucPerrin1 :: [Integer]
sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª definición
sucPerrin2 :: [Integer]
sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]
  where op (a,b,c) = (b,c,a+b)
 
-- 3ª definición
sucPerrin3 :: [Integer]
sucPerrin3 =
  unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- Comparación de eficiencia
--    λ> length (show (sucPerrin1 !! (10^5)))
--    12213
--    (1.44 secs, 295,373,680 bytes)
--    λ> length (show (sucPerrin2 !! (10^5)))
--    12213
--    (1.22 secs, 301,493,408 bytes)
--    λ> length (show (sucPerrin3 !! (10^5)))
--    12213
--    (0.86 secs, 296,911,304 bytes)

-- Usaremos la 3ª
sucPerrin :: [Integer]
sucPerrin = sucPerrin3

-- La propiedad es  
conjeturaPerrin :: Integer -> Property
conjeturaPerrin n =
  n > 1 ==>
  (perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por
-- ejemplo,
--    perrin 4  ==  2
--    perrin 5  ==  5
--    perrin 6  ==  5
perrin :: Integer -> Integer
perrin n = sucPerrin `genericIndex` n

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

import Data.List (genericIndex, unfoldr)

import Data.Numbers.Primes (isPrime)

import Test.QuickCheck

-- 1ª definición

sucPerrin1 :: [Integer]

sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª definición

sucPerrin2 :: [Integer]

sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]

where op (a,b,c) = (b,c,a+b)

-- 3ª definición

sucPerrin3 :: [Integer]

sucPerrin3 =

unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- Comparación de eficiencia

-- λ> length (show (sucPerrin1 !! (10^5)))

-- 12213

-- (1.44 secs, 295,373,680 bytes)

-- λ> length (show (sucPerrin2 !! (10^5)))

-- 12213

-- (1.22 secs, 301,493,408 bytes)

-- λ> length (show (sucPerrin3 !! (10^5)))

-- 12213

-- (0.86 secs, 296,911,304 bytes)

-- Usaremos la 3ª

sucPerrin :: [Integer]

sucPerrin = sucPerrin3

-- La propiedad es

conjeturaPerrin :: Integer -> Property

conjeturaPerrin n =

n > 1 ==>

(perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por

-- ejemplo,

-- perrin 4 == 2

-- perrin 5 == 5

-- perrin 6 == 5

perrin :: Integer -> Integer

perrin n = sucPerrin `genericIndex` n

-- La comprobación es

-- λ> quickCheck conjeturaPerrin

-- +++ OK, passed 100 tests.

Nota: Aunque QuickCheck no haya encontrado contraejemplos, la propiedad no es cierta. Sólo lo es una de las implicaciones: si n es primo, entonces el n-ésimo término de la sucesión de Perrin es divisible por n. La otra es falsa y los primeros contraejemplos son

   271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

1	271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

Distancia a Erdős

PorJosé A. Alonso 14-diciembre-201621-diciembre-2016

Una de las razones por la que el matemático húngaro Paul Erdős es conocido es por la multitud de colaboraciones que realizó durante toda su carrera, un total de 511. Tal es así que se establece la distancia a Erdős como la distancia que has estado de coautoría con Erdős. Por ejemplo, si eres Paul Erdős tu distancia a Erdős es 0, si has escrito un artículo con Erdős tu distancia es 1, si has escrito un artículo con alguien que ha escrito un artículo con Erdős tu distancia es 2, etc. El objetivo de este problema es definir una función que a partir de una lista de pares de coautores y un número natural n calcular la lista de los matemáticos a una distancia n de Erdős.

Para el problema se considerará la siguiente lista de coautores

   coautores :: [(String,String)]
   coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

La lista anterior es real y se ha obtenido del artículo Famous trails to Paul Erdős.

Definir la función

   numeroDeErdos :: [(String, String)] -> Int -> [String]

1	numeroDeErdos :: [(String, String)] -> Int -> [String]

tal que (numeroDeErdos xs n) es la lista de lista de los matemáticos de la
lista de coautores xs que se encuentran a una distancia n de Erdős. Por ejemplo,

   λ> numeroDeErdos coautores 0
   ["Paul Erdos"]
   λ> numeroDeErdos coautores 1
   ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]
   λ> numeroDeErdos coautores 2
   ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

λ> numeroDeErdos coautores 0

["Paul Erdos"]

λ> numeroDeErdos coautores 1

["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]

λ> numeroDeErdos coautores 2

["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

data Arbol a = N a [Arbol a]
             deriving Show 

coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

-- 1ª solución
-- ===========

numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de
-- coautores xs. Por ejemplo,
--    λ> arbolDeErdos coautores "Paul Erdos"
--    N "Paul Erdos"
--      [N "Ernst Straus"
--         [N "Albert Einstein"
--           [N "Wolfgang Pauli" [],
--            N "Otto Stern" []]],
--          N "Pascual Jordan"
--            [N "John von Newmann"
--               [N "David Hilbert" []]],
--          N "D. Kleitman"
--            [N "S. Glashow"
--               [N "M. Gell-Mann"
--                  [N "Richar Feynman" [],
--                   N "David Pines"
--                     [N "A. Bohr" [],
--                      N "D. Bohm"
--                        [N "L. De Broglie" []]]]]],
--          N "J. Conway"
--            [N "P. Doyle" []],
--             N "A. J. Granville"
--               [N "B. Mazur"
--                  [N "Andrew Wiles" []]]]
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    filtra a (x,y) | a == x    = y
                   | otherwise = x
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel
-- n. Por ejemplo,      
--    nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [3]
--    nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [5,7]
--    nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [6,9]
nivel :: Int -> Arbol a -> [a]
nivel 0 (N a xs) = [a]
nivel n (N a xs) = concatMap (nivel (n-1)) xs

-- 2ª solución
-- ===========

numeroDeErdos2 :: [(String, String)] -> Int -> [String]
numeroDeErdos2 = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]

-- 3ª solución
-- ===========

numeroDeErdos3 :: [(String, String)] -> Int -> [String]
numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados
-- por diatancia. Por ejemplo, 
--    λ> take 3 (sucCoautores "Paul Erdos" coautores)
--    [["Paul Erdos"],
--     ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",
--      "A. J. Granville"],
--     ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",
--      "B. Mazur"]]
--    λ> sucCoautores "Albert Einstein" coautores
--    [["Albert Einstein"],
--     ["Ernst Straus","Otto Stern","Wolfgang Pauli"],
--     ["Paul Erdos"],
--     ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],
--     ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],
--     ["David Hilbert","M. Gell-Mann","Andrew Wiles"],
--     ["David Pines","Richar Feynman"],
--     ["D. Bohm","A. Bohr"],
--     ["L. De Broglie"]]
sucCoautores :: String -> [(String, String)] -> [[String]]
sucCoautores a ps =
  takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \\ zs)
          where zs = [y | y <- ys
                        , or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por
-- ejemplo,
--    elementos [(1,3),(3,2),(1,5)]  ==  [1,3,2,5]
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap (\(x,y) -> [x,y]))

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

data Arbol a = N a [Arbol a]

deriving Show

coautores :: [(String,String)]

coautores =

[("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),

("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),

("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),

("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),

("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),

("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),

("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),

("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),

("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),

("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

-- 1ª solución

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

numeroDeErdos :: [(String, String)] -> Int -> [String]

numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")

-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de

-- coautores xs. Por ejemplo,

-- λ> arbolDeErdos coautores "Paul Erdos"

-- N "Paul Erdos"

-- [N "Ernst Straus"

-- [N "Albert Einstein"

-- [N "Wolfgang Pauli" [],

-- N "Otto Stern" []]],

-- N "Pascual Jordan"

-- [N "John von Newmann"

-- [N "David Hilbert" []]],

-- N "D. Kleitman"

-- [N "S. Glashow"

-- [N "M. Gell-Mann"

-- [N "Richar Feynman" [],

-- N "David Pines"

-- [N "A. Bohr" [],

-- N "D. Bohm"

-- [N "L. De Broglie" []]]]]],

-- N "J. Conway"

-- [N "P. Doyle" []],

-- N "A. J. Granville"

-- [N "B. Mazur"

-- [N "Andrew Wiles" []]]]

arbolDeErdos :: [(String, String)] -> String -> Arbol String

arbolDeErdos xs a =

N a [arbolDeErdos noColaboradores n | n <- colaboradores]

where

colaboradores = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]

filtra a (x,y) | a == x = y

| otherwise = x

noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]

-- (nivel n a) es la lista de los elementos del árbol a en el nivel

-- n. Por ejemplo,

-- nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [3]

-- nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [5,7]

-- nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]]) == [6,9]

nivel :: Int -> Arbol a -> [a]

nivel 0 (N a xs) = [a]

nivel n (N a xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

numeroDeErdos2 :: [(String, String)] -> Int -> [String]

numeroDeErdos2 = auxC ["Paul Erdos"]

where

auxC v xs 0 = v

auxC v xs x = auxC (n v) (m v xs) (x-1)

where n v = [a | (a,b) <- xs, elem b v] ++

[b | (a,b) <- xs, elem a v]

m ys xs = [(a,b) | (a,b) <- xs

, notElem a ys && notElem b ys]

-- 3ª solución

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

numeroDeErdos3 :: [(String, String)] -> Int -> [String]

numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n

-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados

-- por diatancia. Por ejemplo,

-- λ> take 3 (sucCoautores "Paul Erdos" coautores)

-- [["Paul Erdos"],

-- ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",

-- "A. J. Granville"],

-- ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",

-- "B. Mazur"]]

-- λ> sucCoautores "Albert Einstein" coautores

-- [["Albert Einstein"],

-- ["Ernst Straus","Otto Stern","Wolfgang Pauli"],

-- ["Paul Erdos"],

-- ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],

-- ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],

-- ["David Hilbert","M. Gell-Mann","Andrew Wiles"],

-- ["David Pines","Richar Feynman"],

-- ["D. Bohm","A. Bohr"],

-- ["L. De Broglie"]]

sucCoautores :: String -> [(String, String)] -> [[String]]

sucCoautores a ps =

takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))

where as = elementos ps

sig (xs,ys) = (zs,ys \\ zs)

where zs = [y | y <- ys

, or [elem (x,y) ps || elem (y,x) ps | x <- xs]]

-- (elementos ps) es la lista de los elementos de los pares ps. Por

-- ejemplo,

-- elementos [(1,3),(3,2),(1,5)] == [1,3,2,5]

elementos :: Eq a => [(a, a)] -> [a]

elementos = nub . (concatMap (\(x,y) -> [x,y]))

Suma de los máximos de los subconjuntos

PorJosé A. Alonso 8-diciembre-201615-diciembre-2016

Los subconjuntos distinto del vacío del conjunto {3, 2, 5}, junto con sus máximos elementos, son

   {3}       su máximo es 3
   {2}       su máximo es 2
   {5}       su máximo es 5
   {3, 2}    su máximo es 3
   {3, 5}    su máximo es 5
   {2, 5}    su máximo es 5
   {3, 2, 5} su máximo es 5

{3} su máximo es 3

{2} su máximo es 2

{5} su máximo es 5

{3, 2} su máximo es 3

{3, 5} su máximo es 5

{2, 5} su máximo es 5

{3, 2, 5} su máximo es 5

Por tanto, la suma de los máximos elementos de los subconjuntos de {3, 2, 5} es 3 + 2 + 5 + 3 + 5 + 5 + 5 = 28.

Definir la función

   sumaMaximos :: [Integer] -> Integer

1	sumaMaximos :: [Integer] -> Integer

tal que (sumaMaximos xs) es la suma de los máximos elementos de los subconjuntos de xs. Por ejemplo,

   sumaMaximos [3,2,5]    ==  28
   sumaMaximos [4,1,6,3]  ==  71
   sumaMaximos [1..100]   ==  125497409422594710748173617332225
   length (show (sumaMaximos [1..10^5]))  ==  30108
   sumaMaximos [1..10^5] `mod` (10^7)     ==  4490625

sumaMaximos [3,2,5] == 28

sumaMaximos [4,1,6,3] == 71

sumaMaximos [1..100] == 125497409422594710748173617332225

length (show (sumaMaximos [1..10^5])) == 30108

sumaMaximos [1..10^5] `mod` (10^7) == 4490625

Soluciones

import Data.List (sort, subsequences)

-- 1ª definición
sumaMaximos :: [Integer] -> Integer
sumaMaximos xs =
  sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición
sumaMaximos2 :: [Integer] -> Integer
sumaMaximos2 =
  sum . map maximum . tail . subsequences

-- 3ª definición
sumaMaximos3 :: [Integer] -> Integer
sumaMaximos3 xs =
  sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia
--    λ> sumaMaximos [1..20]
--    19922945
--    (2.74 secs, 703,957,848 bytes)
--    λ> sumaMaximos2 [1..20]
--    19922945
--    (2.06 secs, 680,728,696 bytes)
--    λ> sumaMaximos3 [1..20]
--    19922945
--    (0.01 secs, 0 bytes)

import Data.List (sort, subsequences)

-- 1ª definición

sumaMaximos :: [Integer] -> Integer

sumaMaximos xs =

sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición

sumaMaximos2 :: [Integer] -> Integer

sumaMaximos2 =

sum . map maximum . tail . subsequences

-- 3ª definición

sumaMaximos3 :: [Integer] -> Integer

sumaMaximos3 xs =

sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia

-- λ> sumaMaximos [1..20]

-- 19922945

-- (2.74 secs, 703,957,848 bytes)

-- λ> sumaMaximos2 [1..20]

-- 19922945

-- (2.06 secs, 680,728,696 bytes)

-- λ> sumaMaximos3 [1..20]

-- 19922945

-- (0.01 secs, 0 bytes)

Basado en el artículo
Sum of maximum elements of all subsets
de Utkarsh Trivedi en GeeksforGeeks.

Menor potencia de 2 comenzando un número dado

PorJosé A. Alonso 24-noviembre-20161-diciembre-2016

Definir las siguientes funciones

   potenciasDe2  :: Integer -> [Integer]
   menorPotenciaDe2 :: Integer -> Integer

1 2	potenciasDe2 :: Integer -> [Integer] menorPotenciaDe2 :: Integer -> Integer

tales que

(potenciasDe2 a) es la lista de las potencias de 2 que comienzan por a. Por ejemplo,

     λ> take 5 (potenciasDe2 3)
     [32,32768,33554432,34359738368,35184372088832]
     λ> take 2 (potenciasDe2 102)
     [1024,102844034832575377634685573909834406561420991602098741459288064]

λ> take 5 (potenciasDe2 3)

[32,32768,33554432,34359738368,35184372088832]

λ> take 2 (potenciasDe2 102)

[1024,102844034832575377634685573909834406561420991602098741459288064]

(menorPotenciaDe2 a) es la menor potencia de 2 que comienza con el número a. Por ejemplo,

     λ> menorPotenciaDe2 10
     1024
     λ> menorPotenciaDe2 25
     256
     λ> menorPotenciaDe2 62
     6277101735386680763835789423207666416102355444464034512896
     λ> menorPotenciaDe2 425
     42535295865117307932921825928971026432
     λ> menorPotenciaDe2 967140655691
     9671406556917033397649408
     λ> [menorPotenciaDe2 a | a <- [1..10]]
     [1,2,32,4,512,64,70368744177664,8,9007199254740992,1024]

λ> menorPotenciaDe2 10

1024

λ> menorPotenciaDe2 25

256

λ> menorPotenciaDe2 62

6277101735386680763835789423207666416102355444464034512896

λ> menorPotenciaDe2 425

42535295865117307932921825928971026432

λ> menorPotenciaDe2 967140655691

9671406556917033397649408

λ> [menorPotenciaDe2 a | a <- [1..10]]

[1,2,32,4,512,64,70368744177664,8,9007199254740992,1024]

Comprobar con QuickCheck que, para todo entero positivo a, existe una potencia de 2 que empieza por a.

Soluciones

import Data.List (isPrefixOf)
import Test.QuickCheck

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

potenciasDe2A :: Integer -> [Integer]
potenciasDe2A a =
  [x | x <- potenciasA
     , a `esPrefijo` x]

potenciasA :: [Integer]
potenciasA = [2^n | n <- [0..]]

esPrefijo :: Integer -> Integer -> Bool
esPrefijo x y = show x `isPrefixOf` show y

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

potenciasDe2B :: Integer -> [Integer]
potenciasDe2B a = filter (a `esPrefijo`) potenciasA

-- 3ª definición de potenciasDe2
-- =============================

potenciasDe2C :: Integer -> [Integer]
potenciasDe2C a = filter (a `esPrefijo`) potenciasC

potenciasC :: [Integer]
potenciasC = iterate (*2) 1

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

-- λ> length (show (head (potenciasDe2A 123456)))
-- 19054
-- (7.17 secs, 1,591,992,792 bytes)
-- λ> length (show (head (potenciasDe2B 123456)))
-- 19054
-- (5.96 secs, 1,273,295,272 bytes)
-- λ> length (show (head (potenciasDe2C 123456)))
-- 19054
-- (6.24 secs, 1,542,698,392 bytes)

-- Definición de menorPotenciaDe2 
menorPotenciaDe2 :: Integer -> Integer
menorPotenciaDe2 = head . potenciasDe2B

-- Propiedad
prop_potenciasDe2 :: Integer -> Property
prop_potenciasDe2 a =
  a > 0 ==> not (null (potenciasDe2B a))

-- Comprobación
--    λ> quickCheck prop_potenciasDe2
--    +++ OK, passed 100 tests.

import Data.List (isPrefixOf)

import Test.QuickCheck

-- 1ª definición de potenciasDe2

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

potenciasDe2A :: Integer -> [Integer]

potenciasDe2A a =

[x | x <- potenciasA

, a `esPrefijo` x]

potenciasA :: [Integer]

potenciasA = [2^n | n <- [0..]]

esPrefijo :: Integer -> Integer -> Bool

esPrefijo x y = show x `isPrefixOf` show y

-- 2ª definición de potenciasDe2

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

potenciasDe2B :: Integer -> [Integer]

potenciasDe2B a = filter (a `esPrefijo`) potenciasA

-- 3ª definición de potenciasDe2

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

potenciasDe2C :: Integer -> [Integer]

potenciasDe2C a = filter (a `esPrefijo`) potenciasC

potenciasC :: [Integer]

potenciasC = iterate (*2) 1

-- Comparación de eficiencia

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

-- λ> length (show (head (potenciasDe2A 123456)))

-- 19054

-- (7.17 secs, 1,591,992,792 bytes)

-- λ> length (show (head (potenciasDe2B 123456)))

-- 19054

-- (5.96 secs, 1,273,295,272 bytes)

-- λ> length (show (head (potenciasDe2C 123456)))

-- 19054

-- (6.24 secs, 1,542,698,392 bytes)

-- Definición de menorPotenciaDe2

menorPotenciaDe2 :: Integer -> Integer

menorPotenciaDe2 = head . potenciasDe2B

-- Propiedad

prop_potenciasDe2 :: Integer -> Property

prop_potenciasDe2 a =

a > 0 ==> not (null (potenciasDe2B a))

-- Comprobación

-- λ> quickCheck prop_potenciasDe2

-- +++ OK, passed 100 tests.

Referencias

Potencias de 2 por Philippe Chevanne en «Mad Maths».
Sucesión A018802 de la OEIS

Sucesión duplicadora

PorJosé A. Alonso 16-mayo-201625-abril-2021

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

3 = 2*1 +1

6 = 2*3

13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

1	duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

duplicadora 13 == [1,3,6,13]

duplicadora 17 == [1,2,4,8,17]

length (duplicadora (10^40000)) == 132878

Soluciones

-- 1ª solución
duplicadora :: Integer -> [Integer]
duplicadora x =
    reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
    reverse . takeWhile (>=1) . iterate (`div` 2)

-- 1ª solución

duplicadora :: Integer -> [Integer]

duplicadora x =

reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición

duplicadora2 :: Integer -> [Integer]

duplicadora2 =

reverse . takeWhile (>=1) . iterate (`div` 2)

Integración por el método de los rectángulos

PorJosé A. Alonso 1-marzo-20161-mayo-2016

La integral definida de una función f entre los límites a y b puede calcularse mediante la regla del rectángulo usando la fórmula

   h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

1	h * (f(a+h/2) + f(a+h+h/2) + f(a+2h+h/2) + ... + f(a+nh+h/2))

con a+nh+h/2 ≤ b < a+(n+1)h+h/2 y usando valores pequeños para h.

Definir la función

   integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

1	integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

tal que (integral a b f h) es el valor de dicha expresión. Por ejemplo, el cálculo de la integral de f(x) = x^3 entre 0 y 1, con paso 0.01, es

   integral 0 1 (^3) 0.01  ==  0.24998750000000042

1	integral 0 1 (^3) 0.01 == 0.24998750000000042

Otros ejemplos son

   integral 0 1 (^4) 0.01                        ==  0.19998333362500048
   integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01       ==  1.9999250000000026
   log 2 - integral 1 2 (\x -> 1/x) 0.01         ==  3.124931644782336e-6
   pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01  ==  -8.333333331389525e-6

integral 0 1 (^4) 0.01 == 0.19998333362500048

integral 0 1 (\x -> 3*x^2 + 4*x^3) 0.01 == 1.9999250000000026

log 2 - integral 1 2 (\x -> 1/x) 0.01 == 3.124931644782336e-6

pi - 4 * integral 0 1 (\x -> 1/(x^2+1)) 0.01 == -8.333333331389525e-6

Nota: Definir la función también en Maxima. Por ejemplo,

   (%i3) integral (0,1,lambda ([x],x^3),0.01);
   (%o3) 0.2499875

1 2	(%i3) integral (0,1,lambda ([x],x^3),0.01); (%o3) 0.2499875

Soluciones

-- 1ª solución
-- ===========

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de
--    f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    suma 2 5 (1+) (^3)  ==  224
suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a
suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista
--    [a, s(a), s(s(a), ..., s(...(s(a))...)]
-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,
--    sucesion 3 20 (+2)  ==  [3,5,7,9,11,13,15,17,19]
sucesion :: Ord a => a -> a -> (a -> a) -> [a]
sucesion a b s = takeWhile (<=b) (iterate s a)

-- 2ª solución
-- ===========

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral2 a b f h
    | a+h/2 > b = 0
    | otherwise = h * f (a+h/2) + integral2 (a+h) b f h

-- 3ª solución
-- ===========

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a
integral3 a b f h = aux a where
    aux x | x+h/2 > b = 0
          | otherwise = h * f (x+h/2) + aux (x+h)

-- 1ª solución

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

integral :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral a b f h = h * suma (a+h/2) b (+h) f

-- (suma a b s f) es l valor de

-- f(a) + f(s(a)) + f(s(s(a)) + ... + f(s(...(s(a))...))

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- suma 2 5 (1+) (^3) == 224

suma :: (Ord t, Num a) => t -> t -> (t -> t) -> (t -> a) -> a

suma a b s f = sum [f x | x <- sucesion a b s]

-- (sucesion x y s) es la lista

-- [a, s(a), s(s(a), ..., s(...(s(a))...)]

-- hasta que s(s(...(s(a))...)) > b. Por ejemplo,

-- sucesion 3 20 (+2) == [3,5,7,9,11,13,15,17,19]

sucesion :: Ord a => a -> a -> (a -> a) -> [a]

sucesion a b s = takeWhile (<=b) (iterate s a)

-- 2ª solución

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

integral2 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral2 a b f h

| a+h/2 > b = 0

| otherwise = h * f (a+h/2) + integral2 (a+h) b f h

-- 3ª solución

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

integral3 :: (Fractional a, Ord a) => a -> a -> (a -> a) -> a -> a

integral3 a b f h = aux a where

aux x | x+h/2 > b = 0

| otherwise = h * f (x+h/2) + aux (x+h)

Solución en Maxima

integral (a,b,f,h) := block ([c:a+h/2, s:0],
  while c <= b do
    ( s : s + f(c),
      c : c+h),
  float(h*s))$

integral (a,b,f,h) := block ([c:a+h/2, s:0],

while c <= b do

( s : s + f(c),

c : c+h),

float(h*s))$

Nota: En Maxima esta definida la función integrate para calcular integrales definidas. Por ejemplo,

     (%i7) integrate (x^3,x,0,1);
           1
     (%o7) -
           4
     (%i8) %, numer;
     (%o8) 0.25

(%i7) integrate (x^3,x,0,1);

(%o7) -

(%i8) %, numer;

(%o8) 0.25

Puntos en una región

PorJosé A. Alonso 5-enero-20161-mayo-2016

Definir la función

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

1	puntos :: Integer -> [(Integer,Integer)]

tal que (puntos n) es la lista de los puntos (x,y) con coordenadas enteras de
la cuadrícula [1..n]x[1..n] (es decir, 1 ≤ x,y ≤ n) tales que |x²-xy-y²| = 1. Por ejemplo,

   length (puntos 10)          ==  5
   length (puntos 100)         ==  10
   length (puntos 1000)        ==  15
   length (puntos (10^50000))  ==  239249

length (puntos 10) == 5

length (puntos 100) == 10

length (puntos 1000) == 15

length (puntos (10^50000)) == 239249

Soluciones

-- 1ª definición
-- =============

puntos1 :: Integer -> [(Integer,Integer)]
puntos1 n =
    [(x,y) | x <- [1..n],
             y <- [1..n],
             abs (x^2-x*y-y^2) == 1] 

-- 2ª definición
-- =============

-- Calculando algunos elementos
--    λ> puntos1 10
--    [(1,1),(2,1),(3,2),(5,3),(8,5)]
--    λ> puntos1 20
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]
--    λ> puntos1 100
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
--    λ> puntos1 89
--    [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]
-- se observa una ley de construcción de cada elemento a partir del anterior.

puntos2 :: Integer -> [(Integer,Integer)]
puntos2 n = takeWhile menor (iterate siguiente (1,1))
    where siguiente (x,y) = (x+y,x)
          menor (x,y)     = x <= n

-- 3ª definición
-- =============

-- Se observa que la lista de las segundas componentes
--    1,1,2,3,5,8,13,21,34,55,89,...
-- y la lista de las primeras componentes es el resto de la segunda. 

puntos3 :: Integer -> [(Integer,Integer)]
puntos3 n = zip (tail xs) xs
    where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,
--    take 11 fibonacci  ==  [1,1,2,3,5,8,13,21,34,55,89]
fibonacci :: [Integer]
fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

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

-- λ> length (puntos1 (10^3))
-- 15
-- (7.96 secs, 1,092,368,200 bytes)
-- λ> length (puntos2 (10^3))
-- 15
-- (0.02 secs, 0 bytes)
-- 
-- λ> length (puntos2 (10^30000))
-- 143549
-- (1.14 secs, 974,239,544 bytes)
-- λ> length (puntos3 (10^30000))
-- 143549
-- (3.28 secs, 967,206,560 bytes)

-- 1ª definición

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

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

puntos1 n =

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

y <- [1..n],

abs (x^2-x*y-y^2) == 1]

-- 2ª definición

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

-- Calculando algunos elementos

-- λ> puntos1 10

-- [(1,1),(2,1),(3,2),(5,3),(8,5)]

-- λ> puntos1 20

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8)]

-- λ> puntos1 100

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- λ> puntos1 89

-- [(1,1),(2,1),(3,2),(5,3),(8,5),(13,8),(21,13),(34,21),(55,34),(89,55)]

-- se observa una ley de construcción de cada elemento a partir del anterior.

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

puntos2 n = takeWhile menor (iterate siguiente (1,1))

where siguiente (x,y) = (x+y,x)

menor (x,y) = x <= n

-- 3ª definición

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

-- Se observa que la lista de las segundas componentes

-- 1,1,2,3,5,8,13,21,34,55,89,...

-- y la lista de las primeras componentes es el resto de la segunda.

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

puntos3 n = zip (tail xs) xs

where xs = takeWhile (<=n) fibonacci

-- fibonacci es la sucesión de Fibonacci. Por ejemplo,

-- take 11 fibonacci == [1,1,2,3,5,8,13,21,34,55,89]

fibonacci :: [Integer]

fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci)

-- Comparación de eficiencia

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

-- λ> length (puntos1 (10^3))

-- 15

-- (7.96 secs, 1,092,368,200 bytes)

-- λ> length (puntos2 (10^3))

-- 15

-- (0.02 secs, 0 bytes)

-- λ> length (puntos2 (10^30000))

-- 143549

-- (1.14 secs, 974,239,544 bytes)

-- λ> length (puntos3 (10^30000))

-- 143549

-- (3.28 secs, 967,206,560 bytes)

Suma con redondeos

PorJosé A. Alonso 1-enero-20167-enero-2016

Definir las funciones

   sumaRedondeos       :: Integer -> [Integer]
   limiteSumaRedondeos :: Integer -> Integer

1 2	sumaRedondeos :: Integer -> [Integer] limiteSumaRedondeos :: Integer -> Integer

tales que

(sumaRedondeos n) es la sucesión cuyo k-ésimo término es

     redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

1	redondeo (n/2) + redondeo (n/4) + ... + redondeo (n/2^k)

Por ejemplo,

     take 5 (sumaRedondeos 1000)  ==  [500,750,875,937,968]

1	take 5 (sumaRedondeos 1000) == [500,750,875,937,968]

(limiteSumaRedondeos n) es la suma de la serie

     redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

1	redondeo (n/2) + redondeo (n/4) + redondeo (n/8) + ...

Por ejemplo,

     limiteSumaRedondeos 2000                    ==  1999
     limiteSumaRedondeos 2016                    ==  2016
     limiteSumaRedondeos (10^308) `mod` (10^10)  ==  123839487

limiteSumaRedondeos 2000 == 1999

limiteSumaRedondeos 2016 == 2016

limiteSumaRedondeos (10^308) `mod` (10^10) == 123839487

Soluciones

-- 1ª definición
-- =============

sumaRedondeos1 :: Integer -> [Integer]
sumaRedondeos1 n =
    [sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer
limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer
limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición
sumaRedondeos2 :: Integer -> [Integer]
sumaRedondeos2 n =
    scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]
    where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer
limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición
sumaRedondeos3 :: Integer -> [Integer]
sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))
    where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)
          n'      = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer
limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición
sumaRedondeos4 :: Integer -> [Integer]
sumaRedondeos4 n = xs ++ repeat x
    where n' = fromIntegral n
          m  = round (logBase 2 n')
          xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
          x  = last xs

limiteSumaRedondeos4 :: Integer -> Integer
limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia
--    λ> (sumaRedondeos1 4) !! 20000
--    3
--    (0.92 secs, 197,782,232 bytes)
--    λ> (sumaRedondeos1 4) !! 30000
--    3
--    (2.20 secs, 351,084,816 bytes)
--    λ> (sumaRedondeos3 4) !! 20000
--    3
--    (0.30 secs, 53,472,392 bytes)
--    λ> (sumaRedondeos4 4) !! 20000
--    3
--    (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición
sumaRedondeos :: Integer -> [Integer]
sumaRedondeos = sumaRedondeos3

-- 5ª definición
-- =============

limiteSumaRedondeos5 :: Integer -> Integer
limiteSumaRedondeos5 n = 
    sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]
    where n' = fromIntegral n
          m  = round (logBase 2 n')

-- 1ª definición

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

sumaRedondeos1 :: Integer -> [Integer]

sumaRedondeos1 n =

[sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]] | m <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos1 :: Integer -> Integer

limiteSumaRedondeos1 = limite . sumaRedondeos1

limite :: [Integer] -> Integer

limite xs = head [x | (x,y) <- zip xs (tail xs), x == y]

-- 2ª definición

sumaRedondeos2 :: Integer -> [Integer]

sumaRedondeos2 n =

scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..]]

where n' = fromIntegral n

limiteSumaRedondeos2 :: Integer -> Integer

limiteSumaRedondeos2 = limite . sumaRedondeos2

-- 3ª definición

sumaRedondeos3 :: Integer -> [Integer]

sumaRedondeos3 n = map fst (iterate f (round (n'/2),4))

where f (s,d) = (s + round (n'/(fromIntegral d)), 2*d)

n' = fromIntegral n

limiteSumaRedondeos3 :: Integer -> Integer

limiteSumaRedondeos3 = limite . sumaRedondeos3

-- 4ª definición

sumaRedondeos4 :: Integer -> [Integer]

sumaRedondeos4 n = xs ++ repeat x

where n' = fromIntegral n

m = round (logBase 2 n')

xs = scanl1 (+) [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

x = last xs

limiteSumaRedondeos4 :: Integer -> Integer

limiteSumaRedondeos4 = limite . sumaRedondeos4

-- Comparación de eficiencia

-- λ> (sumaRedondeos1 4) !! 20000

-- 3

-- (0.92 secs, 197,782,232 bytes)

-- λ> (sumaRedondeos1 4) !! 30000

-- 3

-- (2.20 secs, 351,084,816 bytes)

-- λ> (sumaRedondeos3 4) !! 20000

-- 3

-- (0.30 secs, 53,472,392 bytes)

-- λ> (sumaRedondeos4 4) !! 20000

-- 3

-- (0.01 secs, 0 bytes)

-- En lo que sigue, usaremos la 3ª definición

sumaRedondeos :: Integer -> [Integer]

sumaRedondeos = sumaRedondeos3

-- 5ª definición

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

limiteSumaRedondeos5 :: Integer -> Integer

limiteSumaRedondeos5 n =

sum [round (n'/(fromIntegral (2^k))) | k <- [1..m]]

where n' = fromIntegral n

m = round (logBase 2 n')

Rotaciones de un número

PorJosé A. Alonso 30-abril-20157-mayo-2015

Definir la función

   rotacionesNumero :: Integer -> [Integer]

1	rotacionesNumero :: Integer -> [Integer]

(rotacionesNumero n) es la lista de las rotaciones obtenidas desplazando el primer dígito de n al final. Por ejemplo,

   rotacionesNumero 325  ==  [325,253,532]

1	rotacionesNumero 325 == [325,253,532]

Soluciones

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

rotacionesNumero1 :: Integer -> [Integer]
rotacionesNumero1 n = [read xs | xs <- rotaciones (show n)]

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando
-- el primer elemento xs al final. Por ejemplo,
--    rotaciones [2,3,5]  ==  [[2,3,5],[3,5,2],[5,2,3]]
rotaciones :: [a] -> [[a]]
rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al
-- final. Por ejemplo, 
--    rota [3,2,5,7]  ==  [2,5,7,3]
rota :: [a] -> [a]
rota (x:xs) = xs ++ [x]

-- 2ª definición (con map)
-- =======================

rotacionesNumero2 :: Integer -> [Integer]
rotacionesNumero2 n = map read (rotaciones (show n))

-- 3ª definición (sin argumentos)
-- ==============================

rotacionesNumero3 :: Integer -> [Integer]
rotacionesNumero3 = map read . rotaciones . show

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

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

rotacionesNumero1 :: Integer -> [Integer]

rotacionesNumero1 n = [read xs | xs <- rotaciones (show n)]

-- (rotaciones xs) es la lista de las rotaciones obtenidas desplazando

-- el primer elemento xs al final. Por ejemplo,

-- rotaciones [2,3,5] == [[2,3,5],[3,5,2],[5,2,3]]

rotaciones :: [a] -> [[a]]

rotaciones xs = take (length xs) (iterate rota xs)

-- (rota xs) es la lista añadiendo el primer elemento de xs al

-- final. Por ejemplo,

-- rota [3,2,5,7] == [2,5,7,3]

rota :: [a] -> [a]

rota (x:xs) = xs ++ [x]

-- 2ª definición (con map)

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

rotacionesNumero2 :: Integer -> [Integer]

rotacionesNumero2 n = map read (rotaciones (show n))

-- 3ª definición (sin argumentos)

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

rotacionesNumero3 :: Integer -> [Integer]

rotacionesNumero3 = map read . rotaciones . show

Distancia invierte y suma hasta capicúa

PorJosé A. Alonso 27-abril-20151-mayo-2016

Un número es capicúa si es igual leído de izquierda a derecha que de derecha a izquierda; por ejemplo, el 4884.

El transformado «invierte y suma» de un número x es la suma de x y su número invertido; es decir, el número resultante de la inversión del orden en el que aparecen sus dígitos. Por ejemplo, el transformado de 124 es 124 + 421 = 545.

Se aplica la transformación «invierte y suma» hasta obtener un capicúa. Por ejemplo, partiendo del número 87, el proceso es

     87 +   78 =  165 
    165 +  561 =  726 
    726 +  627 = 1353 
   1353 + 3531 = 4884

87 + 78 = 165

165 + 561 = 726

726 + 627 = 1353

1353 + 3531 = 4884

El número de pasos de dicho proceso es la distancia capicúa del número; por ejemplo, la distancia capicúa de 87 es 4.

Definir la función

   distanciaIS :: Integer -> Integer

1	distanciaIS :: Integer -> Integer

tal que (distanciaIS x) es la distancia capicúa de x. Por ejemplo,

   distanciaIS 11                   ==    0
   distanciaIS 10                   ==    1
   distanciaIS 19                   ==    2
   distanciaIS 59                   ==    3
   distanciaIS 69                   ==    4
   distanciaIS 166                  ==    5
   distanciaIS 79                   ==    6
   distanciaIS 89                   ==   24
   distanciaIS 10911                ==   55
   distanciaIS 1000000079994144385  ==  259

distanciaIS 11 == 0

distanciaIS 10 == 1

distanciaIS 19 == 2

distanciaIS 59 == 3

distanciaIS 69 == 4

distanciaIS 166 == 5

distanciaIS 79 == 6

distanciaIS 89 == 24

distanciaIS 10911 == 55

distanciaIS 1000000079994144385 == 259

Soluciones

import Data.List (genericLength)

-- 1ª solución (por recursión)
-- ===========================

distanciaIS1 :: Integer -> Integer
distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por
-- ejemplo, 
--    cadena 87  ==  [87,165,726,1353]
cadena :: Integer -> [Integer]
cadena x | esCapicua x = []
         | otherwise   = x : cadena (transformadoIS x)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 42524  ==  True
--    esCapicua 42542  ==  False
esCapicua :: Integer -> Bool
esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los
-- mismos dígitos que x pero en orden inverso. Por ejemplo,
--    transformadoIS 1325  ==  6556
--    transformadoIS 1375  ==  7106
transformadoIS :: Integer -> Integer
transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)
distanciaIS2 :: Integer -> Integer
distanciaIS2 x = aux x 0
    where aux x n | esCapicua x = n
                  | otherwise   = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)
distanciaIS3 :: Integer -> Integer
distanciaIS3 =
    genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

import Data.List (genericLength)

-- 1ª solución (por recursión)

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

distanciaIS1 :: Integer -> Integer

distanciaIS1 = genericLength . cadena

-- (cadena x) es la lista de transformados de x que no son capicúas. Por

-- ejemplo,

-- cadena 87 == [87,165,726,1353]

cadena :: Integer -> [Integer]

cadena x | esCapicua x = []

| otherwise = x : cadena (transformadoIS x)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 42524 == True

-- esCapicua 42542 == False

esCapicua :: Integer -> Bool

esCapicua x = show x == reverse (show x)

-- (transformadoIS x) es el número obtenido sumándole a x el número con los

-- mismos dígitos que x pero en orden inverso. Por ejemplo,

-- transformadoIS 1325 == 6556

-- transformadoIS 1375 == 7106

transformadoIS :: Integer -> Integer

transformadoIS x = x + read (reverse (show x))

-- 2ª solución (por recursión con contador)

distanciaIS2 :: Integer -> Integer

distanciaIS2 x = aux x 0

where aux x n | esCapicua x = n

| otherwise = aux (transformadoIS x) (n+1)

-- 3ª solución (con iterate)

distanciaIS3 :: Integer -> Integer

distanciaIS3 =

genericLength . takeWhile (not . esCapicua) . iterate transformadoIS

Números de suma prima hereditarios por la derecha

PorJosé A. Alonso 27-marzo-20151-mayo-2015

Decimos que un número es de suma prima si la suma de todos sus dígitos es un número primo. Por ejemplo el número 562 es de suma prima pues la suma de sus dígitos es el número primo 13; sin embargo, el número 514 no es de suma prima pues la suma de sus dígitos es 10, que no es primo.

Decimos que un número es de suma prima hereditario por la derecha si es de suma prima y los números que se obtienen eliminando sus últimas cifras también son de suma prima. Por ejemplo 7426 es de suma prima hereditario por la derecha pues 7426, 742, 74 y 7 son todos números de suma prima.

Definir la constante

   listaSumaPrimaHD :: [Integer]

1	listaSumaPrimaHD :: [Integer]

cuyo valor es la lista infinita de los números de suma prima hereditarios por la derecha. Por ejemplo,

   take 10 listaSumaPrimaHD     ==  [2,3,5,7,20,21,23,25,29,30]
   listaSumaPrimaHD !! 2000000  ==  3800024668046

1 2	take 10 listaSumaPrimaHD == [2,3,5,7,20,21,23,25,29,30] listaSumaPrimaHD !! 2000000 == 3800024668046

Soluciones

import Data.Char (digitToInt)
import Data.Array
import Data.Numbers.Primes (isPrime)

-- 1ª definición
-- =============

listaSumaPrimaHD1 :: [Integer]
listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la
-- derecha. Por ejemplo,
--    sumaPrimaHD 7426  ==  True
--    sumaPrimaHD 7427  ==  False
sumaPrimaHD n
    | n < 10    = isPrime n
    | otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por
-- ejemplo, 
--    sumaPrima 562  ==  True
--    sumaPrima 514  ==  False
sumaPrima :: Integer -> Bool
sumaPrima = isPrime . sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos = map (fromIntegral . digitToInt) . show


-- 2ª definición
-- =============

listaSumaPrimaHD2 :: [Integer]
listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]
paresSumaPrimaHDDigitos =
    paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

paresSumaPrimaHDDigitosAux :: Integer -> [(Integer,Integer)] -> 
                              [(Integer,Integer)]
paresSumaPrimaHDDigitosAux n ac =
    ac ++ paresSumaPrimaHDDigitosAux (n+1) 
                                     (concatMap extiendeSumaPrimaHD ac)

extiendeSumaPrimaHD :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

-- 3ª definición
-- =============

listaSumaPrimaHD3 :: [Integer]
listaSumaPrimaHD3 = 
    map fst (concat (iterate (concatMap extiendeSumaPrimaHD3) 
                             [(2,2),(3,3),(5,5),(7,7)]))

extiendeSumaPrimaHD3 :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]
extensiones = array (1,1000) 
              [(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

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

--    ghci> listaSumaPrimaHD1 !! 600
--    34004
--    (2.47 secs, 1565301720 bytes)
--    ghci> listaSumaPrimaHD2 !! 600
--    34004
--    (0.02 secs, 7209000 bytes)
--    ghci> listaSumaPrimaHD3 !! 600
--    34004
--    (0.01 secs, 1579920 bytes)
-- 
--    ghci> listaSumaPrimaHD2 !! 2000000
--    3800024668046
--    (45.41 secs, 29056613824 bytes)
--    ghci> listaSumaPrimaHD3 !! 2000000
--    3800024668046
--    (4.29 secs, 973265400 bytes)

import Data.Char (digitToInt)

import Data.Array

import Data.Numbers.Primes (isPrime)

-- 1ª definición

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

listaSumaPrimaHD1 :: [Integer]

listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la

-- derecha. Por ejemplo,

-- sumaPrimaHD 7426 == True

-- sumaPrimaHD 7427 == False

sumaPrimaHD n

| n < 10 = isPrime n

| otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por

-- ejemplo,

-- sumaPrima 562 == True

-- sumaPrima 514 == False

sumaPrima :: Integer -> Bool

sumaPrima = isPrime . sum . digitos

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

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos = map (fromIntegral . digitToInt) . show

-- 2ª definición

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

listaSumaPrimaHD2 :: [Integer]

listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]

paresSumaPrimaHDDigitos =

paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

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

[(Integer,Integer)]

paresSumaPrimaHDDigitosAux n ac =

ac ++ paresSumaPrimaHDDigitosAux (n+1)

(concatMap extiendeSumaPrimaHD ac)

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

extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

-- 3ª definición

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

listaSumaPrimaHD3 :: [Integer]

listaSumaPrimaHD3 =

map fst (concat (iterate (concatMap extiendeSumaPrimaHD3)

[(2,2),(3,3),(5,5),(7,7)]))

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

extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]

extensiones = array (1,1000)

[(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

-- Comparación de eficiencia

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

-- ghci> listaSumaPrimaHD1 !! 600

-- 34004

-- (2.47 secs, 1565301720 bytes)

-- ghci> listaSumaPrimaHD2 !! 600

-- 34004

-- (0.02 secs, 7209000 bytes)

-- ghci> listaSumaPrimaHD3 !! 600

-- 34004

-- (0.01 secs, 1579920 bytes)

-- ghci> listaSumaPrimaHD2 !! 2000000

-- 3800024668046

-- (45.41 secs, 29056613824 bytes)

-- ghci> listaSumaPrimaHD3 !! 2000000

-- 3800024668046

-- (4.29 secs, 973265400 bytes)

Mayor sucesión del problema 3n+1

PorJosé A. Alonso 20-junio-20141-mayo-2016

Enunciado

-- La sucesión 3n+1 generada por un número entero positivo x es la
-- sucesión generada por el siguiente algoritmo: Se empieza con el
-- número x. Si x es par, se divide entre 2. Si x es impar, se
-- multiplica por 3 y se le suma 1. El  proceso se repite con el número
-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de
-- números generadas cuando se empieza en 22 es
--    22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre
-- alcanza el 1 empezando en cualquier entero positivo.
-- 
-- Definir la función
--    mayorLongitud :: Integer -> Integer -> Integer
-- tal que (mayorLongitud i j) es el máximo de las longitudes de las
-- sucesiones 3n+1 para todos los números comprendidos entre i y j,
-- ambos inclusives. Por ejemplo,
--    mayorLongitud   1   10  ==  20
--    mayorLongitud 100  200  ==  125
--    mayorLongitud 201  210  ==  89
--    mayorLongitud 900 1000  ==  174

-- La sucesión 3n+1 generada por un número entero positivo x es la

-- sucesión generada por el siguiente algoritmo: Se empieza con el

-- número x. Si x es par, se divide entre 2. Si x es impar, se

-- multiplica por 3 y se le suma 1. El proceso se repite con el número

-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de

-- números generadas cuando se empieza en 22 es

-- 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1

-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre

-- alcanza el 1 empezando en cualquier entero positivo.

-- Definir la función

-- mayorLongitud :: Integer -> Integer -> Integer

-- tal que (mayorLongitud i j) es el máximo de las longitudes de las

-- sucesiones 3n+1 para todos los números comprendidos entre i y j,

-- ambos inclusives. Por ejemplo,

-- mayorLongitud 1 10 == 20

-- mayorLongitud 100 200 == 125

-- mayorLongitud 201 210 == 89

-- mayorLongitud 900 1000 == 174

Soluciones

-- 1ª solución
-- ===========

mayorLongitud1 :: Int -> Int -> Int
mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion :: Int -> [Int]
sucesion 1 = [1]
sucesion n | even n    = n : sucesion (n `div` 2)
           | otherwise = n : sucesion (3*n+1)

-- 2ª solución
-- ===========

mayorLongitud2 :: Int -> Int -> Int
mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por
-- ejemplo, 
--    longitud 22  ==  16
longitud :: Int -> Int
longitud 1 = 1
longitud n | even n    = 1 + longitud (n `div` 2)
           | otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)
-- =========================

mayorLongitud3 :: Int -> Int -> Int
mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion2 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion2 :: Int -> [Int]
sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]
    where f x | even x    = x `div` 2
              | otherwise = 3*x+1

-- 1ª solución

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

mayorLongitud1 :: Int -> Int -> Int

mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion :: Int -> [Int]

sucesion 1 = [1]

sucesion n | even n = n : sucesion (n `div` 2)

| otherwise = n : sucesion (3*n+1)

-- 2ª solución

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

mayorLongitud2 :: Int -> Int -> Int

mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por

-- ejemplo,

-- longitud 22 == 16

longitud :: Int -> Int

longitud 1 = 1

longitud n | even n = 1 + longitud (n `div` 2)

| otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)

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

mayorLongitud3 :: Int -> Int -> Int

mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion2 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion2 :: Int -> [Int]

sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]

where f x | even x = x `div` 2

| otherwise = 3*x+1

Referencia

El ejercicio está basado en The 3n + 1 problem de UVa Online Judge.

Órbita prima

PorJosé A. Alonso 13-junio-20141-mayo-2016

Enunciado

-- La órbita prima de un número n es la sucesión construida de la
-- siguiente forma: 
--    * si n es compuesto su órbita no tiene elementos 
--    * si n es primo, entonces n está en su órbita; además, sumamos n y
--      sus dígitos, si el resultado es un número primo repetimos el
--      proceso hasta obtener un número compuesto. 
-- Por ejemplo, con el 11 podemos repetir el proceso dos veces
--    13 = 11+1+1
--    17 = 13+1+3
-- Así, la órbita prima de 11 es 11, 13, 17. 
-- 
-- Definir la función
--    orbita :: Integer -> [Integer]
-- tal que (orbita n) es la órbita prima de n. Por ejemplo,
--    orbita 11 == [11,13,17]
--    orbita 59 == [59,73,83]
-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

-- La órbita prima de un número n es la sucesión construida de la

-- siguiente forma:

-- * si n es compuesto su órbita no tiene elementos

-- * si n es primo, entonces n está en su órbita; además, sumamos n y

-- sus dígitos, si el resultado es un número primo repetimos el

-- proceso hasta obtener un número compuesto.

-- Por ejemplo, con el 11 podemos repetir el proceso dos veces

-- 13 = 11+1+1

-- 17 = 13+1+3

-- Así, la órbita prima de 11 es 11, 13, 17.

-- Definir la función

-- orbita :: Integer -> [Integer]

-- tal que (orbita n) es la órbita prima de n. Por ejemplo,

-- orbita 11 == [11,13,17]

-- orbita 59 == [59,73,83]

-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

Soluciones

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

orbita1 :: Integer -> [Integer]
orbita1 n | not (esPrimo n) = []
          | otherwise       = n : orbita1 (n + sum (cifras n))

esPrimo :: Integer -> Bool
esPrimo n = [x | x <- [1..n], n `rem` x == 0] == [1,n] 

cifras :: Integer -> [Integer]
cifras n = [read [x]| x <- show n]

-- El cálculo es
--    ghci> head [x | x <- [1,3..], length (orbita x) > 3]
--    277
-- 
--    ghci> orbita 277
--    [277,293,307,317]

-- 2ª definición (con iterate)
-- ===========================

orbita2 :: Integer -> [Integer]
orbita2 n = takeWhile esPrimo (iterate f n)
    where f x = x + sum (cifras x)

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

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

orbita1 :: Integer -> [Integer]

orbita1 n | not (esPrimo n) = []

| otherwise = n : orbita1 (n + sum (cifras n))

esPrimo :: Integer -> Bool

esPrimo n = [x | x <- [1..n], n `rem` x == 0] == [1,n]

cifras :: Integer -> [Integer]

cifras n = [read [x]| x <- show n]

-- El cálculo es

-- ghci> head [x | x <- [1,3..], length (orbita x) > 3]

-- 277

-- ghci> orbita 277

-- [277,293,307,317]

-- 2ª definición (con iterate)

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

orbita2 :: Integer -> [Integer]

orbita2 n = takeWhile esPrimo (iterate f n)

where f x = x + sum (cifras x)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Solución en Maxima

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico