febrero 2018 – Exercitium

Números cuyos factoriales son divisibles por x pero no por y

PorJosé A. Alonso 28-febrero-20187-marzo-2018

Hay 3 números (el 2, 3 y 4) cuyos factoriales son divisibles por 2 pero no por 5. Análogamente, hay números 5 (el 5, 6, 7, 8, 9) cuyos factoriales son divisibles por 15 pero no por 25.

Definir la función

   nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

1	nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

tal que (nNumerosConFactorialesDivisibles x y) es la cantidad de números cuyo factorial es divisible por x pero no por y. Por ejemplo,

  nNumerosConFactorialesDivisibles 2   5     ==  3
  nNumerosConFactorialesDivisibles 15  25    ==  5
  nNumerosConFactorialesDivisibles 100 2000  ==  5

nNumerosConFactorialesDivisibles 2 5 == 3

nNumerosConFactorialesDivisibles 15 25 == 5

nNumerosConFactorialesDivisibles 100 2000 == 5

Soluciones

import Data.List (genericLength)

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

nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer
nNumerosConFactorialesDivisibles x y =
  genericLength (numerosConFactorialesDivisibles x y)

-- (numerosConFactorialesDivisibles x y) es la lista de números
-- divisibles por el factorial de x pero no divisibles por el 
-- factorial de y. Por ejemplo,
--   numerosConFactorialesDivisibles 2  5   ==  [2,3,4]
--   numerosConFactorialesDivisibles 15 25  ==  [5,6,7,8,9]
numerosConFactorialesDivisibles :: Integer -> Integer -> [Integer]
numerosConFactorialesDivisibles x y =
  [z | z <- [0..y-1]
     , factorial z `mod` x == 0
     , factorial z `mod` y /= 0]

-- (factorial n) es el factorial de n. Por ejemplo, 
--   factorial 4  ==  24
factorial :: Integer -> Integer
factorial n = product [1..n]

-- 2ª solución (usando la función de Smarandache)
-- ==============================================

nNumerosConFactorialesDivisibles2 :: Integer -> Integer -> Integer
nNumerosConFactorialesDivisibles2 x y =
  max 0 (smarandache y - smarandache x)

--(smarandache n) es el menor número cuyo factorial es divisible por
-- n. Por ejemplo,   
--    smarandache 8   ==  4
--    smarandache 10  ==  5
--    smarandache 16  ==  6
smarandache :: Integer -> Integer
smarandache x =
  head [n | (n,y) <- zip [0..] factoriales
          , y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    λ> take 12 factoriales
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

-- Comparación de eficiencia
--    λ> nNumerosConFactorialesDivisibles 100 2000
--    5
--    (2.70 secs, 3,933,938,648 bytes)
--    λ> nNumerosConFactorialesDivisibles2 100 2000
--    5
--    (0.01 secs, 148,200 bytes)

import Data.List (genericLength)

-- 1ª solución

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

nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

nNumerosConFactorialesDivisibles x y =

genericLength (numerosConFactorialesDivisibles x y)

-- (numerosConFactorialesDivisibles x y) es la lista de números

-- divisibles por el factorial de x pero no divisibles por el

-- factorial de y. Por ejemplo,

-- numerosConFactorialesDivisibles 2 5 == [2,3,4]

-- numerosConFactorialesDivisibles 15 25 == [5,6,7,8,9]

numerosConFactorialesDivisibles :: Integer -> Integer -> [Integer]

numerosConFactorialesDivisibles x y =

[z | z <- [0..y-1]

, factorial z `mod` x == 0

, factorial z `mod` y /= 0]

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 4 == 24

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 2ª solución (usando la función de Smarandache)

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

nNumerosConFactorialesDivisibles2 :: Integer -> Integer -> Integer

nNumerosConFactorialesDivisibles2 x y =

max 0 (smarandache y - smarandache x)

--(smarandache n) es el menor número cuyo factorial es divisible por

-- n. Por ejemplo,

-- smarandache 8 == 4

-- smarandache 10 == 5

-- smarandache 16 == 6

smarandache :: Integer -> Integer

smarandache x =

head [n | (n,y) <- zip [0..] factoriales

, y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo,

-- λ> take 12 factoriales

-- [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

-- Comparación de eficiencia

-- λ> nNumerosConFactorialesDivisibles 100 2000

-- 5

-- (2.70 secs, 3,933,938,648 bytes)

-- λ> nNumerosConFactorialesDivisibles2 100 2000

-- 5

-- (0.01 secs, 148,200 bytes)

La función de Smarandache

PorJosé A. Alonso 27-febrero-20186-marzo-2018

La función de Smarandache, también conocida como la función de Kempner, es la función que asigna a cada número entero positivo n el menor número cuyo factorial es divisible por n y se representa por S(n). Por ejemplo, el número 8 no divide a 1!, 2!, 3!, pero sí divide 4!; por tanto, S(8) = 4.

Definir las funciones

   smarandache        :: Integer -> Integer
   graficaSmarandache :: Integer -> IO ()

1 2	smarandache :: Integer -> Integer graficaSmarandache :: Integer -> IO ()

tales que

(smarandache n) es el menor número cuyo factorial es divisible por n. Por ejemplo,

     smarandache 8   ==  4
     smarandache 10  ==  5
     smarandache 16  ==  6

smarandache 8 == 4

smarandache 10 == 5

smarandache 16 == 6

(graficaSmarandache n) dibuja la gráfica de los n primeros términos de la sucesión de Smarandache. Por ejemplo, (graficaSmarandache 100) dibuja

(graficaSmarandache 500) dibuja

Soluciones

import Data.List (genericLength)
import Graphics.Gnuplot.Simple

smarandache :: Integer -> Integer
smarandache x =
  head [n | (n,y) <- zip [0..] factoriales
          , y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    λ> take 12 factoriales
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

graficaSmarandache :: Integer -> IO ()
graficaSmarandache n =
  plotList [Key Nothing
           , PNG ("La_funcion_de_Smarandache_" ++ show n ++ ".png")
           ]
           (map smarandache [1..n])

import Data.List (genericLength)

import Graphics.Gnuplot.Simple

smarandache :: Integer -> Integer

smarandache x =

head [n | (n,y) <- zip [0..] factoriales

, y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo,

-- λ> take 12 factoriales

-- [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

graficaSmarandache :: Integer -> IO ()

graficaSmarandache n =

plotList [Key Nothing

, PNG ("La_funcion_de_Smarandache_" ++ show n ++ ".png")

]

(map smarandache [1..n])

Generación de progresiones geométricas

PorJosé A. Alonso 26-febrero-20186-marzo-2018

Definir la función

   geometrica :: Int -> Int -> Int -> [Int]

1	geometrica :: Int -> Int -> Int -> [Int]

tal que (geometrica a b c) es la lista de los términos de la progresión geométrica cuyo primer término es a, su segundo término es b (que se supone que es múltiplo de a) y los términos son menores o iguales que c. Por ejemplo,

   geometrica 1 3  27   ==  [1,3,9,27]
   geometrica 2 6  100  ==  [2,6,18,54]
   geometrica 3 12 57   ==  [3,12,48]
   geometrica 4 20 253  ==  [4,20,100]
   geometrica 5 25 625  ==  [5,25,125,625]
   geometrica 6 42 42   ==  [6,42]

geometrica 1 3 27 == [1,3,9,27]

geometrica 2 6 100 == [2,6,18,54]

geometrica 3 12 57 == [3,12,48]

geometrica 4 20 253 == [4,20,100]

geometrica 5 25 625 == [5,25,125,625]

geometrica 6 42 42 == [6,42]

Soluciones

-- 1ª definición
geometrica :: Int -> Int -> Int -> [Int]
geometrica a b c =
  takeWhile (<=c) (iterate (*r) a)
  where r = b `div` a

-- 2ª definición
geometrica2 :: Int -> Int -> Int -> [Int]
geometrica2 a b c = aux a b 
  where aux a b 
          | a > c     = []
          | otherwise = a : aux b (b * r)
        r = b `div` a

-- 1ª definición

geometrica :: Int -> Int -> Int -> [Int]

geometrica a b c =

takeWhile (<=c) (iterate (*r) a)

where r = b `div` a

-- 2ª definición

geometrica2 :: Int -> Int -> Int -> [Int]

geometrica2 a b c = aux a b

where aux a b

| a > c = []

| otherwise = a : aux b (b * r)

r = b `div` a

Ceros con los n primeros números

PorJosé A. Alonso 23-febrero-20182-marzo-2018

Los números del 1 al 3 se pueden escribir de dos formas, con el signo más o menos entre ellos, tales que su suma sea 0:

    1+2-3 = 0
   -1-2+3 = 0

1 2	1+2-3 = 0 -1-2+3 = 0

Definir la función

   ceros :: Int -> [[Int]]

1	ceros :: Int -> [[Int]]

tal que (ceros n) son las posibles formas de obtener cero sumando los números del 1 al n, con el signo más o menos entre ellos. Por ejemplo,

   ceros 3           ==  [[1,2,-3],[-1,-2,3]]
   ceros 4           ==  [[1,-2,-3,4],[-1,2,3,-4]]
   ceros 5           ==  []
   length (ceros 7)  ==  8
   take 3 (ceros 7)  ==  [[1,2,-3,4,-5,-6,7],[1,2,-3,-4,5,6,-7],[1,-2,3,4,-5,6,-7]]

ceros 3 == [[1,2,-3],[-1,-2,3]]

ceros 4 == [[1,-2,-3,4],[-1,2,3,-4]]

ceros 5 == []

length (ceros 7) == 8

take 3 (ceros 7) == [[1,2,-3,4,-5,-6,7],[1,2,-3,-4,5,6,-7],[1,-2,3,4,-5,6,-7]]

Soluciones

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

ceros :: Int -> [[Int]]
ceros n = [xs | xs <- candidatos n, sum xs == 0]

-- (candidatos n) es la lista de los números del 1 al n con los signos
-- más o menos. Por ejemplo,
--    λ> candidatos 1
--    [[1],[-1]]
--    λ> candidatos 2
--    [[1,2],[1,-2],[-1,2],[-1,-2]]
--    λ> candidatos 3
--    [[1,2,3],[1,2,-3],[1,-2,3],[1,-2,-3],[-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]
candidatos :: Int -> [[Int]]
candidatos n = productoCartesiano [[i,-i] | i <- [1..n]]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo, 
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

ceros2 :: Int -> [[Int]]
ceros2 n = [xs | xs <- candidatos2 n, sum xs == 0]

candidatos2 :: Int -> [[Int]]
candidatos2 n = mapM (\i -> [i,-i]) [1..n]

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

ceros3 :: Int -> [[Int]]
ceros3 n = [xs | xs <- mapM (\i -> [i,-i]) [1..n], sum xs == 0]

-- 4ª solución
-- ===========

ceros4 :: Integer -> [[Integer]]
ceros4 = map fst
       . filter ((==0) . snd)
       . sumas

-- (sumas n) es la lista de las candidatos con los n primeros números y
-- sus sumas. Por ejemplo,
--    λ> sumas 2
--    [([1,2],3),([-1,2],1),([1,-2],-1),([-1,-2],-3)]
--    λ> sumas 3
--    [([1,2,3],6),([-1,2,3],4),([1,-2,3],2),([-1,-2,3],0),([1,2,-3],0),
--     ([-1,2,-3],-2),([1,-2,-3],-4),([-1,-2,-3],-6)]
sumas :: Integer -> [([Integer],Integer)]
sumas = foldr aux [([], 0)]
      . enumFromTo 1
  where
    aux n = concatMap (\(ns', s') -> [(n : ns', s' + n), (-n : ns', s' - n)])

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

--    λ> length (ceros 18)
--    0
--    (4.14 secs, 1,094,854,776 bytes)
--    λ> length (ceros2 18)
--    0
--    (1.16 secs, 375,541,680 bytes)
--    λ> length (ceros3 18)
--    0
--    (1.13 secs, 375,540,192 bytes)
--    λ> length (ceros4 18)
--    0
--    (0.69 secs, 157,316,688 bytes)

-- 1ª solución

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

ceros :: Int -> [[Int]]

ceros n = [xs | xs <- candidatos n, sum xs == 0]

-- (candidatos n) es la lista de los números del 1 al n con los signos

-- más o menos. Por ejemplo,

-- λ> candidatos 1

-- [[1],[-1]]

-- λ> candidatos 2

-- [[1,2],[1,-2],[-1,2],[-1,-2]]

-- λ> candidatos 3

-- [[1,2,3],[1,2,-3],[1,-2,3],[1,-2,-3],[-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]

candidatos :: Int -> [[Int]]

candidatos n = productoCartesiano [[i,-i] | i <- [1..n]]

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[1,3],[2,5],[6,4]]

-- [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 2ª solución

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

ceros2 :: Int -> [[Int]]

ceros2 n = [xs | xs <- candidatos2 n, sum xs == 0]

candidatos2 :: Int -> [[Int]]

candidatos2 n = mapM (\i -> [i,-i]) [1..n]

-- 3ª solución

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

ceros3 :: Int -> [[Int]]

ceros3 n = [xs | xs <- mapM (\i -> [i,-i]) [1..n], sum xs == 0]

-- 4ª solución

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

ceros4 :: Integer -> [[Integer]]

ceros4 = map fst

. filter ((==0) . snd)

. sumas

-- (sumas n) es la lista de las candidatos con los n primeros números y

-- sus sumas. Por ejemplo,

-- λ> sumas 2

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

-- λ> sumas 3

-- [([1,2,3],6),([-1,2,3],4),([1,-2,3],2),([-1,-2,3],0),([1,2,-3],0),

-- ([-1,2,-3],-2),([1,-2,-3],-4),([-1,-2,-3],-6)]

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

sumas = foldr aux [([], 0)]

. enumFromTo 1

where

aux n = concatMap (\(ns', s') -> [(n : ns', s' + n), (-n : ns', s' - n)])

-- Comparación de eficiencia

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

-- λ> length (ceros 18)

-- 0

-- (4.14 secs, 1,094,854,776 bytes)

-- λ> length (ceros2 18)

-- 0

-- (1.16 secs, 375,541,680 bytes)

-- λ> length (ceros3 18)

-- 0

-- (1.13 secs, 375,540,192 bytes)

-- λ> length (ceros4 18)

-- 0

-- (0.69 secs, 157,316,688 bytes)

Menor potencia de 2 que comienza por n

PorJosé A. Alonso 22-febrero-201826-marzo-2022

Definir las funciones

   menorPotencia            :: Integer -> (Integer,Integer)
   graficaMenoresExponentes :: Integer -> IO ()

1 2	menorPotencia :: Integer -> (Integer,Integer) graficaMenoresExponentes :: Integer -> IO ()

tales que

(menorPotencia n) es el par (k,m) donde m es la menor potencia de 2 que empieza por n y k es su exponentes (es decir, 2^k = m). Por ejemplo,

     menorPotencia 3             ==  (5,32)
     menorPotencia 7             ==  (46,70368744177664)
     fst (menorPotencia 982)     ==  3973
     fst (menorPotencia 32627)   ==  28557
     fst (menorPotencia 158426)  ==  40000

menorPotencia 3 == (5,32)

menorPotencia 7 == (46,70368744177664)

fst (menorPotencia 982) == 3973

fst (menorPotencia 32627) == 28557

fst (menorPotencia 158426) == 40000

(graficaMenoresExponentes n) dibuja la gráfica de los exponentes de 2 en las menores potencias de los n primeros números enteros positivos. Por ejemplo, (graficaMenoresExponentes 200) dibuja

Soluciones

import Data.List               (isPrefixOf)
import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

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

menorPotencia :: Integer -> (Integer,Integer)
menorPotencia n =
  head [(k,m) | (k,m) <- zip [0..] potenciasDe2
              , cs `isPrefixOf` show m]
  where cs = show n

-- potenciasDe 2 es la lista de las potencias de dos. Por ejemplo,
--    take 12 potenciasDe2  ==  [1,2,4,8,16,32,64,128,256,512,1024,2048]
potenciasDe2 :: [Integer]
potenciasDe2 = iterate (*2) 1

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

menorPotencia2 :: Integer -> (Integer,Integer)
menorPotencia2 n = aux (0,1)
  where aux (k,m) | cs `isPrefixOf` show m = (k,m)
                  | otherwise              = aux (k+1,2*m)
        cs = show n

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

menorPotencia3 :: Integer -> (Integer,Integer)
menorPotencia3 n =
  until (isPrefixOf n1 . show . snd) (\(x,y) -> (x+1,2*y)) (0,1)
  where n1 = show n

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

--    λ> maximum [fst (menorPotencia n) | n <- [1..1000]]
--    3973
--    (3.69 secs, 1,094,923,696 bytes)
--    λ> maximum [fst (menorPotencia2 n) | n <- [1..1000]]
--    3973
--    (5.13 secs, 1,326,382,872 bytes)
--    λ> maximum [fst (menorPotencia3 n) | n <- [1..1000]]
--    3973
--    (4.71 secs, 1,240,498,128 bytes)

graficaMenoresExponentes :: Integer -> IO ()
graficaMenoresExponentes n =
  plotList [ Key Nothing
           , PNG "Menor_potencia_de_2_que_comienza_por_n.png"
           ]
           (map (fst . menorPotencia) [1..n])

import Data.List (isPrefixOf)

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

-- 1ª definición

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

menorPotencia :: Integer -> (Integer,Integer)

menorPotencia n =

head [(k,m) | (k,m) <- zip [0..] potenciasDe2

, cs `isPrefixOf` show m]

where cs = show n

-- potenciasDe 2 es la lista de las potencias de dos. Por ejemplo,

-- take 12 potenciasDe2 == [1,2,4,8,16,32,64,128,256,512,1024,2048]

potenciasDe2 :: [Integer]

potenciasDe2 = iterate (*2) 1

-- 2ª definición

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

menorPotencia2 :: Integer -> (Integer,Integer)

menorPotencia2 n = aux (0,1)

where aux (k,m) | cs `isPrefixOf` show m = (k,m)

| otherwise = aux (k+1,2*m)

cs = show n

-- 3ª definición

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

menorPotencia3 :: Integer -> (Integer,Integer)

menorPotencia3 n =

until (isPrefixOf n1 . show . snd) (\(x,y) -> (x+1,2*y)) (0,1)

where n1 = show n

-- Comparación de eficiencia

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

-- λ> maximum [fst (menorPotencia n) | n <- [1..1000]]

-- 3973

-- (3.69 secs, 1,094,923,696 bytes)

-- λ> maximum [fst (menorPotencia2 n) | n <- [1..1000]]

-- 3973

-- (5.13 secs, 1,326,382,872 bytes)

-- λ> maximum [fst (menorPotencia3 n) | n <- [1..1000]]

-- 3973

-- (4.71 secs, 1,240,498,128 bytes)

graficaMenoresExponentes :: Integer -> IO ()

graficaMenoresExponentes n =

plotList [ Key Nothing

, PNG "Menor_potencia_de_2_que_comienza_por_n.png"

]

(map (fst . menorPotencia) [1..n])

Representación ampliada de matrices dispersas

PorJosé A. Alonso 21-febrero-201828-febrero-2018

En el ejercicio anterior se explicó una representación reducida de las matrices dispersas. A partir del número de columnas y la representación reducida se puede construir la matriz.

Definir la función

   ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a

1	ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a

tal que (ampliada n xss) es la matriz con n columnas cuya representación reducida es xss. Por ejemplo,

   λ> ampliada 3 [[(3,4)],[(2,5)],[]]
   ( 0 0 4 )
   ( 0 5 0 )
   ( 0 0 0 )
   
   λ> ampliada 3 [[],[]]
   ( 0 0 0 )
   ( 0 0 0 )
   
   λ> ampliada 2 [[],[],[]]
   ( 0 0 )
   ( 0 0 )
   ( 0 0 )

λ> ampliada 3 [[(3,4)],[(2,5)],[]]

( 0 0 4 )

( 0 5 0 )

( 0 0 0 )

λ> ampliada 3 [[],[]]

( 0 0 0 )

λ> ampliada 2 [[],[],[]]

( 0 0 )

Soluciones

import Data.Matrix (Matrix, fromLists)
import Data.List   (lookup)

ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a
ampliada n xss =
  fromLists [filaAmpliada n xs | xs <- xss]

-- Se puede redefinir con un argumento
ampliada2 :: Num a => Int -> [[(Int,a)]] -> Matrix a
ampliada2 n = fromLists . map (filaAmpliada n)

-- Se puede redefinir sin argumentos usando las siguientes reducciones
--      fromLists . map (filaAmpliada n)
--    = fromLists . ((map . filaAmpliada) n)
--    = ((fromLists .) . (map . filaAmpliada)) n
--    = ((fromLists .) . map . filaAmpliada) n
ampliada3 :: Num a => Int -> [[(Int,a)]] -> Matrix a
ampliada3 = (fromLists .) . map . filaAmpliada

-- (filaAmpliada n xs) es la fila ampliada de la representación reducida
-- xs de una matriz con n columnas. Por ejemplo, 
--    filaAmpliada 3 [(2,5)]        ==  [0,5,0]
--    filaAmpliada 7 [(2,5),(1,3)]  ==  [3,5,0,0,0,0,0]
filaAmpliada :: Num a => Int -> [(Int,a)] -> [a]
filaAmpliada n xs =
  [f (lookup i xs) | i <- [1..n]]
  where f Nothing  = 0
        f (Just x) = x

import Data.Matrix (Matrix, fromLists)

import Data.List (lookup)

ampliada :: Num a => Int -> [[(Int,a)]] -> Matrix a

ampliada n xss =

fromLists [filaAmpliada n xs | xs <- xss]

-- Se puede redefinir con un argumento

ampliada2 :: Num a => Int -> [[(Int,a)]] -> Matrix a

ampliada2 n = fromLists . map (filaAmpliada n)

-- Se puede redefinir sin argumentos usando las siguientes reducciones

-- fromLists . map (filaAmpliada n)

-- = fromLists . ((map . filaAmpliada) n)

-- = ((fromLists .) . (map . filaAmpliada)) n

-- = ((fromLists .) . map . filaAmpliada) n

ampliada3 :: Num a => Int -> [[(Int,a)]] -> Matrix a

ampliada3 = (fromLists .) . map . filaAmpliada

-- (filaAmpliada n xs) es la fila ampliada de la representación reducida

-- xs de una matriz con n columnas. Por ejemplo,

-- filaAmpliada 3 [(2,5)] == [0,5,0]

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

filaAmpliada :: Num a => Int -> [(Int,a)] -> [a]

filaAmpliada n xs =

[f (lookup i xs) | i <- [1..n]]

where f Nothing = 0

f (Just x) = x

Representación reducida de matrices dispersas

PorJosé A. Alonso 20-febrero-201827-febrero-2018

Una representación reducida de una matriz dispersa es una lista de listas donde cada una de las listas representa una fila de la matriz mediante listas de pares correspondientes a las snúmeros de columnas con valores no nulos de la matriz. Por ejemplo, la representacioń reducida de la matriz

   ( 0 0 4 )
   ( 0 5 0 )
   ( 0 0 0 )

( 0 0 4 )

( 0 5 0 )

( 0 0 0 )

es [[(3,4)],[(2,5)],[]].

Definir la función

   reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]

1	reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]

tal que (reducida p) es la representación reducida de la matriz p. Por ejemplo,

   reducida (fromList 3 3 [0,0,4,0,5,0,0,0,0])  ==  [[(3,4)],[(2,5)],[]]
   reducida (identity 3)  ==  [[(1,1)],[(2,1)],[(3,1)]]
   reducida (zero 9 3)    ==  [[],[],[],[],[],[],[],[],[]]
   reducida (zero 9 4)    ==  [[],[],[],[],[],[],[],[],[]]

reducida (fromList 3 3 [0,0,4,0,5,0,0,0,0]) == [[(3,4)],[(2,5)],[]]

reducida (identity 3) == [[(1,1)],[(2,1)],[(3,1)]]

reducida (zero 9 3) == [[],[],[],[],[],[],[],[],[]]

reducida (zero 9 4) == [[],[],[],[],[],[],[],[],[]]

Soluciones

import Data.Matrix (Matrix, (!), nrows, ncols)

reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]
reducida p =
  [[(j,x) | j <- [1..n], let x = p!(i,j), x /= 0] | i <- [1..m]] 
  where m = nrows p
        n = ncols p

import Data.Matrix (Matrix, (!), nrows, ncols)

reducida :: (Num a, Eq a) => Matrix a -> [[(Int,a)]]

reducida p =

[[(j,x) | j <- [1..n], let x = p!(i,j), x /= 0] | i <- [1..m]]

where m = nrows p

n = ncols p

Matrices dispersas

PorJosé A. Alonso 19-febrero-201826-febrero-2018

Una matriz es dispersa si la mayoriá de sus elementos son ceros. Por ejemplo, la primera de las siguientes matrices es dispersa y la segunda no lo es

   ( 0 0 4 )   ( 0 1 4 )
   ( 0 5 0 )   ( 0 5 1 )
   ( 0 0 0 )

( 0 0 4 ) ( 0 1 4 )

( 0 5 0 ) ( 0 5 1 )

( 0 0 0 )

Usando la librería Data.Matrix, las anteriores matrices se pueden definir por

   ej1, ej2 :: Matrix Int
   ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
   ej2 = fromList 2 3 [0,1,4,0,5,1]

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

La dispersión de una matriz es el cociente entre el número de ceros de la matriz y el producto de sus números de filas y de columnas.

Definir las siguientes funciones

   dispersion :: (Num a, Eq a) => Matrix a -> Double
   esDispersa :: (Num a, Eq a) => Matrix a -> Bool

1 2	dispersion :: (Num a, Eq a) => Matrix a -> Double esDispersa :: (Num a, Eq a) => Matrix a -> Bool

tales que

(dispersion p) es la dispersión de la matriz p. Por ejemplo,

     dispersion ej1              ==  0.7777777777777778
     dispersion ej2              ==  0.3333333333333333
     dispersion (fmap (+1) ej1)  ==  0.0
     dispersion (identity 3)     ==  0.6666666666666666
     dispersion (zero 9 9)       ==  1.0

dispersion ej1 == 0.7777777777777778

dispersion ej2 == 0.3333333333333333

dispersion (fmap (+1) ej1) == 0.0

dispersion (identity 3) == 0.6666666666666666

dispersion (zero 9 9) == 1.0

(esDispersa p) se verifica si la matriz p es dispersa. Por ejemplo,

     esDispersa ej1              ==  True
     esDispersa ej2              ==  False
     esDispersa (fmap (+1) ej1)  ==  False
     esDispersa (identity 3)     ==  True
     esDispersa (zero 9 9)       ==  True

esDispersa ej1 == True

esDispersa ej2 == False

esDispersa (fmap (+1) ej1) == False

esDispersa (identity 3) == True

esDispersa (zero 9 9) == True

Soluciones

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int
ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]
ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double
dispersion p =
  fi nCeros / (fi nrows * fi ncols)
  where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,
--    nCeros ej1  ==  7
--    nCeros ej2  ==  2
nCeros :: (Num a, Eq a) => Matrix a -> Int
nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:
nCeros2 :: (Num a, Eq a) => Matrix a -> Int
nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool
esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:
esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool
esDispersa2 = (> 0.5) . dispersion

import Data.Matrix (Matrix, fromList, nrows, ncols, toList)

ej1, ej2 :: Matrix Int

ej1 = fromList 3 3 [0,0,4,0,5,0,0,0,0]

ej2 = fromList 2 3 [0,1,4,0,5,1]

dispersion :: (Num a, Eq a) => Matrix a -> Double

dispersion p =

fi nCeros / (fi nrows * fi ncols)

where fi f = (fromIntegral . f) p

-- (nCeros p) es el número de ceros de la matriz p. Por ejemplo,

-- nCeros ej1 == 7

-- nCeros ej2 == 2

nCeros :: (Num a, Eq a) => Matrix a -> Int

nCeros p = length (filter (== 0) (toList p))

-- La función anterior se puede definir sin argumentos:

nCeros2 :: (Num a, Eq a) => Matrix a -> Int

nCeros2 = length . filter (== 0) . toList

esDispersa :: (Num a, Eq a) => Matrix a -> Bool

esDispersa p = dispersion p > 0.5

-- La función anterior se puede definir sin argumentos:

esDispersa2 :: (Num a, Eq a) => Matrix a -> Bool

esDispersa2 = (> 0.5) . dispersion

Vértices de un cuadrado

PorJosé A. Alonso 16-febrero-20187-marzo-2018

Definir la función

   esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

1	esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

tal que (esCuadrado p q r s) se verifica si los puntos p, q, r y s son los vértices de un cuadrado. Por ejemplo,

   esCuadrado (0,0) (0,1) (1,1) (1,0)    == True
   esCuadrado (0,0) (2,1) (3,-1) (1, -2) == True
   esCuadrado (0,0) (1,1) (0,1) (1,0)    == True
   esCuadrado (1,1) (1,1) (1,1) (1,1)    == True
   esCuadrado (0,0) (0,2) (3,2) (3,0)    == False
   esCuadrado (0,0) (3,4) (8,4) (5,0)    == False
   esCuadrado (0,0) (0,0) (1,1) (0,0)    == False
   esCuadrado (0,0) (0,0) (1,0) (0,1)    == False
   esCuadrado (0,0) (1,0) (0,1) (-1,-1)  == False

esCuadrado (0,0) (0,1) (1,1) (1,0) == True

esCuadrado (0,0) (2,1) (3,-1) (1, -2) == True

esCuadrado (0,0) (1,1) (0,1) (1,0) == True

esCuadrado (1,1) (1,1) (1,1) (1,1) == True

esCuadrado (0,0) (0,2) (3,2) (3,0) == False

esCuadrado (0,0) (3,4) (8,4) (5,0) == False

esCuadrado (0,0) (0,0) (1,1) (0,0) == False

esCuadrado (0,0) (0,0) (1,0) (0,1) == False

esCuadrado (0,0) (1,0) (0,1) (-1,-1) == False

Soluciones

import Data.List (sort, tails)

esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool
esCuadrado p q r s = and [a == b, b == c, c == d, e == f, a + b == e]
  where [a,b,c,d,e,f] = sort (distancias p q r s)

-- (distancias p q r s) es la lista de los cuadrados de las longitudes
-- de los lados y de las diagonales del cuadrilátero cuyos vértices son
-- los puntos p, q, r y s. Por ejemplo,
--    distancias (0,0) (0,1) (1,1) (1,0)  ==  [1,2,1,1,2,1]
--    distancias (0,0) (3,4) (8,4) (5,0)  ==  [25,80,25,25,20,25]
--    distancias (0,0) (0,2) (3,2) (3,0)  ==  [4,13,9,9,13,4]
--    distancias (0,0) (0,0) (1,1) (0,0)  ==  [0,2,0,2,0,2]
--    distancias (0,0) (0,0) (1,0) (0,1)  ==  [0,1,1,1,1,2]
distancias :: Num a => (a,a) -> (a,a) -> (a,a) -> (a,a) -> [a]
distancias p q r s =
  [l | (h:t) <- tails [p,q,r,s], l <- map (dist h) t]

-- (dist p q) es el cuadrado de la distancia del punto p al q. Por
-- ejemplo,
--    dist (6,4) (3,8)  ==  25
dist :: Num a => (a,a) -> (a,a) -> a
dist (x1,y1) (x2,y2) = (x2-x1)^2 + (y2-y1)^2

import Data.List (sort, tails)

esCuadrado :: (Num a, Ord a) => (a,a) -> (a,a) -> (a,a) -> (a,a) -> Bool

esCuadrado p q r s = and [a == b, b == c, c == d, e == f, a + b == e]

where [a,b,c,d,e,f] = sort (distancias p q r s)

-- (distancias p q r s) es la lista de los cuadrados de las longitudes

-- de los lados y de las diagonales del cuadrilátero cuyos vértices son

-- los puntos p, q, r y s. Por ejemplo,

-- distancias (0,0) (0,1) (1,1) (1,0) == [1,2,1,1,2,1]

-- distancias (0,0) (3,4) (8,4) (5,0) == [25,80,25,25,20,25]

-- distancias (0,0) (0,2) (3,2) (3,0) == [4,13,9,9,13,4]

-- distancias (0,0) (0,0) (1,1) (0,0) == [0,2,0,2,0,2]

-- distancias (0,0) (0,0) (1,0) (0,1) == [0,1,1,1,1,2]

distancias :: Num a => (a,a) -> (a,a) -> (a,a) -> (a,a) -> [a]

distancias p q r s =

[l | (h:t) <- tails [p,q,r,s], l <- map (dist h) t]

-- (dist p q) es el cuadrado de la distancia del punto p al q. Por

-- ejemplo,

-- dist (6,4) (3,8) == 25

dist :: Num a => (a,a) -> (a,a) -> a

dist (x1,y1) (x2,y2) = (x2-x1)^2 + (y2-y1)^2

Números que no son cuadrados

PorJosé A. Alonso 15-febrero-201822-febrero-2018

Definir las funciones

   noCuadrados :: [Integer]
   graficaNoCuadrados :: Integer -> IO ()

1 2	noCuadrados :: [Integer] graficaNoCuadrados :: Integer -> IO ()

tales que

noCuadrados es la lista de los números naturales que no son cuadrados. Por ejemplo,

     λ> take 25 noCuadrados
     [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

1 2	λ> take 25 noCuadrados [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

(graficaNoCuadrados n) dibuja las diferencias entre los n primeros elementos de noCuadrados y sus posiciones. Por ejemplo, (graficaNoCuadrados 300) dibuja

(graficaNoCuadrados 3000) dibuja

(graficaNoCuadrados 30000) dibuja

Comprobar con QuickCheck que el término de noCuadrados en la posición n-1 es (n + floor(1/2 + sqrt(n))).

Soluciones

import Data.List (genericIndex)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

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

noCuadrados :: [Integer]
noCuadrados = aux [0..] cuadrados
  where aux xs (y:ys) = as ++ aux bs ys
          where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]
cuadrados = [x^2 | x <- [0..]]

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

noCuadrados2 :: [Integer]
noCuadrados2 = aux 2 [1..]
  where aux n (_:xs) = ys ++ aux (n+2) zs
          where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados
-- ================================

graficaNoCuadrados :: Integer -> IO ()
graficaNoCuadrados n =
  plotList [ Key Nothing
           , PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")
           ]
           (zipWith (-) noCuadrados [0..n-1])

-- La propiedad es
prop_noCuadrados :: Positive Integer -> Bool
prop_noCuadrados (Positive n) =
  noCuadrados `genericIndex` (n-1) ==
  n + floor (1/2 + sqrt (fromIntegral n))

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

import Data.List (genericIndex)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

noCuadrados :: [Integer]

noCuadrados = aux [0..] cuadrados

where aux xs (y:ys) = as ++ aux bs ys

where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]

cuadrados = [x^2 | x <- [0..]]

-- 2ª definición

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

noCuadrados2 :: [Integer]

noCuadrados2 = aux 2 [1..]

where aux n (_:xs) = ys ++ aux (n+2) zs

where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados

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

graficaNoCuadrados :: Integer -> IO ()

graficaNoCuadrados n =

plotList [ Key Nothing

, PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")

]

(zipWith (-) noCuadrados [0..n-1])

-- La propiedad es

prop_noCuadrados :: Positive Integer -> Bool

prop_noCuadrados (Positive n) =

noCuadrados `genericIndex` (n-1) ==

n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es

-- λ> quickCheck prop_noCuadrados

-- +++ OK, passed 100 tests.

Árboles binarios completos

PorJosé A. Alonso 14-febrero-201821-febrero-2018

Un árbol binario completo es un árbol en el que cada nodo tiene cero o dos hijos. Por ejemplo, el primero de los siguientes árboles es un árbol binario completo pero los otros no lo son

           1              1            1    
         /   \          /   \        / | \ 
        2     3        2     3      2  7  3
       / \            /            / \      
      4   5          4            4   5

1 1 1

/ \ / \ / | \

2 3 2 3 2 7 3

/ \ / / \

4 5 4 4 5

Los árboles se pueden representar mediante el siguiente tipo de datos

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

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

Por ejemplo, los árboles los árboles anteriores se puede representar por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
   ej2 = N 1 [N 2 [N 4 []], N 3 []]
   ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

Definir la función

   esBinarioCompleto :: Arbol t -> Bool

1	esBinarioCompleto :: Arbol t -> Bool

tal que (esBinarioCompleto a) se verifica si a es un árbol binario completo. Por ejemplo,

   esBinarioCompleto ej1  ==  True
   esBinarioCompleto ej2  ==  False
   esBinarioCompleto ej3  ==  False

esBinarioCompleto ej1 == True

esBinarioCompleto ej2 == False

esBinarioCompleto ej3 == False

Soluciones

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

ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]
ej2 = N 1 [N 2 [N 4 []], N 3 []]
ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]
          
esBinarioCompleto :: Arbol t -> Bool
esBinarioCompleto (N _ []) = True
esBinarioCompleto (N x as) = length as `elem` [0,2] 
                             && all esBinarioCompleto as

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N 2 [N 4 []], N 3 []]

ej3 = N 1 [N 2 [N 4 [], N 5 []], N 7 [], N 3 []]

esBinarioCompleto :: Arbol t -> Bool

esBinarioCompleto (N _ []) = True

esBinarioCompleto (N x as) = length as `elem` [0,2]

&& all esBinarioCompleto as

Menor número divisible por 10^n cuyos dígitos suman n

PorJosé A. Alonso 13-febrero-201820-febrero-2018

Definir la función

   menor :: Integer -> Integer

1	menor :: Integer -> Integer

tal que (menor n) es el menor número divisible por 10^n cuyos dígitos suman n. Por ejemplo,

   menor 5   ==  500000
   menor 20  ==  29900000000000000000000

1 2	menor 5 == 500000 menor 20 == 29900000000000000000000

Soluciones

import Data.List (genericLength, genericReplicate)

menor :: Integer -> Integer
menor n = read (show (n-9*a) ++
                genericReplicate a '9' ++
                genericReplicate n '0')
  where a = n `div` 9

import Data.List (genericLength, genericReplicate)

menor :: Integer -> Integer

menor n = read (show (n-9*a) ++

genericReplicate a '9' ++

genericReplicate n '0')

where a = n `div` 9

Números trimórficos

PorJosé A. Alonso 12-febrero-201819-febrero-2018

Un número trimórfico es un número cuyo cubo termina en dicho número. Por ejemplo, 24 es trimórfico ya que 24^3 = 13824 termina en 24.

Para cada entero positivo n, la densidad de trimórficos hasta n es el cociente entre la cantidad de números trimórficos menores o iguales que n y el número n. Por ejemplo, hasta 10 hay 6 números trimórficos (0, 1, 4, 5, 6 y 9); por tanto, la densidad hasta 10 es 6/10 = 0.6.

Definir las funciones

   trimorficos         :: [Integer]
   densidadTrimorficos :: Integer -> Double

1 2	trimorficos :: [Integer] densidadTrimorficos :: Integer -> Double

tal que

trimorficos es la lista de los números trimórficos. Por ejemplo,

     λ> take 20 trimorficos
     [0,1,4,5,6,9,24,25,49,51,75,76,99,125,249,251,375,376,499,501]

1 2	λ> take 20 trimorficos [0,1,4,5,6,9,24,25,49,51,75,76,99,125,249,251,375,376,499,501]

(densidadTrimorficos n) es la densidad de trimórficos hasta n. Por ejemplo,

     densidadTrimorficos 10      ==  0.6
     densidadTrimorficos 100     ==  0.13
     densidadTrimorficos 1000    ==  2.6e-2
     densidadTrimorficos 10000   ==  3.7e-3
     densidadTrimorficos 100000  ==  4.8e-4

densidadTrimorficos 10 == 0.6

densidadTrimorficos 100 == 0.13

densidadTrimorficos 1000 == 2.6e-2

densidadTrimorficos 10000 == 3.7e-3

densidadTrimorficos 100000 == 4.8e-4

Soluciones

import Data.List (genericLength, isPrefixOf)

trimorficos :: [Integer]
trimorficos = filter esTrimorfico [0..]

-- (esTrimorfico n) se verifica si n es trimórfico. Por ejemplo,
--    esTrimorfico 24  ==  True
esTrimorfico :: Integer -> Bool
esTrimorfico n =
  reverse (show n) `isPrefixOf` reverse (show (n^3)) 

densidadTrimorficos :: Integer -> Double
densidadTrimorficos n =
  genericLength [x | x <- [0..n-1], esTrimorfico x] / fromIntegral n

import Data.List (genericLength, isPrefixOf)

trimorficos :: [Integer]

trimorficos = filter esTrimorfico [0..]

-- (esTrimorfico n) se verifica si n es trimórfico. Por ejemplo,

-- esTrimorfico 24 == True

esTrimorfico :: Integer -> Bool

esTrimorfico n =

reverse (show n) `isPrefixOf` reverse (show (n^3))

densidadTrimorficos :: Integer -> Double

densidadTrimorficos n =

genericLength [x | x <- [0..n-1], esTrimorfico x] / fromIntegral n

Períodos de Fibonacci

PorJosé A. Alonso 9-febrero-201819-febrero-2018

Los primeros términos de la sucesión de Fibonacci son

   0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

1	0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

Al calcular sus restos módulo 3 se obtiene

   0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

Se observa que es periódica y su período es

   0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1

Definir las funciones

   fibsMod                   :: Integer -> [Integer]
   periodoFibMod             :: Integer -> [Integer]
   longPeriodosFibMod        :: [Int]
   graficaLongPeriodosFibMod :: Int -> IO ()

fibsMod :: Integer -> [Integer]

periodoFibMod :: Integer -> [Integer]

longPeriodosFibMod :: [Int]

graficaLongPeriodosFibMod :: Int -> IO ()

tales que

(fibsMod n) es la lista de los términos de la sucesión de Fibonacci módulo n. Por ejemplo,

     λ> take 24 (fibsMod 3)
     [0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]
     λ> take 24 (fibsMod 4)
     [0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

λ> take 24 (fibsMod 3)

[0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]

λ> take 24 (fibsMod 4)

[0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

(periodoFibMod n) es la parte perioica de la sucesión de Fibonacci módulo n. Por ejemplo,

     periodoFibMod 3  ==  [0,1,1,2,0,2,2,1]
     periodoFibMod 4  ==  [0,1,1,2,3,1]
     periodoFibMod 7  ==  [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

periodoFibMod 3 == [0,1,1,2,0,2,2,1]

periodoFibMod 4 == [0,1,1,2,3,1]

periodoFibMod 7 == [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

longPeriodosFibMod es la sucesión de las longitudes de los períodos de las sucesiones de Fibonacci módulo n, para n > 0. Por ejemplo,

     λ> take 20 longPeriodosFibMod
     [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

1 2	λ> take 20 longPeriodosFibMod [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

(graficaLongPeriodosFibMod n) dibuja la gráfica de los n primeros términos de la sucesión longPeriodosFibMod. Por ejemplo, (graficaLongPeriodosFibMod n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]
fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,
--    λ> take 20 fibs
--    [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]
periodoFibMod 1 = [0]
periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))
  where aux (0:1:xs) = []
        aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]
longPeriodosFibMod =
  [length (periodoFibMod n) | n <- [1..]]

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

longPeriodosFibMod2 :: [Int]
longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int
longPeriodoFibMod 1 = 1
longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0
  where aux 0 (1 : xs) k = k
        aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()
graficaLongPeriodosFibMod n =
  plotList [ Key Nothing
           , Title ("graficaLongPeriodosFibMod " ++ show n)
           , PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]
           (take n longPeriodosFibMod)

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]

fibsMod n = map (`mod` n) fibs

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

-- λ> take 20 fibs

-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]

periodoFibMod 1 = [0]

periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))

where aux (0:1:xs) = []

aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]

longPeriodosFibMod =

[length (periodoFibMod n) | n <- [1..]]

-- 2ª definición de longPeriodosFibMod

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

longPeriodosFibMod2 :: [Int]

longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int

longPeriodoFibMod 1 = 1

longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0

where aux 0 (1 : xs) k = k

aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()

graficaLongPeriodosFibMod n =

plotList [ Key Nothing

, Title ("graficaLongPeriodosFibMod " ++ show n)

, PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]

(take n longPeriodosFibMod)

Recorrido de árboles en espiral

PorJosé A. Alonso 8-febrero-201825-abril-2021

Los árboles se pueden representar mediante el siguiente tipo de datos

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

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

Por ejemplo, los árboles

         1             1             1  
        /  \          / \           / \ 
       /    \        8   3         8   3
      2      3          /|\       /|\  |
     / \    / \        4 5 6     4 5 6 7
    4   5  6   7

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 3 /|\ /|\ |

/ \ / \ 4 5 6 4 5 6 7

4 5 6 7

se representan por

   ej1, ej2, ej3 :: Arbol Int
   ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
   ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
   ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

Definir la función

   espiral :: Arbol a -> [a]

1	espiral :: Arbol a -> [a]

tal que (espiral x) es la lista de los nodos del árbol x recorridos en espiral; es decir, la raíz de x, los nodos del primer nivel de izquierda a derecha, los nodos del segundo nivel de derecha a izquierda y así sucesivamente. Por ejemplo,

   espiral ej1  ==  [1,2,3,7,6,5,4]
   espiral ej2  ==  [1,8,3,6,5,4]
   espiral ej3  ==  [1,8,3,7,6,5,4]

espiral ej1 == [1,2,3,7,6,5,4]

espiral ej2 == [1,8,3,6,5,4]

espiral ej3 == [1,8,3,7,6,5,4]

Soluciones

data Arbol a = N a [Arbol a]
  deriving Show
           
ej1, ej2, ej3 :: Arbol Int
ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]
ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]
ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

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

espiral :: Arbol a -> [a]
espiral x =
  concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo, 
--    niveles ej1 == [[1],[8,3],[4]]
--    niveles ej2 == [[1],[8,3],[4,5,6]]
--    niveles ej3 == [[1],[8,3],[4,5,6,7]]
niveles :: Arbol a -> [[a]]
niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,
--    nivel 0 ej1  ==  [1]
--    nivel 1 ej1  ==  [8,3]
--    nivel 2 ej1  ==  [4]
--    nivel 4 ej1  ==  []
nivel :: Int -> Arbol a ->  [a]
nivel 0 (N x _)  = [x]
nivel n (N _ xs) = concatMap (nivel (n-1)) xs

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

espiral2 :: Arbol a -> [a]
espiral2 = 
  concat . zipWith ($) (cycle [reverse,id]) . niveles

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

espiral3 :: Arbol a -> [a]
espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]
niveles3 t = map (map raiz)
           . takeWhile (not . null)
           . iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a
raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]
subBosque (N _ ts) = ts

-- 4ª solución
-- ===========

espiral4 :: Arbol a -> [a]
espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]
niveles4 = map (map raiz)
         . takeWhile (not . null)
         . iterate (concatMap subBosque)
         . return  

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

espiral5 :: Arbol a -> [a]
espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]
niveles5 [] = []
niveles5 xs = a : niveles5 (concat b)
  where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición
-- =============

espiral6 :: Arbol a -> [a]
espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [N 4 [], N 5 []], N 3 [N 6 [], N 7 []]]

ej2 = N 1 [N 8 [], N 3 [N 4 [], N 5 [], N 6 []]]

ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 7 []]]

-- 1ª solución

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

espiral :: Arbol a -> [a]

espiral x =

concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo,

-- niveles ej1 == [[1],[8,3],[4]]

-- niveles ej2 == [[1],[8,3],[4,5,6]]

-- niveles ej3 == [[1],[8,3],[4,5,6,7]]

niveles :: Arbol a -> [[a]]

niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,

-- nivel 0 ej1 == [1]

-- nivel 1 ej1 == [8,3]

-- nivel 2 ej1 == [4]

-- nivel 4 ej1 == []

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

nivel 0 (N x _) = [x]

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

-- 2ª solución

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

espiral2 :: Arbol a -> [a]

espiral2 =

concat . zipWith ($) (cycle [reverse,id]) . niveles

-- 3ª solución

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

espiral3 :: Arbol a -> [a]

espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]

niveles3 t = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a

raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]

subBosque (N _ ts) = ts

-- 4ª solución

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

espiral4 :: Arbol a -> [a]

espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]

niveles4 = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque)

. return

-- 5ª definición

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

espiral5 :: Arbol a -> [a]

espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]

niveles5 [] = []

niveles5 xs = a : niveles5 (concat b)

where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición

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

espiral6 :: Arbol a -> [a]

espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

Huecos binarios

PorJosé A. Alonso 7-febrero-201814-febrero-2018

Los huecos binarios de un número natural n son las listas de cer0 entre dos unos en la representación binaria de n. Por ejemplo, puesto que la representación binaria de 20 es 10100 tiene dos huecos binarios de longitudes 1 y 2. La longitud del mayor hueco binario de 529 es 4 ya que la representación binaria de 529 es 1000010001.

Definir las funciones

   longMayorHuecoBinario        :: Int -> Int
   graficaLongMayorHuecoBinario :: Int -> IO ()

1 2	longMayorHuecoBinario :: Int -> Int graficaLongMayorHuecoBinario :: Int -> IO ()

tales que

(longMayorHuecoBinario n) es la longitud del mayor hueco binario de n. Por ejemplo,

     longMayorHuecoBinario 20    ==  2
     longMayorHuecoBinario 529   ==  4
     longMayorHuecoBinario 2018  ==  3

longMayorHuecoBinario 20 == 2

longMayorHuecoBinario 529 == 4

longMayorHuecoBinario 2018 == 3

(graficaLongMayorHuecoBinario n) dibuja la gráfica de las longitudes de los mayores huecos binarios de los n primeros números naturales. Por ejemplo, (graficaLongMayorHuecoBinario 200) dibuja

Soluciones

import Data.List (group)
import Graphics.Gnuplot.Simple

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

longMayorHuecoBinario :: Int -> Int
longMayorHuecoBinario n =
  maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por
-- ejemplo, 
--    decimalAbinario 20   ==  [0,0,1,0,1]
--    decimalAbinario 529  ==  [1,0,0,0,1,0,0,0,0,1] 
decimalAbinario :: Int -> [Int]
decimalAbinario x
  | x < 2     = [x]
  | otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre
-- dos elementos distintos de cero. Por ejemplo,
--    huecosBinarios [0,0,1,0,1]            ==  [[0,0],[0]]
--    huecosBinarios [1,0,0,0,1,0,0,0,0,1]  ==  [[0,0,0],[0,0,0,0]]
huecosBinarios :: [Int] -> [[Int]]
huecosBinarios xs =
  [ys | ys <- group xs, 0 `elem` ys]

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

longMayorHuecoBinario2 :: Int -> Int
longMayorHuecoBinario2 =
  maximum . (0 :) . map length . huecosBinarios . decimalAbinario

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

longMayorHuecoBinario3 :: Int -> Int
longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos
-- binarios de n. Por ejemplo,
--    longHuecosBinarios 20  ==  [2,1,0]
--    longHuecosBinarios 529  ==  [3,4,0]
longHuecosBinarios :: Int -> [Int]
longHuecosBinarios 1 = [0]
longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)
                     | mod n 4 == 2 = 1 : h : t
                     | otherwise = 1 + h : t
  where (h : t) = longHuecosBinarios (div n 2)

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

--    λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]
--    16
--    (5.51 secs, 941,090,272 bytes)
--    λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]
--    16
--    (5.54 secs, 933,093,168 bytes)
--    λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]
--    16
--    (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()
graficaLongMayorHuecoBinario n =
  plotList [ Key Nothing
           , Title ("graficaLongMayorHuecoBinario " ++ show n)
           , PNG ("Huecos_binarios_" ++ show n ++ ".png")
           ]
           [longMayorHuecoBinario k | k <- [0..n-1]]

import Data.List (group)

import Graphics.Gnuplot.Simple

-- 1ª solución

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

longMayorHuecoBinario :: Int -> Int

longMayorHuecoBinario n =

maximum (0 : map length (huecosBinarios (decimalAbinario n)))

-- (decimalAbinario x) es la representación binaria del número c. Por

-- ejemplo,

-- decimalAbinario 20 == [0,0,1,0,1]

-- decimalAbinario 529 == [1,0,0,0,1,0,0,0,0,1]

decimalAbinario :: Int -> [Int]

decimalAbinario x

| x < 2 = [x]

| otherwise = x `mod` 2 : decimalAbinario (x `div` 2)

-- (huecosBinarios xs) es la lista de los ceros consecutivos de xs entre

-- dos elementos distintos de cero. Por ejemplo,

-- huecosBinarios [0,0,1,0,1] == [[0,0],[0]]

-- huecosBinarios [1,0,0,0,1,0,0,0,0,1] == [[0,0,0],[0,0,0,0]]

huecosBinarios :: [Int] -> [[Int]]

huecosBinarios xs =

[ys | ys <- group xs, 0 `elem` ys]

-- 2ª solución

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

longMayorHuecoBinario2 :: Int -> Int

longMayorHuecoBinario2 =

maximum . (0 :) . map length . huecosBinarios . decimalAbinario

-- 3ª solución

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

longMayorHuecoBinario3 :: Int -> Int

longMayorHuecoBinario3 = maximum . longHuecosBinarios

-- (longHuecosBinarios n) es la lista de las longitudes de los huecos

-- binarios de n. Por ejemplo,

-- longHuecosBinarios 20 == [2,1,0]

-- longHuecosBinarios 529 == [3,4,0]

longHuecosBinarios :: Int -> [Int]

longHuecosBinarios 1 = [0]

longHuecosBinarios n | mod n 2 == 1 = longHuecosBinarios (div n 2)

| mod n 4 == 2 = 1 : h : t

| otherwise = 1 + h : t

where (h : t) = longHuecosBinarios (div n 2)

-- Comparación de eficiencia

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

-- λ> maximum [longMayorHuecoBinario x | x <- [1..100000]]

-- 16

-- (5.51 secs, 941,090,272 bytes)

-- λ> maximum [longMayorHuecoBinario2 x | x <- [1..100000]]

-- 16

-- (5.54 secs, 933,093,168 bytes)

-- λ> maximum [longMayorHuecoBinario3 x | x <- [1..100000]]

-- 16

-- (6.00 secs, 966,584,848 bytes)

graficaLongMayorHuecoBinario :: Int -> IO ()

graficaLongMayorHuecoBinario n =

plotList [ Key Nothing

, Title ("graficaLongMayorHuecoBinario " ++ show n)

, PNG ("Huecos_binarios_" ++ show n ++ ".png")

]

[longMayorHuecoBinario k | k <- [0..n-1]]

División equitativa

PorJosé A. Alonso 6-febrero-201826-marzo-2022

Definir la función

   divisionEquitativa :: [Int] -> Maybe ([Int],[Int])

1	divisionEquitativa :: [Int] -> Maybe ([Int],[Int])

tal que (divisionEquitativa xs) determina si la lista de números enteros positivos xs se puede dividir en dos partes (sin reordenar sus elementos) con la misma suma. Si es posible, su valor es el par formado por las dos partes. Si no lo es, su valor es Nothing. Por ejemplo,

   divisionEquitativa [1,2,3,4,5,15]  ==  Just ([1,2,3,4,5],[15])
   divisionEquitativa [15,1,2,3,4,5]  ==  Just ([15],[1,2,3,4,5])
   divisionEquitativa [1,2,3,4,7,15]  ==  Nothing
   divisionEquitativa [1,2,3,4,15,5]  ==  Nothing

divisionEquitativa [1,2,3,4,5,15] == Just ([1,2,3,4,5],[15])

divisionEquitativa [15,1,2,3,4,5] == Just ([15],[1,2,3,4,5])

divisionEquitativa [1,2,3,4,7,15] == Nothing

divisionEquitativa [1,2,3,4,15,5] == Nothing

Soluciones

import Data.Maybe (isNothing, fromJust, listToMaybe)
import Data.List  (elemIndex, inits, tails)

-- 1ª solución
divisionEquitativa1 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa1 xs = aux (particiones xs)
 where aux []                              = Nothing
       aux ((as,bs):ys) | sum as == sum bs = Just (as,bs)
                        | otherwise        = aux ys                   
       particiones xs = [splitAt i xs | i <- [1..length xs-1]]

-- 2ª solución
divisionEquitativa2 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa2 xs
  | 2 * b == suma = Just $ splitAt (length as + 1) xs
  | otherwise     = Nothing
  where suma        = sum xs
        (as,(b:bs)) = span (<suma `div` 2) $ scanl1 (+) xs

-- 3ª solución
divisionEquitativa3 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa3 xs
  | odd n       = Nothing
  | isNothing p = Nothing
  | otherwise   = Just (splitAt (1 + fromJust p) xs)
  where n  = sum xs
        ys = scanl1 (+) xs
        p  = elemIndex (n `div` 2) ys

-- 4ª solución
divisionEquitativa4 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa4 xs
  | odd (sum xs) = Nothing
  | otherwise    = aux [] xs
  where aux as bs@(b:bs') | sum as == sum bs = Just (reverse as, bs)
                          | sum as > sum bs  = Nothing
                          | otherwise        = aux (b:as) (bs')

-- 5ª solución
divisionEquitativa5 :: [Int] -> Maybe ([Int],[Int])
divisionEquitativa5 xs =
  listToMaybe
    [(ys, zs) | (ys,zs) <- zip (inits xs) (tails xs)
              , sum ys == sum zs ]

import Data.Maybe (isNothing, fromJust, listToMaybe)

import Data.List (elemIndex, inits, tails)

-- 1ª solución

divisionEquitativa1 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa1 xs = aux (particiones xs)

where aux [] = Nothing

aux ((as,bs):ys) | sum as == sum bs = Just (as,bs)

| otherwise = aux ys

particiones xs = [splitAt i xs | i <- [1..length xs-1]]

-- 2ª solución

divisionEquitativa2 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa2 xs

| 2 * b == suma = Just $ splitAt (length as + 1) xs

| otherwise = Nothing

where suma = sum xs

(as,(b:bs)) = span (<suma `div` 2) $ scanl1 (+) xs

-- 3ª solución

divisionEquitativa3 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa3 xs

| odd n = Nothing

| isNothing p = Nothing

| otherwise = Just (splitAt (1 + fromJust p) xs)

where n = sum xs

ys = scanl1 (+) xs

p = elemIndex (n `div` 2) ys

-- 4ª solución

divisionEquitativa4 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa4 xs

| odd (sum xs) = Nothing

| otherwise = aux [] xs

where aux as bs@(b:bs') | sum as == sum bs = Just (reverse as, bs)

| sum as > sum bs = Nothing

| otherwise = aux (b:as) (bs')

-- 5ª solución

divisionEquitativa5 :: [Int] -> Maybe ([Int],[Int])

divisionEquitativa5 xs =

listToMaybe

[(ys, zs) | (ys,zs) <- zip (inits xs) (tails xs)

, sum ys == sum zs ]

Celdas interiores de una retícula

PorJosé A. Alonso 5-febrero-201812-febrero-2018

Las celdas de una retícula cuadrada se numeran consecutivamente. Por ejemplo, la numeración de la retícula cuadrada de lado 4 es

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

1, 2, 3, 4

5, 6, 7, 8

9,10,11,12

13,14,15,16

Los números de sus celdas interiores son 6,7,10,11.

Definir la función

   interiores :: Int -> [Int]

1	interiores :: Int -> [Int]

tal que (interiores n) es la lista de los números de las celdas interiores de la retícula cuadrada de lado n. Por ejemplo,

   interiores 4  == [6,7,10,11]
   interiores 5  == [7,8,9,12,13,14,17,18,19]
   interiores 6  == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]
   interiores 2  == []
   length (interiores 2018)  == 4064256

interiores 4 == [6,7,10,11]

interiores 5 == [7,8,9,12,13,14,17,18,19]

interiores 6 == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]

interiores 2 == []

length (interiores 2018) == 4064256

Comprobar con QuickCheck que el número de celdas interiores de la retícula cuadrada de lado n, con n > 1, es (n-2)^2.

Soluciones

import Test.QuickCheck
import Data.List.Split (divvy)

-- 1ª solución
interiores :: Int -> [Int]
interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución
interiores2 :: Int -> [Int]
interiores2 n = aux [n+1..n^2-n]
  where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)
        aux []         = []

-- 3ª solución 
interiores3 :: Int -> [Int]
interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución
interiores4 :: Int -> [Int]
interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución
interiores5 :: Int -> [Int]
interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es
prop_interiores :: Int -> Property
prop_interiores n =
  n > 1 ==> length (interiores n) == (n-2)^2

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

import Test.QuickCheck

import Data.List.Split (divvy)

-- 1ª solución

interiores :: Int -> [Int]

interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución

interiores2 :: Int -> [Int]

interiores2 n = aux [n+1..n^2-n]

where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)

aux [] = []

-- 3ª solución

interiores3 :: Int -> [Int]

interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución

interiores4 :: Int -> [Int]

interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución

interiores5 :: Int -> [Int]

interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es

prop_interiores :: Int -> Property

prop_interiores n =

n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es

-- λ> quickCheck prop_interiores

-- +++ OK, passed 100 tests.

Dígitos iniciales

PorJosé A. Alonso 2-febrero-201819-febrero-2018

Definir las funciones

   digitosIniciales        :: [Int]
   graficaDigitosIniciales :: Int -> IO ()

1 2	digitosIniciales :: [Int] graficaDigitosIniciales :: Int -> IO ()

tales que

digitosIniciales es la lista de los dígitos iniciales de los números naturales. Por ejemplo,

     λ> take 100 digitosIniciales
     [0,1,2,3,4,5,6,7,8,9,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,
      3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,
      6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8,
      9,9,9,9,9,9,9,9,9,9]

λ> take 100 digitosIniciales

[0,1,2,3,4,5,6,7,8,9,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,

3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,

6,6,6,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,8,8,

9,9,9,9,9,9,9,9,9,9]

(graficaDigitosIniciales n) dibuja la gráfica de los primeros n términos de la sucesión digitosIniciales. Por ejemplo, (graficaDigitosIniciales 100) dibuja

y (graficaDigitosIniciales 1000) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

digitosIniciales :: [Int]
digitosIniciales = map digitoInicial [0..]

digitoInicial :: Integer -> Int
digitoInicial n = read [head (show n)]

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

digitosIniciales2 :: [Int]
digitosIniciales2 = map (read . return . head . show) [0..]

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

digitosIniciales3 :: [Int]
digitosIniciales3 = map digitoInicial3 [0..]

digitoInicial3 :: Integer -> Int
digitoInicial3 = fromInteger . until (< 10) (`div` 10)

-- 4ª definición
-- =============

digitosIniciales4 :: [Int]
digitosIniciales4 = map (fromInteger . until (< 10) (`div` 10)) [0..]

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

digitosIniciales5 :: [Int]
digitosIniciales5 =
  0 : concat [replicate k x | k <- [10^n | n <- [0..]]
                            , x <- [1..9]]

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

--    λ> digitosIniciales !! (2*10^6)
--    2
--    (0.46 secs, 320,145,984 bytes)
--    λ> digitosIniciales2 !! (2*10^6)
--    2
--    (0.46 secs, 320,143,288 bytes)
--    λ> digitosIniciales3 !! (2*10^6)
--    2
--    (0.17 secs, 320,139,216 bytes)
--    λ> digitosIniciales4 !! (2*10^6)
--    2
--    (0.55 secs, 320,139,248 bytes)
--    λ> digitosIniciales5 !! (2*10^6)
--    2
--    (0.12 secs, 224,158,992 bytes)

graficaDigitosIniciales :: Int -> IO ()
graficaDigitosIniciales n =
  plotList [ Key Nothing
           , Title ("graficaDigitosIniciales " ++ show n)
           , PNG ("Digitos_iniciales_" ++ show n ++ ".png" )
           ]
           (take n digitosIniciales)

import Graphics.Gnuplot.Simple

-- 1ª definición

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

digitosIniciales :: [Int]

digitosIniciales = map digitoInicial [0..]

digitoInicial :: Integer -> Int

digitoInicial n = read [head (show n)]

-- 2ª definición

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

digitosIniciales2 :: [Int]

digitosIniciales2 = map (read . return . head . show) [0..]

-- 3ª definición

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

digitosIniciales3 :: [Int]

digitosIniciales3 = map digitoInicial3 [0..]

digitoInicial3 :: Integer -> Int

digitoInicial3 = fromInteger . until (< 10) (`div` 10)

-- 4ª definición

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

digitosIniciales4 :: [Int]

digitosIniciales4 = map (fromInteger . until (< 10) (`div` 10)) [0..]

-- 5ª definición

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

digitosIniciales5 :: [Int]

digitosIniciales5 =

0 : concat [replicate k x | k <- [10^n | n <- [0..]]

, x <- [1..9]]

-- Comparación de eficiencia

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

-- λ> digitosIniciales !! (2*10^6)

-- 2

-- (0.46 secs, 320,145,984 bytes)

-- λ> digitosIniciales2 !! (2*10^6)

-- 2

-- (0.46 secs, 320,143,288 bytes)

-- λ> digitosIniciales3 !! (2*10^6)

-- 2

-- (0.17 secs, 320,139,216 bytes)

-- λ> digitosIniciales4 !! (2*10^6)

-- 2

-- (0.55 secs, 320,139,248 bytes)

-- λ> digitosIniciales5 !! (2*10^6)

-- 2

-- (0.12 secs, 224,158,992 bytes)

graficaDigitosIniciales :: Int -> IO ()

graficaDigitosIniciales n =

plotList [ Key Nothing

, Title ("graficaDigitosIniciales " ++ show n)

, PNG ("Digitos_iniciales_" ++ show n ++ ".png" )

]

(take n digitosIniciales)

Exponentes de Hamming

PorJosé A. Alonso 1-febrero-20188-febrero-2018

Los números de Hamming forman una sucesión estrictamente creciente de números que cumplen las siguientes condiciones:

El número 1 está en la sucesión.
Si x está en la sucesión, entonces 2x, 3x y 5x también están.
Ningún otro número está en la sucesión.

Los primeros números de Hamming son 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, …

Los exponentes de un número de Hamming n es una terna (x,y,z) tal que n = 2^x*3^y*5^z. Por ejemplo, los exponentes de 600 son (3,1,2) ya que 600 = 2^x*3^1*5^z.

Definir la sucesión

   sucExponentesHamming :: [(Int,Int,Int)]

1	sucExponentesHamming :: [(Int,Int,Int)]

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

   λ> take 21 sucExponentesHamming
   [(0,0,0),(1,0,0),(0,1,0),(2,0,0),(0,0,1),(1,1,0),(3,0,0),
    (0,2,0),(1,0,1),(2,1,0),(0,1,1),(4,0,0),(1,2,0),(2,0,1),
    (3,1,0),(0,0,2),(0,3,0),(1,1,1),(5,0,0),(2,2,0),(3,0,1)]
   λ> sucExponentesHamming !! (5*10^5)
   (74,82,7)

λ> take 21 sucExponentesHamming

[(0,0,0),(1,0,0),(0,1,0),(2,0,0),(0,0,1),(1,1,0),(3,0,0),

(0,2,0),(1,0,1),(2,1,0),(0,1,1),(4,0,0),(1,2,0),(2,0,1),

(3,1,0),(0,0,2),(0,3,0),(1,1,1),(5,0,0),(2,2,0),(3,0,1)]

λ> sucExponentesHamming !! (5*10^5)

(74,82,7)

Soluciones

import Data.Numbers.Primes (primeFactors)

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

sucExponentesHamming :: [(Int,Int,Int)]
sucExponentesHamming = map exponentes hamming

-- (exponentes n) es la terna de exponentes del número de Hamming n. Por
-- ejemplo, 
--    exponentes 600  ==  (3,1,2)
exponentes :: Integer -> (Int,Int,Int)
exponentes x = (length as, length cs, length ds)
  where xs = primeFactors x
        (as,bs) = span (==2) xs
        (cs,ds) = span (==3) bs

-- hamming es la sucesión de los números de Hamming. Por ejemplo,
--    λ> take 21 hamming
--    [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40]
hamming :: [Integer]
hamming = 1 : mezcla3 [2*i | i <- hamming]  
                      [3*i | i <- hamming]  
                      [5*i | i <- hamming]  

-- mezcla3 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs, ys y zs y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10]  ==  [2,3,4,5,6,8,9,10,12]
mezcla3 :: Ord a => [a] -> [a] -> [a] -> [a]
mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)  

-- mezcla2 xs ys zs es la lista obtenida mezclando las listas ordenadas
-- xs e ys y eliminando los elementos duplicados. Por ejemplo, 
--    mezcla2 [2,4,6,8,10,12] [3,6,9,12]  ==  [2,3,4,6,8,9,10,12]
mezcla2 :: Ord a => [a] -> [a] -> [a] 
mezcla2 p@(x:xs) q@(y:ys) | x < y     = x:mezcla2 xs q
                          | x > y     = y:mezcla2 p  ys  
                          | otherwise = x:mezcla2 xs ys
mezcla2 []       ys                   = ys
mezcla2 xs       []                   = xs

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

sucExponentesHamming2 :: [(Int,Int,Int)]
sucExponentesHamming2 = map exponentes2 hamming

exponentes2 :: Integer -> (Int,Int,Int)
exponentes2 = aux (0,0,0)
  where aux (a,b,c) 1 = (a,b,c)
        aux (a,b,c) x | mod x 2 == 0 = aux (a+1,b,c) (div x 2)
                      | mod x 3 == 0 = aux (a,b+1,c) (div x 3)
                      | otherwise    = aux (a,b,c+1) (div x 5)

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

sucExponentesHamming3 :: [(Int,Int,Int)]
sucExponentesHamming3 = map exponentes3 hamming

exponentes3 :: Integer -> (Int,Int,Int)
exponentes3 1 = (0,0,0)
exponentes3 x
  | x `mod` 2 == 0 = suma (1,0,0) (descomposicion (x `div` 2))
  | x `mod` 3 == 0 = suma (0,1,0) (descomposicion (x `div` 3))
  | otherwise      = suma (0,0,1) (descomposicion (x `div` 5))
  where suma (x,y,z) (a,b,c) = (x+a,y+b,z+c)

-- 4ª solución
-- ===========

type Terna = (Int,Int,Int)

sucExponentesHamming4 :: [Terna]
sucExponentesHamming4 =
  (0,0,0) : mezclaT3 [(x+1,y,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y+1,z) | (x,y,z) <- sucExponentesHamming4]
                     [(x,y,z+1) | (x,y,z) <- sucExponentesHamming4]
 
mezclaT3 :: [Terna] -> [Terna] -> [Terna] -> [Terna]
mezclaT3 t1 t2 t3 = mezclaT2 t1 (mezclaT2 t2 t3)

mezclaT2 :: [Terna] -> [Terna] -> [Terna]
mezclaT2 ts1@((i,j,k):xs) ts2@((a,b,c):ys)
  | x < y     = (i,j,k) : mezclaT2 xs ts2
  | x > y     = (a,b,c) : mezclaT2 ts1 ys
  | otherwise = (i,j,k) : mezclaT2 xs ys
  where x = 2^i*3^j*5^k
        y = 2^a*3^b*5^c

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

sucExponentesHamming :: [(Int,Int,Int)]

sucExponentesHamming = map exponentes hamming

-- (exponentes n) es la terna de exponentes del número de Hamming n. Por

-- ejemplo,

-- exponentes 600 == (3,1,2)

exponentes :: Integer -> (Int,Int,Int)

exponentes x = (length as, length cs, length ds)

where xs = primeFactors x

(as,bs) = span (==2) xs

(cs,ds) = span (==3) bs

-- hamming es la sucesión de los números de Hamming. Por ejemplo,

-- λ> take 21 hamming

-- [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36,40]

hamming :: [Integer]

hamming = 1 : mezcla3 [2*i | i <- hamming]

[3*i | i <- hamming]

[5*i | i <- hamming]

-- mezcla3 xs ys zs es la lista obtenida mezclando las listas ordenadas

-- xs, ys y zs y eliminando los elementos duplicados. Por ejemplo,

-- mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10] == [2,3,4,5,6,8,9,10,12]

mezcla3 :: Ord a => [a] -> [a] -> [a] -> [a]

mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)

-- mezcla2 xs ys zs es la lista obtenida mezclando las listas ordenadas

-- xs e ys y eliminando los elementos duplicados. Por ejemplo,

-- mezcla2 [2,4,6,8,10,12] [3,6,9,12] == [2,3,4,6,8,9,10,12]

mezcla2 :: Ord a => [a] -> [a] -> [a]

mezcla2 p@(x:xs) q@(y:ys) | x < y = x:mezcla2 xs q

| x > y = y:mezcla2 p ys

| otherwise = x:mezcla2 xs ys

mezcla2 [] ys = ys

mezcla2 xs [] = xs

-- 2ª solución

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

sucExponentesHamming2 :: [(Int,Int,Int)]

sucExponentesHamming2 = map exponentes2 hamming

exponentes2 :: Integer -> (Int,Int,Int)

exponentes2 = aux (0,0,0)

where aux (a,b,c) 1 = (a,b,c)

aux (a,b,c) x | mod x 2 == 0 = aux (a+1,b,c) (div x 2)

| mod x 3 == 0 = aux (a,b+1,c) (div x 3)

| otherwise = aux (a,b,c+1) (div x 5)

-- 3ª solución

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

sucExponentesHamming3 :: [(Int,Int,Int)]

sucExponentesHamming3 = map exponentes3 hamming

exponentes3 :: Integer -> (Int,Int,Int)

exponentes3 1 = (0,0,0)

exponentes3 x

| x `mod` 2 == 0 = suma (1,0,0) (descomposicion (x `div` 2))

| x `mod` 3 == 0 = suma (0,1,0) (descomposicion (x `div` 3))

| otherwise = suma (0,0,1) (descomposicion (x `div` 5))

where suma (x,y,z) (a,b,c) = (x+a,y+b,z+c)

-- 4ª solución

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

type Terna = (Int,Int,Int)

sucExponentesHamming4 :: [Terna]

sucExponentesHamming4 =

(0,0,0) : mezclaT3 [(x+1,y,z) | (x,y,z) <- sucExponentesHamming4]

[(x,y+1,z) | (x,y,z) <- sucExponentesHamming4]

[(x,y,z+1) | (x,y,z) <- sucExponentesHamming4]

mezclaT3 :: [Terna] -> [Terna] -> [Terna] -> [Terna]

mezclaT3 t1 t2 t3 = mezclaT2 t1 (mezclaT2 t2 t3)

mezclaT2 :: [Terna] -> [Terna] -> [Terna]

mezclaT2 ts1@((i,j,k):xs) ts2@((a,b,c):ys)

| x < y = (i,j,k) : mezclaT2 xs ts2

| x > y = (a,b,c) : mezclaT2 ts1 ys

| otherwise = (i,j,k) : mezclaT2 xs ys

where x = 2^i*3^j*5^k

y = 2^a*3^b*5^c

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico