José A. Alonso

Máxima distancia en árbol

PorJosé A. Alonso 29-enero-20185-febrero-2018

Los árboles binarios con valores en las hojas y en los nodos se definen por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a) 
     deriving (Eq, Show)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

         10
        /  \
       /    \
      8      1
     / \    / \
    3   9  2   6

/ \

8 1

/ \ / \

3 9 2 6

se puede representar por

   ejArbol :: Arbol Int
   ejArbol = N 10 (N 8 (H 3) (H 9))
                  (N 1 (H 2) (H 6))

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 9))

(N 1 (H 2) (H 6))

La distancia entre un padre y un hijo en el árbol es el valor absoluto de la diferencia de sus valores. Por ejemplo, la distancia de 10 a 8 es 2 y de 1 a 6 es 5.

Definir la función

   maximaDistancia :: (Num a, Ord a) => Arbol a -> a

1	maximaDistancia :: (Num a, Ord a) => Arbol a -> a

tal que (maximaDistancia a) es la máxima distancia entre un padre y un hijo del árbol a. Por ejemplo,

   maximaDistancia ejArbol                                     ==  9
   maximaDistancia (N 1 (N 8 (H 3) (H 9)) (N 1  (H 2) (H 6)))  ==  7
   maximaDistancia (N 8 (N 8 (H 3) (H 9)) (N 10 (H 2) (H 6)))  ==  8

maximaDistancia ejArbol == 9

maximaDistancia (N 1 (N 8 (H 3) (H 9)) (N 1 (H 2) (H 6))) == 7

maximaDistancia (N 8 (N 8 (H 3) (H 9)) (N 10 (H 2) (H 6))) == 8

Soluciones

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

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

[/schedule]

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

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving Show

ejArbol :: Arbol Int
ejArbol = N 10 (N 8 (H 3) (H 9))
               (N 1 (H 2) (H 6))


maximaDistancia :: (Num a, Ord a) => Arbol a -> a
maximaDistancia (H _)     = 0
maximaDistancia (N x i d) = maximum [abs (x - raiz i)
                                    , maximaDistancia i
                                    , abs (x - raiz d)
                                    , maximaDistancia d]
                             
raiz :: Arbol a -> a
raiz (H x)     = x
raiz (N x _ _) = x

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 9))

(N 1 (H 2) (H 6))

maximaDistancia :: (Num a, Ord a) => Arbol a -> a

maximaDistancia (H _) = 0

maximaDistancia (N x i d) = maximum [abs (x - raiz i)

, maximaDistancia i

, abs (x - raiz d)

, maximaDistancia d]

raiz :: Arbol a -> a

raiz (H x) = x

raiz (N x _ _) = x

[/schedule]

Relación definida por un árbol

PorJosé A. Alonso 26-enero-20182-febrero-2018

Los árboles binarios con valores en las hojas y en los nodos se definen por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a) 
     deriving (Eq, Show)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

         10
        /  \
       /    \
      8      2
     / \    / \
    3   5  2   0

/ \

8 2

/ \ / \

3 5 2 0

se pueden representar por

   ejArbol :: Arbol Int
   ejArbol = N 10 (N 8 (H 3) (H 5))
                  (N 2 (H 2) (H 0))

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 5))

(N 2 (H 2) (H 0))

Un árbol binario define una relación binaria donde un elemento x está relacionado con y si x es el padre de y. Por ejemplo, la relación definida por el árbol anterior es [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)].

Definir la función

   relacionDelArbol :: Arbol a -> [(a,a)]

1	relacionDelArbol :: Arbol a -> [(a,a)]

tal que (relacionDelArbol a) es la relación binaria definida por el árbol a. Por ejemplo,

   λ> relacionDelArbol ejArbol
   [(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]
   λ> relacionDelArbol (N 10 (H 8) (N 2 (H 2) (H 0)))
   [(10,8),(10,2),(2,2),(2,0)]
   λ> relacionDelArbol (N 10 (N 8 (H 3) (H 5)) (H 2))
   [(10,8),(8,3),(8,5),(10,2)]
   λ> relacionDelArbol (H 10)
   []

λ> relacionDelArbol ejArbol

[(10,8),(8,3),(8,5),(10,2),(2,2),(2,0)]

λ> relacionDelArbol (N 10 (H 8) (N 2 (H 2) (H 0)))

[(10,8),(10,2),(2,2),(2,0)]

λ> relacionDelArbol (N 10 (N 8 (H 3) (H 5)) (H 2))

[(10,8),(8,3),(8,5),(10,2)]

λ> relacionDelArbol (H 10)

[]

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving Show

ejArbol :: Arbol Int
ejArbol = N 10 (N 8 (H 3) (H 5))
               (N 2 (H 2) (H 0))

relacionDelArbol :: Arbol a -> [(a,a)]
relacionDelArbol (H _)     = []
relacionDelArbol (N x i d) = ((x,raiz i) : relacionDelArbol i) ++ 
                             ((x,raiz d) : relacionDelArbol d)
                             
raiz :: Arbol a -> a
raiz (H x)     = x
raiz (N x _ _) = x

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 5))

(N 2 (H 2) (H 0))

relacionDelArbol :: Arbol a -> [(a,a)]

relacionDelArbol (H _) = []

relacionDelArbol (N x i d) = ((x,raiz i) : relacionDelArbol i) ++

((x,raiz d) : relacionDelArbol d)

raiz :: Arbol a -> a

raiz (H x) = x

raiz (N x _ _) = x

Sucesión de Lichtenberg

PorJosé A. Alonso 25-enero-20181-febrero-2018

La sucesión de Lichtenberg esta formada por la representación decimal de los números binarios de la sucesión de dígitos 0 y 1 alternados Los primeros términos de ambas sucesiones son

   Alternada ..... Lichtenberg
   0 ....................... 0
   1 ....................... 1
   10 ...................... 2
   101 ..................... 5
   1010 ................... 10
   10101 .................. 21
   101010 ................. 42
   1010101 ................ 85
   10101010 .............. 170
   101010101 ............. 341
   1010101010 ............ 682
   10101010101 .......... 1365
   101010101010 ......... 2730

Alternada ..... Lichtenberg

0 ....................... 0

1 ....................... 1

10 ...................... 2

101 ..................... 5

1010 ................... 10

10101 .................. 21

101010 ................. 42

1010101 ................ 85

10101010 .............. 170

101010101 ............. 341

1010101010 ............ 682

10101010101 .......... 1365

101010101010 ......... 2730

Definir las funciones

   lichtenberg        :: [Integer]
   graficaLichtenberg :: Int -> IO ()

1 2	lichtenberg :: [Integer] graficaLichtenberg :: Int -> IO ()

tales que

lichtenberg es la lista cuyos elementos son los términos de la sucesión de Lichtenberg. Por ejemplo,

     λ> take 17 lichtenberg
     [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

1 2	λ> take 17 lichtenberg [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]

(graficaLichtenberg n) dibuja la gráfica del número de dígitos de los n primeros términos de la sucesión de Lichtenberg. Por ejemlo, (graficaLichtenberg 100) dibuja

Comprobar con QuickCheck que todos los términos de la sucesión de Lichtenberg, a partir del 4º, son números compuestos.

Soluciones

import Data.Char (digitToInt)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)

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

lichtenberg1 :: [Integer]
lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la
-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,
--    λ> take 7 sucAlternada
--    ["0","1","10","101","1010","10101","101010"]
sucAlternada :: [String]
sucAlternada =
  ['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y
-- 0. Por ejemplo,
--    take 20 cadenaAlternada  ==  "10101010101010101010"
cadenaAlternada :: String
cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número
-- binario cuya cadena de dígitos es cs. Por ejemplo,
--    binarioAdecimal "11101"  ==  29
binarioAdecimal :: String -> Integer
binarioAdecimal =
  foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0
  
-- 2ª solución
lichtenberg2 :: [Integer]
lichtenberg2 = map a [0..]
  where a 0 = 0
        a 1 = 1
        a n = a (n-1) + 2 * a (n-2) + 1

-- 3ª solución
lichtenberg3 :: [Integer]
lichtenberg3 =
  0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3)) 

-- Comprobación de eficiencia
--    λ> length (show (lichtenberg1 !! 27))
--    8
--    (0.02 secs, 155,384 bytes)
--    λ> length (show (lichtenberg2 !! 27))
--    8
--    (2.22 secs, 311,157,760 bytes)
--    
--    λ> length (show (lichtenberg1 !! (8*10^4)))
--    24083
--    (1.28 secs, 664,207,040 bytes)
--    λ> length (show (lichtenberg3 !! (8*10^4)))
--    24083
--    (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es
propLichtenberg :: Int -> Property
propLichtenberg n =
  n > 4 ==> not (isPrime (lichtenberg1 !! n))

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

graficaLichtenberg :: Int -> IO ()
graficaLichtenberg n =
  plotList [ Key Nothing
           , Title "Numero de digitos de la sucesion de Lichtenberg"
           , PNG "Sucesion_de_Lichtenberg.png"
           ]
           (take n (map (length . show) lichtenberg1))

import Data.Char (digitToInt)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

import Data.Numbers.Primes (isPrime)

-- 1ª solución

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

lichtenberg1 :: [Integer]

lichtenberg1 = map binarioAdecimal sucAlternada

-- sucAlternada es la lista cuyos elementos son los términos de la

-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,

-- λ> take 7 sucAlternada

-- ["0","1","10","101","1010","10101","101010"]

sucAlternada :: [String]

sucAlternada =

['0'] : [take n cadenaAlternada | n <- [1..]]

-- cadenaAltenada es la cadena formada alternando los caracteres 1 y

-- 0. Por ejemplo,

-- take 20 cadenaAlternada == "10101010101010101010"

cadenaAlternada :: String

cadenaAlternada = cycle ['1','0']

-- (binarioAdecimal cs) es el número decimal correspondiente al número

-- binario cuya cadena de dígitos es cs. Por ejemplo,

-- binarioAdecimal "11101" == 29

binarioAdecimal :: String -> Integer

binarioAdecimal =

foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0

-- 2ª solución

lichtenberg2 :: [Integer]

lichtenberg2 = map a [0..]

where a 0 = 0

a 1 = 1

a n = a (n-1) + 2 * a (n-2) + 1

-- 3ª solución

lichtenberg3 :: [Integer]

lichtenberg3 =

0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3))

-- Comprobación de eficiencia

-- λ> length (show (lichtenberg1 !! 27))

-- 8

-- (0.02 secs, 155,384 bytes)

-- λ> length (show (lichtenberg2 !! 27))

-- 8

-- (2.22 secs, 311,157,760 bytes)

-- λ> length (show (lichtenberg1 !! (8*10^4)))

-- 24083

-- (1.28 secs, 664,207,040 bytes)

-- λ> length (show (lichtenberg3 !! (8*10^4)))

-- 24083

-- (2.59 secs, 1,253,328,200 bytes)

-- La propiedad es

propLichtenberg :: Int -> Property

propLichtenberg n =

n > 4 ==> not (isPrime (lichtenberg1 !! n))

-- La comprobación es

-- λ> quickCheck propLichtenberg

-- +++ OK, passed 100 tests.

graficaLichtenberg :: Int -> IO ()

graficaLichtenberg n =

plotList [ Key Nothing

, Title "Numero de digitos de la sucesion de Lichtenberg"

, PNG "Sucesion_de_Lichtenberg.png"

]

(take n (map (length . show) lichtenberg1))

Sucesión de dígitos 0 y 1 alternados

PorJosé A. Alonso 24-enero-201831-enero-2018

Los primeros términos de la sucesión de los dígitos 0 y 1 alternados son

101

1010

10101

101010

1010101

10101010

101010101

Definir la lista

   sucAlternada :: [Integer]

1	sucAlternada :: [Integer]

tal que sus elementos son los términos de la sucesión de los dígitos 0 y 1 alternados. Por ejemplo,

   λ> take 10 sucAlternada
   [0,1,10,101,1010,10101,101010,1010101,10101010,101010101]
   λ> length (show (sucAlternada !! (2*10^6)))
   2000000

λ> take 10 sucAlternada

[0,1,10,101,1010,10101,101010,1010101,10101010,101010101]

λ> length (show (sucAlternada !! (2*10^6)))

2000000

Soluciones

import Data.List (inits, unfoldr)

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

sucAlternada :: [Integer]
sucAlternada = [read (take x aux) | x <- [1..]]
  where aux = '0' : '1' : aux

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

sucAlternada2 :: [Integer]
sucAlternada2 =
  [read (take n (cycle "01")) | n <- [1..]]

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

sucAlternada3 :: [Integer]
sucAlternada3 = 0 : [siguiente n | n <- sucAlternada3]

siguiente :: Integer -> Integer
siguiente x | even x    = 10*x + 1
            | otherwise = 10*x

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

sucAlternada4 :: [Integer]
sucAlternada4 = 0 : map siguiente sucAlternada4

-- 5ª solución
-- ===========

sucAlternada5 :: [Integer]
sucAlternada5 = map read ((tail . inits . concat . repeat) "01")

-- 6ª solución
-- ===========

sucAlternada6 :: [Integer]
sucAlternada6 = [(10 * 10^n - 1) `div` 99 | n <- [0..]]
 
-- 7ª solución
-- ===========

sucAlternada7 :: [Integer]
sucAlternada7 =
  unfoldr (\x -> if x `mod` 10 == 0
                 then Just (x,10 * x + 1)
                 else Just (x,10 * x))
          0

import Data.List (inits, unfoldr)

-- 1ª solución

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

sucAlternada :: [Integer]

sucAlternada = [read (take x aux) | x <- [1..]]

where aux = '0' : '1' : aux

-- 2ª solución

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

sucAlternada2 :: [Integer]

sucAlternada2 =

[read (take n (cycle "01")) | n <- [1..]]

-- 3ª solución

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

sucAlternada3 :: [Integer]

sucAlternada3 = 0 : [siguiente n | n <- sucAlternada3]

siguiente :: Integer -> Integer

siguiente x | even x = 10*x + 1

| otherwise = 10*x

-- 3ª solución

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

sucAlternada4 :: [Integer]

sucAlternada4 = 0 : map siguiente sucAlternada4

-- 5ª solución

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

sucAlternada5 :: [Integer]

sucAlternada5 = map read ((tail . inits . concat . repeat) "01")

-- 6ª solución

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

sucAlternada6 :: [Integer]

sucAlternada6 = [(10 * 10^n - 1) `div` 99 | n <- [0..]]

-- 7ª solución

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

sucAlternada7 :: [Integer]

sucAlternada7 =

unfoldr (\x -> if x `mod` 10 == 0

then Just (x,10 * x + 1)

else Just (x,10 * x))

Sumas parciales de Juzuk

PorJosé A. Alonso 23-enero-201830-enero-2018

En 1939 Dov Juzuk extendió el método de Nicómaco del cálculo de los cubos. La extensión se basaba en los siguientes pasos:

se comienza con la lista de todos los enteros positivos

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

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

se agrupan tomando el primer elemento, los dos siguientes, los tres
siguientes, etc.

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

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

se seleccionan los elementos en posiciones pares

     [[1],         [4, 5, 6],                [11, 12, 13, 14, 15], ...

1	[[1], [4, 5, 6], [11, 12, 13, 14, 15], ...

se suman los elementos de cada grupo

     [1,           15,                       65,                   ...

1	[1, 15, 65, ...

se calculan las sumas acumuladas

     [1,           16,                       81,                   ...

1	[1, 16, 81, ...

Las sumas obtenidas son las cuantas potencias de los números enteros positivos.

Definir las funciones

   listasParcialesJuzuk :: [a] -> [[a]]
   sumasParcialesJuzuk  :: [Integer] -> [Integer]

1 2	listasParcialesJuzuk :: [a] -> [[a]] sumasParcialesJuzuk :: [Integer] -> [Integer]

tal que

(listasParcialesJuzuk xs) es lalista de ls listas parciales de Juzuk; es decir, la selección de los elementos en posiciones pares de la agrupación de los elementos de xs tomando el primer elemento, los dos siguientes, los tres siguientes, etc. Por ejemplo,

     λ> take 4 (listasParcialesJuzuk [1..])
     [[1],[4,5,6],[11,12,13,14,15],[22,23,24,25,26,27,28]]
     λ> take 4 (listasParcialesJuzuk [1,3..])
     [[1],[7,9,11],[21,23,25,27,29],[43,45,47,49,51,53,55]]

λ> take 4 (listasParcialesJuzuk [1..])

[[1],[4,5,6],[11,12,13,14,15],[22,23,24,25,26,27,28]]

λ> take 4 (listasParcialesJuzuk [1,3..])

[[1],[7,9,11],[21,23,25,27,29],[43,45,47,49,51,53,55]]

(sumasParcialesJuzuk xs) es la lista de las sumas acumuladas de los elementos de las listas de Juzuk generadas por xs. Por ejemplo,

     take 4 (sumasParcialesJuzuk [1..])  ==  [1,16,81,256]
     take 4 (sumasParcialesJuzuk [1,3..])  ==  [1,28,153,496]

1 2	take 4 (sumasParcialesJuzuk [1..]) == [1,16,81,256] take 4 (sumasParcialesJuzuk [1,3..]) == [1,28,153,496]

Comprobar con QuickChek que, para todo entero positivo n,

el elemento de (sumasParcialesJuzuk [1..]) en la posición (n-1) es n^4.
el elemento de (sumasParcialesJuzuk [1,3..]) en la posición (n-1) es n^2*(2*n^2 - 1).
el elemento de (sumasParcialesJuzuk [1,5..]) en la posición (n-1) es 4*n^4-3*n^2.
el elemento de (sumasParcialesJuzuk [2,3..]) en la posición (n-1) es n^2*(n^2+1).

Soluciones

import Data.List (genericIndex)
import Test.QuickCheck

listasParcialesJuzuk :: [a] -> [[a]]
listasParcialesJuzuk = elementosEnPares . listasParciales

-- (listasParciales xs) es la agrupación de los elementos de xs obtenida
-- tomando el primer elemento, los dos siguientes, los tres siguientes,
-- etc. Por ejemplo, 
--    λ> take 5 (listasParciales [1..])
--    [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]
listasParciales :: [a] -> [[a]]
listasParciales = aux 1
  where aux n xs = ys : aux (n+1) zs  
          where (ys,zs) = splitAt n xs

-- (elementosEnPares xs) es la lista de los elementos de xs en
-- posiciones pares. Por ejemplo,
--    λ> elementosEnPares [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]
--    [[1],[4,5,6],[11,12,13,14,15]]
elementosEnPares :: [a] -> [a]
elementosEnPares []       = []
elementosEnPares [x]      = [x]
elementosEnPares (x:_:xs) = x : elementosEnPares xs

sumasParcialesJuzuk :: [Integer] -> [Integer]
sumasParcialesJuzuk xs =
  scanl1 (+) (map sum (listasParcialesJuzuk xs))

-- La primera propiedad es
prop_sumasParcialesJuzuk :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk (Positive n) =
  sumasParcialesJuzuk [1..] `genericIndex` (n-1) == n^4

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk
--    +++ OK, passed 100 tests.

-- La segunda propiedad es
prop_sumasParcialesJuzuk2 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk2 (Positive n) =
  sumasParcialesJuzuk [1,3..] `genericIndex` (n-1) == n^2*(2*n^2 - 1)

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk2
--    +++ OK, passed 100 tests.

-- La tercera propiedad es
prop_sumasParcialesJuzuk3 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk3 (Positive n) =
  sumasParcialesJuzuk [1,5..] `genericIndex` (n-1) == 4*n^4-3*n^2

-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk3
--    +++ OK, passed 100 tests.

-- La cuarta propiedad es
prop_sumasParcialesJuzuk4 :: (Positive Integer) -> Bool
prop_sumasParcialesJuzuk4 (Positive n) =
  sumasParcialesJuzuk [2,3..] `genericIndex` (n-1) == n^2*(n^2+1)
  
-- Su comprobación es
--    λ> quickCheck prop_sumasParcialesJuzuk4
--    +++ OK, passed 100 tests.

import Data.List (genericIndex)

import Test.QuickCheck

listasParcialesJuzuk :: [a] -> [[a]]

listasParcialesJuzuk = elementosEnPares . listasParciales

-- (listasParciales xs) es la agrupación de los elementos de xs obtenida

-- tomando el primer elemento, los dos siguientes, los tres siguientes,

-- etc. Por ejemplo,

-- λ> take 5 (listasParciales [1..])

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

listasParciales :: [a] -> [[a]]

listasParciales = aux 1

where aux n xs = ys : aux (n+1) zs

where (ys,zs) = splitAt n xs

-- (elementosEnPares xs) es la lista de los elementos de xs en

-- posiciones pares. Por ejemplo,

-- λ> elementosEnPares [[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15]]

-- [[1],[4,5,6],[11,12,13,14,15]]

elementosEnPares :: [a] -> [a]

elementosEnPares [] = []

elementosEnPares [x] = [x]

elementosEnPares (x:_:xs) = x : elementosEnPares xs

sumasParcialesJuzuk :: [Integer] -> [Integer]

sumasParcialesJuzuk xs =

scanl1 (+) (map sum (listasParcialesJuzuk xs))

-- La primera propiedad es

prop_sumasParcialesJuzuk :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk (Positive n) =

sumasParcialesJuzuk [1..] `genericIndex` (n-1) == n^4

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk

-- +++ OK, passed 100 tests.

-- La segunda propiedad es

prop_sumasParcialesJuzuk2 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk2 (Positive n) =

sumasParcialesJuzuk [1,3..] `genericIndex` (n-1) == n^2*(2*n^2 - 1)

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk2

-- +++ OK, passed 100 tests.

-- La tercera propiedad es

prop_sumasParcialesJuzuk3 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk3 (Positive n) =

sumasParcialesJuzuk [1,5..] `genericIndex` (n-1) == 4*n^4-3*n^2

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk3

-- +++ OK, passed 100 tests.

-- La cuarta propiedad es

prop_sumasParcialesJuzuk4 :: (Positive Integer) -> Bool

prop_sumasParcialesJuzuk4 (Positive n) =

sumasParcialesJuzuk [2,3..] `genericIndex` (n-1) == n^2*(n^2+1)

-- Su comprobación es

-- λ> quickCheck prop_sumasParcialesJuzuk4

-- +++ OK, passed 100 tests.

Complemento potencial

PorJosé A. Alonso 22-enero-201829-enero-2018

El complemento potencial de un número entero positivo x es el menor número y tal que el producto de x por y es un una potencia perfecta. Por ejemplo,

el complemento potencial de 12 es 3 ya que 12 y 24 no son potencias perfectas pero 36 sí lo es;
el complemento potencial de 54 es 4 ya que 54, 108 y 162 no son potencias perfectas pero 216 = 6^3 sí lo es.

Definir las funciones

   complemento                 :: Integer -> Integer
   graficaComplementoPotencial :: Integer -> IO ()

1 2	complemento :: Integer -> Integer graficaComplementoPotencial :: Integer -> IO ()

tales que

(complemento x) es el complemento potencial de x; por ejemplo,

     complemento 12     ==  3
     complemento 54     ==  4
     complemento 720    ==  5
     complemento 24000  ==  9
     complemento 2018   ==  2018

complemento 12 == 3

complemento 54 == 4

complemento 720 == 5

complemento 24000 == 9

complemento 2018 == 2018

(graficaComplementoPotencial n) dibuja la gráfica de los complementos potenciales de los n primeros números enteros positivos. Por ejemplo, (graficaComplementoPotencial 100) dibuja

y (graficaComplementoPotencial 500) dibuja

Comprobar con QuickCheck que (complemento x) es menor o igual que x.

Soluciones

import Data.Numbers.Primes     (primeFactors)
import Data.List               (genericLength, group)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG, Title))
import Test.QuickCheck

complemento :: Integer -> Integer
complemento 1 = 1
complemento x =
  head [y | y <- [1..]
          , esPotenciaPerfecta (x*y)]
  
-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de la factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Integer]
exponentes = map snd . factorizacion
  
-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
--    mcd [4,5,10]  ==  1
mcd :: [Integer] -> Integer
mcd = foldl1 gcd

-- La propiedad es
prop_complemento :: (Positive Integer) -> Bool
prop_complemento (Positive x) =
  complemento x <= x

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

graficaComplementoPotencial :: Integer -> IO ()
graficaComplementoPotencial n =
  plotList [Key Nothing
           , PNG ("Complemento_potencial_"  ++ show n ++ ".png")
           , Title ("(graficaComplementoPotencial " ++ show n ++ ")") 
           ]
           (map complemento [1..n])

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

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

import Test.QuickCheck

complemento :: Integer -> Integer

complemento 1 = 1

complemento x =

head [y | y <- [1..]

, esPotenciaPerfecta (x*y)]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta 36 == True

-- esPotenciaPerfecta 72 == False

esPotenciaPerfecta :: Integer -> Bool

esPotenciaPerfecta x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de la factorización prima

-- de x. Por ejemplos,

-- exponentes 36 == [2,2]

-- exponentes 72 == [3,2]

exponentes :: Integer -> [Integer]

exponentes = map snd . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,

-- factorizacion 1400 == [(2,3),(5,2),(7,1)]

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

factorizacion n =

[(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,

-- mcd [4,6,10] == 2

-- mcd [4,5,10] == 1

mcd :: [Integer] -> Integer

mcd = foldl1 gcd

-- La propiedad es

prop_complemento :: (Positive Integer) -> Bool

prop_complemento (Positive x) =

complemento x <= x

-- La comprobación es

-- λ> quickCheck prop_complemento

-- +++ OK, passed 100 tests.

graficaComplementoPotencial :: Integer -> IO ()

graficaComplementoPotencial n =

plotList [Key Nothing

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

, Title ("(graficaComplementoPotencial " ++ show n ++ ")")

]

(map complemento [1..n])

Terna pitagórica a partir de un lado

PorJosé A. Alonso 19-enero-201819-febrero-2018

Una terna pitagórica con primer lado x es una terna (x,y,z) tal que x^2 + y^2 = z^2. Por ejemplo, las ternas pitagóricas con primer lado 16 son (16,12,20), (16,30,34) y (16,63,65).

Definir las funciones

   ternasPitagoricas      :: Integer -> [(Integer,Integer,Integer)]
   mayorTernaPitagorica   :: Integer -> (Integer,Integer,Integer)
   graficaMayorHipotenusa :: Integer -> IO ()

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

mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)

graficaMayorHipotenusa :: Integer -> IO ()

tales que

(ternasPitgoricas x) es la lista de las ternas pitagóricas con primer lado x. Por ejemplo,

     ternasPitagoricas 16 == [(16,12,20),(16,30,34),(16,63,65)]
     ternasPitagoricas 20 == [(20,15,25),(20,21,29),(20,48,52),(20,99,101)]
     ternasPitagoricas 25 == [(25,60,65),(25,312,313)]
     ternasPitagoricas 26 == [(26,168,170)]

ternasPitagoricas 16 == [(16,12,20),(16,30,34),(16,63,65)]

ternasPitagoricas 20 == [(20,15,25),(20,21,29),(20,48,52),(20,99,101)]

ternasPitagoricas 25 == [(25,60,65),(25,312,313)]

ternasPitagoricas 26 == [(26,168,170)]

(mayorTernaPitagorica x) es la mayor de las ternas pitagóricas con primer lado x. Por ejemplo,

     mayorTernaPitagorica 16     ==  (16,63,65)
     mayorTernaPitagorica 20     ==  (20,99,101)
     mayorTernaPitagorica 25     ==  (25,312,313)
     mayorTernaPitagorica 26     ==  (26,168,170)
     mayorTernaPitagorica 2018   ==  (2018,1018080,1018082)
     mayorTernaPitagorica 2019   ==  (2019,2038180,2038181)

mayorTernaPitagorica 16 == (16,63,65)

mayorTernaPitagorica 20 == (20,99,101)

mayorTernaPitagorica 25 == (25,312,313)

mayorTernaPitagorica 26 == (26,168,170)

mayorTernaPitagorica 2018 == (2018,1018080,1018082)

mayorTernaPitagorica 2019 == (2019,2038180,2038181)

(graficaMayorHipotenusa n) dibuja la gráfica de las sucesión de las mayores hipotenusas de las ternas pitagóricas con primer lado x, para x entre 3 y n. Por ejemplo, (graficaMayorHipotenusa 100) dibuja

Soluciones

import Graphics.Gnuplot.Simple

-- Definición de ternasPitagoricas
-- ===============================

ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas x =
  [(x,y,z) | y <- [1..(x^ 2 - 1) `div` 2 ]
           , z <- raizCuadrada (x^2 + y^2)]

-- La justificación de la cota es
--    x > 2
--    x^2 + y^2 >= (y+1)^2
--    x^2 + y^2 >= y^2 + 2*y + 1
--    y =< (x^ 2 - 1) `div` 2 

-- (raizCuadrada x) es la lista formada por la raíz cuadrada entera de
-- x, si existe y la lista vacía, en caso contrario. Por ejemplo, 
--    raizCuadrada 25  ==  [5]
--    raizCuadrada 26  ==  []
raizCuadrada :: Integer -> [Integer]
raizCuadrada x =
  [y | y <- [(round . sqrt . fromIntegral) x]
     , y^2 == x]


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

mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica =
  last . ternasPitagoricas

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

mayorTernaPitagorica2 :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica2 x =
  head [(x,y,z) | y <- [k, k-1 .. 1]
                , z <- raizCuadrada (x^2 + y^2)]
  where k = (x^2 - 1) `div` 2

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

-- Se supone que x > 2. Se consideran dos casos:
-- 
-- Primer caso: Supongamos que x es par. Entonces x^2 > 4 y es divisible
-- por 4. Por tanto, existe un y tal que x^2 = 4*y + 4; luego,
--    x^2 + y^2 = 4*y + 4 + y^2
--              = (y + 2)^2
-- La terna es (x,y,y+2) donde y = (x^2 - 4) / 4.
--
-- Segundo caso: Supongamos que x es impar. Entonces x^2 es impar. Por
-- tanto, existe un y tal que x^2 = 2*y + 1; luego,
--    x^2 + y^2 = 2*y + 1 + y^2
--              = (y+1)^2
-- La terna es (x,y,y+1) donde y = (x^2 - 1) / 2.

mayorTernaPitagorica3 :: Integer -> (Integer,Integer,Integer)
mayorTernaPitagorica3 x
  | even x    = (x, y1, y1 + 2)
  | otherwise = (x, y2, y2 + 1)
    where y1 = (x^2 - 4) `div` 4
          y2 = (x^2 - 1) `div` 2 

-- Comparación de eficiencia
--    λ> mayorTernaPitagorica 1006
--    (1006,253008,253010)
--    (7.36 secs, 1,407,793,992 bytes)
--    λ> mayorTernaPitagorica2 1006
--    (1006,253008,253010)
--    (3.76 secs, 704,007,456 bytes)
--    λ> mayorTernaPitagorica3 1006
--    (1006,253008,253010)
--    (0.01 secs, 157,328 bytes)

graficaMayorHipotenusa :: Integer -> IO ()
graficaMayorHipotenusa n =
  plotList [ Key Nothing
           , PNG "Terna_pitagorica_a_partir_de_un_lado.png"
           ]
           [(x,z) | x <- [3..n]
                  , let (_,_,z) = mayorTernaPitagorica3 x]

import Graphics.Gnuplot.Simple

-- Definición de ternasPitagoricas

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

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

ternasPitagoricas x =

[(x,y,z) | y <- [1..(x^ 2 - 1) `div` 2 ]

, z <- raizCuadrada (x^2 + y^2)]

-- La justificación de la cota es

-- x > 2

-- x^2 + y^2 >= (y+1)^2

-- x^2 + y^2 >= y^2 + 2*y + 1

-- y =< (x^ 2 - 1) `div` 2

-- (raizCuadrada x) es la lista formada por la raíz cuadrada entera de

-- x, si existe y la lista vacía, en caso contrario. Por ejemplo,

-- raizCuadrada 25 == [5]

-- raizCuadrada 26 == []

raizCuadrada :: Integer -> [Integer]

raizCuadrada x =

[y | y <- [(round . sqrt . fromIntegral) x]

, y^2 == x]

-- 1ª definición de mayorTernaPitagorica

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

mayorTernaPitagorica :: Integer -> (Integer,Integer,Integer)

mayorTernaPitagorica =

last . ternasPitagoricas

-- 2ª definición de mayorTernaPitagorica

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

mayorTernaPitagorica2 :: Integer -> (Integer,Integer,Integer)

mayorTernaPitagorica2 x =

head [(x,y,z) | y <- [k, k-1 .. 1]

, z <- raizCuadrada (x^2 + y^2)]

where k = (x^2 - 1) `div` 2

-- 3ª definición de mayorTernaPitagorica

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

-- Se supone que x > 2. Se consideran dos casos:

-- Primer caso: Supongamos que x es par. Entonces x^2 > 4 y es divisible

-- por 4. Por tanto, existe un y tal que x^2 = 4*y + 4; luego,

-- x^2 + y^2 = 4*y + 4 + y^2

-- = (y + 2)^2

-- La terna es (x,y,y+2) donde y = (x^2 - 4) / 4.

-- Segundo caso: Supongamos que x es impar. Entonces x^2 es impar. Por

-- tanto, existe un y tal que x^2 = 2*y + 1; luego,

-- x^2 + y^2 = 2*y + 1 + y^2

-- = (y+1)^2

-- La terna es (x,y,y+1) donde y = (x^2 - 1) / 2.

mayorTernaPitagorica3 :: Integer -> (Integer,Integer,Integer)

mayorTernaPitagorica3 x

| even x = (x, y1, y1 + 2)

| otherwise = (x, y2, y2 + 1)

where y1 = (x^2 - 4) `div` 4

y2 = (x^2 - 1) `div` 2

-- Comparación de eficiencia

-- λ> mayorTernaPitagorica 1006

-- (1006,253008,253010)

-- (7.36 secs, 1,407,793,992 bytes)

-- λ> mayorTernaPitagorica2 1006

-- (1006,253008,253010)

-- (3.76 secs, 704,007,456 bytes)

-- λ> mayorTernaPitagorica3 1006

-- (1006,253008,253010)

-- (0.01 secs, 157,328 bytes)

graficaMayorHipotenusa :: Integer -> IO ()

graficaMayorHipotenusa n =

plotList [ Key Nothing

, PNG "Terna_pitagorica_a_partir_de_un_lado.png"

]

[(x,z) | x <- [3..n]

, let (_,_,z) = mayorTernaPitagorica3 x]

Escalada hasta un primo

PorJosé A. Alonso 18-enero-201819-febrero-2018

Este ejercicio está basado en el artículo La conjetura de la «escalada hasta un primo» publicado esta semana por Miguel Ángel Morales en su blog Gaussianos.

La conjetura de escalada hasta un primo trata, propuesta por John Horton Conway, es sencilla de plantear, pero primero vamos a ver qué es eso de escalar hasta un primo. Tomamos un número cualquiera y lo descomponemos en factores primos (colocados en orden ascendente). Si el número era primo, ya hemos acabado; si no era primo, construimos el número formado por los factores primos y los exponentes de los mismos colocados tal cual salen en la factorización. Con el número obtenido hacemos lo mismo que antes. La escalada finaliza cuando obtengamos un número primo. Por ejemplo, para obtener la escalada prima de 1400, como no es primo, se factoriza (obteniéndose 2^3 * 5^2 * 7) y se unen bases y exponentes (obteniéndose 23527). Con el 23527 se repite el proceso obteniéndose la factorización (7 * 3361) y su unión (73361). Como el 73361 es primo, termina la escalada. Por tanto, la escalada de 1400 es [1400,23527,73361].

La conjetura de Conway sobre «escalada hasta un primo» dice que todo número natural mayor o igual que 2 termina su escalada en un número primo.

Definir las funciones

   escaladaPrima                :: Integer -> [Integer]
   longitudEscaladaPrima        :: Integer -> Integer
   longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer
   graficaEscalada              :: Integer -> Integer -> IO ()

escaladaPrima :: Integer -> [Integer]

longitudEscaladaPrima :: Integer -> Integer

longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer

graficaEscalada :: Integer -> Integer -> IO ()

tales que

(escaladaPrima n) es la escalada prima de n. Por ejemplo,

     λ> escaladaPrima 1400
     [1400,23527,73361]
     λ> escaladaPrima 333
     [333,3237,31383,3211317,3217139151,39722974813]
     λ> take 10 (escaladaPrima 20)
     [20,225,3252,223271,297699,399233,715623,3263907,32347303,160720129]
     λ> take 3 (escaladaPrima 13532385396179)
     [13532385396179,13532385396179,13532385396179]
     λ> take 2 (escaladaPrima 45214884853168941713016664887087462487)
     [45214884853168941713016664887087462487,13532385396179]

λ> escaladaPrima 1400

[1400,23527,73361]

λ> escaladaPrima 333

[333,3237,31383,3211317,3217139151,39722974813]

λ> take 10 (escaladaPrima 20)

[20,225,3252,223271,297699,399233,715623,3263907,32347303,160720129]

λ> take 3 (escaladaPrima 13532385396179)

[13532385396179,13532385396179,13532385396179]

λ> take 2 (escaladaPrima 45214884853168941713016664887087462487)

[45214884853168941713016664887087462487,13532385396179]

(longitudEscaladaPrima n) es la longitud de la escalada prima de n. Por ejemplo,

     longitudEscaladaPrima 1400  ==  3
     longitudEscaladaPrima 333   ==  6

1 2	longitudEscaladaPrima 1400 == 3 longitudEscaladaPrima 333 == 6

(longitudEscaladaPrimaAcotada n k) es el mínimo entre la longitud de la escalada prima de n y k. Por ejemplo,

     longitudEscaladaPrimaAcotada 333 10  ==  6
     longitudEscaladaPrimaAcotada 333 4   ==  4
     longitudEscaladaPrimaAcotada 20 4    ==  4

longitudEscaladaPrimaAcotada 333 10 == 6

longitudEscaladaPrimaAcotada 333 4 == 4

longitudEscaladaPrimaAcotada 20 4 == 4

(graficaEscalada n k) dibuja la gráfica de (longitudEscaladaPrimaAcotada x k) para x entre 2 y n. Por ejemplo, (graficaEscalada 120 15) dibuja

Soluciones

import Data.List (genericLength, group)
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple

-- Definición de escaladaPrima 
escaladaPrima :: Integer -> [Integer]
escaladaPrima n
  | isPrime n = [n]
  | otherwise = n : escaladaPrima (siguiente n)

-- (siguiente n) es el siguiente de n en la escalada hacia un primo. Por
-- ejemplo, 
--    siguiente 1400  ==  23527
siguiente :: Integer -> Integer
siguiente = paresAnumero . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (paAnumero p) es el número obtenido pegando las dos componentes de p
-- (si la segunda es mayor que 1) o sólo la primera componente, en caso
-- contrario. Por ejemplo, 
--    parAnumero (7,1)  ==  7
--    parAnumero (23,5)  ==  235
parAnumero :: (Integer,Integer) -> Integer
parAnumero (n,1) = n
parAnumero (n,k) = read (show n ++ show k)

-- (paresA numeros ps) es el número obtenido aplicando parAnumero a cada
-- uno de los pares de ps. Por ejemplo,
--    paresAnumero [(2,3),(5,2),(7,1)]  ==  23527
paresAnumero :: [(Integer,Integer)] -> Integer
paresAnumero = read . concatMap (show . parAnumero)

-- Definición de longitudEscaladaPrima
longitudEscaladaPrima :: Integer -> Integer
longitudEscaladaPrima n
  | isPrime n = 1
  | otherwise = 1 + longitudEscaladaPrima (siguiente n)

-- Definición de longitudEscaladaPrimaAcotada
longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer
longitudEscaladaPrimaAcotada _ 0 = 0
longitudEscaladaPrimaAcotada n k
  | isPrime n = 1
  | otherwise = 1 + longitudEscaladaPrimaAcotada (siguiente n) (k-1)

-- Definición de graficaEscalada 
graficaEscalada :: Integer -> Integer -> IO ()
graficaEscalada n k =
  plotList [ Key Nothing
           , PNG "Escalada_hasta_un_primo.png"
           , Title ("graficaEscalada " ++ show n ++ " " ++ show k)
           , XLabel "Numeros"
           , YLabel "Longitud de escalada"
           ]
           [(x,longitudEscaladaPrimaAcotada x k) | x <- [2..n]]

import Data.List (genericLength, group)

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

-- Definición de escaladaPrima

escaladaPrima :: Integer -> [Integer]

escaladaPrima n

| isPrime n = [n]

| otherwise = n : escaladaPrima (siguiente n)

-- (siguiente n) es el siguiente de n en la escalada hacia un primo. Por

-- ejemplo,

-- siguiente 1400 == 23527

siguiente :: Integer -> Integer

siguiente = paresAnumero . factorizacion

-- (factorizacion n) es la factorizacion prima de n. Por ejemplo,

-- factorizacion 1400 == [(2,3),(5,2),(7,1)]

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

factorizacion n =

[(x,genericLength xs) | xs@(x:_) <- group (primeFactors n)]

-- (paAnumero p) es el número obtenido pegando las dos componentes de p

-- (si la segunda es mayor que 1) o sólo la primera componente, en caso

-- contrario. Por ejemplo,

-- parAnumero (7,1) == 7

-- parAnumero (23,5) == 235

parAnumero :: (Integer,Integer) -> Integer

parAnumero (n,1) = n

parAnumero (n,k) = read (show n ++ show k)

-- (paresA numeros ps) es el número obtenido aplicando parAnumero a cada

-- uno de los pares de ps. Por ejemplo,

-- paresAnumero [(2,3),(5,2),(7,1)] == 23527

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

paresAnumero = read . concatMap (show . parAnumero)

-- Definición de longitudEscaladaPrima

longitudEscaladaPrima :: Integer -> Integer

longitudEscaladaPrima n

| isPrime n = 1

| otherwise = 1 + longitudEscaladaPrima (siguiente n)

-- Definición de longitudEscaladaPrimaAcotada

longitudEscaladaPrimaAcotada :: Integer -> Integer -> Integer

longitudEscaladaPrimaAcotada _ 0 = 0

longitudEscaladaPrimaAcotada n k

| isPrime n = 1

| otherwise = 1 + longitudEscaladaPrimaAcotada (siguiente n) (k-1)

-- Definición de graficaEscalada

graficaEscalada :: Integer -> Integer -> IO ()

graficaEscalada n k =

plotList [ Key Nothing

, PNG "Escalada_hasta_un_primo.png"

, Title ("graficaEscalada " ++ show n ++ " " ++ show k)

, XLabel "Numeros"

, YLabel "Longitud de escalada"

]

[(x,longitudEscaladaPrimaAcotada x k) | x <- [2..n]]

Números como diferencias de potencias

PorJosé A. Alonso 17-enero-201819-febrero-2018

El número 45 se puede escribir de tres formas como diferencia de los cuadrados de dos números naturales:

   45 =  7^2 -  2^2 
      =  9^2 -  6^2
      = 23^2 - 22^2

45 = 7^2 - 2^2

= 9^2 - 6^2

= 23^2 - 22^2

Definir la función

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

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

tal que (diferencias x n) es la lista de pares tales que la diferencia de sus potencias n-ésima es x. Por ejemplo,

   diferencias 45 2    ==  [(7,2),(9,6),(23,22)]
   diferencias 50 2    ==  []
   diferencias 19 3    ==  [(3,2)]
   diferencias 8 3     ==  [(2,0)]
   diferencias 15 4    ==  [(2,1)]
   diferencias 4035 2  ==  [(142,127),(406,401),(674,671),(2018,2017)]
   head (diferencias 1161480105172255454401 5)  ==  (123456,123455)

diferencias 45 2 == [(7,2),(9,6),(23,22)]

diferencias 50 2 == []

diferencias 19 3 == [(3,2)]

diferencias 8 3 == [(2,0)]

diferencias 15 4 == [(2,1)]

diferencias 4035 2 == [(142,127),(406,401),(674,671),(2018,2017)]

head (diferencias 1161480105172255454401 5) == (123456,123455)

Soluciones

-- 1ª definición
diferencias :: Integer -> Integer -> [(Integer,Integer)]
diferencias x n = [(a,b) | b <- [0..x]
                         , a <- [b..x]
                         , x == a^n - b^n]

-- 2ª definición
diferencias2 :: Integer -> Integer -> [(Integer,Integer)]
diferencias2 x n =
  [(a,b) | a <- [1..x]
         , a^n >= x
         , let b = round ((fromIntegral (a^n - x)) ** (1/fromIntegral n))
         , x == a^n - b^n]

-- 3ª definición
diferencias3 :: Integer -> Integer -> [(Integer,Integer)]
diferencias3 x n =
  [(a,b) | a <- [0..x]
         , a^n >= x
         , b <- raizEntera n (a^n - x)]

raizEntera :: Integer -> Integer -> [Integer]
raizEntera n x 
  | y^n == x  = [y]
  | otherwise = []
  where y = head [k | k <- [0..], k^n >= x] 

-- 4ª definición
diferencias4 :: Integer -> Integer -> [(Integer,Integer)]
diferencias4 x n =
  [(a,b) | a <- [0..x]
         , a^n >= x
         , b <- raizEntera n (a^n - x)]
  where potencias = [(k,k^n) | k <- [0..]]
        raizEntera n x 
          | yn == x   = [y]
          | otherwise = []
          where (y,yn) = head [(k,kn) | (k,kn) <- potencias, kn >= x]

-- Comparación de eficiencia
--    λ> head (diferencias 7351 3)
--    (50,49)
--    (2.16 secs, 533,868,368 bytes)
--    λ> head (diferencias2 7351 3)
--    (50,49)
--    (0.01 secs, 270,040 bytes)
--    λ> head (diferencias3 7351 3)
--    (50,49)
--    (0.01 secs, 1,021,720 bytes)
--    λ> head (diferencias4 7351 3)
--    (50,49)
--    (0.01 secs, 316,536 bytes)

-- 1ª definición

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

diferencias x n = [(a,b) | b <- [0..x]

, a <- [b..x]

, x == a^n - b^n]

-- 2ª definición

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

diferencias2 x n =

[(a,b) | a <- [1..x]

, a^n >= x

, let b = round ((fromIntegral (a^n - x)) ** (1/fromIntegral n))

, x == a^n - b^n]

-- 3ª definición

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

diferencias3 x n =

[(a,b) | a <- [0..x]

, a^n >= x

, b <- raizEntera n (a^n - x)]

raizEntera :: Integer -> Integer -> [Integer]

raizEntera n x

| y^n == x = [y]

| otherwise = []

where y = head [k | k <- [0..], k^n >= x]

-- 4ª definición

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

diferencias4 x n =

[(a,b) | a <- [0..x]

, a^n >= x

, b <- raizEntera n (a^n - x)]

where potencias = [(k,k^n) | k <- [0..]]

raizEntera n x

| yn == x = [y]

| otherwise = []

where (y,yn) = head [(k,kn) | (k,kn) <- potencias, kn >= x]

-- Comparación de eficiencia

-- λ> head (diferencias 7351 3)

-- (50,49)

-- (2.16 secs, 533,868,368 bytes)

-- λ> head (diferencias2 7351 3)

-- (50,49)

-- (0.01 secs, 270,040 bytes)

-- λ> head (diferencias3 7351 3)

-- (50,49)

-- (0.01 secs, 1,021,720 bytes)

-- λ> head (diferencias4 7351 3)

-- (50,49)

-- (0.01 secs, 316,536 bytes)

Fractal hexagonal

PorJosé A. Alonso 16-enero-201819-febrero-2018

Escribir, usando CodeWorld, un programa para dibujar el fractal hexagonal que se muestra en la siguiente animación

Las 4 primeras fases de la animación son

Fase 0:
Fase 1:
Fase 2:
Fase 3:

Nota: Este ejercicio ha sido propuesto por Agustín Martín Aguera.

Soluciones

import CodeWorld

main :: IO()
main = animationOf (hexagono . s)

hexagono :: Int -> Picture
hexagono 0 =
  colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]
  where c = 9 * sin (pi / 3)
hexagono n =
  pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))
  where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int
s t = mod (floor t) 5

import CodeWorld

main :: IO()

main = animationOf (hexagono . s)

hexagono :: Int -> Picture

hexagono 0 =

colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]

where c = 9 * sin (pi / 3)

hexagono n =

pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))

where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int

s t = mod (floor t) 5

Sumas parciales de Nicómaco

PorJosé A. Alonso 15-enero-201825-marzo-2022

Nicómaco de Gerasa vivió en Palestina entre los siglos I y II de nuestra era. Escribió Arithmetike eisagoge (Introducción a la aritmética) que es el primer trabajo en donde se trata la Aritmética de forma separada a la Geometría. En el tratado se encuentra la siguiente proposición: «si se escriben los números impares

   1, 3, 5, 7, 9, 11, 13, 15, 17, ...

1	1, 3, 5, 7, 9, 11, 13, 15, 17, ...

entonces el primero es el cubo de 1; la suma de los dos siguientes, el cubo de 2; la suma de los tres siguientes, el cubo de 3; y así sucesivamente.»

Definir las siguientes funciones

   listasParciales :: [a] -> [[a]]
   sumasParciales  :: [Int] -> [Int]

1 2	listasParciales :: [a] -> [[a]] sumasParciales :: [Int] -> [Int]

tales que

(listasParciales xs) es la lista obtenido agrupando los elementos de la lista infinita xs de forma que la primera tiene 0 elementos; la segunda, el primer elemento de xs; la tercera, los dos siguientes; y así sucesivamente. Por ejemplo,

     λ> take 7 (listasParciales [1..])
     [[],[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15],[16,17,18,19,20,21]]
     λ> take 7 (listasParciales [1,3..])
     [[],[1],[3,5],[7,9,11],[13,15,17,19],[21,23,25,27,29],[31,33,35,37,39,41]]

λ> take 7 (listasParciales [1..])

[[],[1],[2,3],[4,5,6],[7,8,9,10],[11,12,13,14,15],[16,17,18,19,20,21]]

λ> take 7 (listasParciales [1,3..])

[[],[1],[3,5],[7,9,11],[13,15,17,19],[21,23,25,27,29],[31,33,35,37,39,41]]

(sumasParciales xs) es la lista de las sumas parciales de la lista infinita xs. Por ejemplo,

     λ> take 15 (sumasParciales [1..])
     [0,1,5,15,34,65,111,175,260,369,505,671,870,1105,1379]
     λ> take 15 (sumasParciales [1,3..])
     [0,1,8,27,64,125,216,343,512,729,1000,1331,1728,2197,2744]

λ> take 15 (sumasParciales [1..])

[0,1,5,15,34,65,111,175,260,369,505,671,870,1105,1379]

λ> take 15 (sumasParciales [1,3..])

[0,1,8,27,64,125,216,343,512,729,1000,1331,1728,2197,2744]

Comprobar con QuickChek la propiedad de Nicómaco; es decir, que para todo número natural n, el término n-ésimo de (sumasParciales [1,3..]) es el cubo de n.

Soluciones

import Test.QuickCheck

listasParciales :: [a] -> [[a]]
listasParciales = aux 0
  where aux n xs = ys : aux (n+1) zs  
          where (ys,zs) = splitAt n xs

sumasParciales :: [Int] -> [Int]
sumasParciales = map sum . listasParciales

prop_Nicomaco :: (Positive Int) -> Bool
prop_Nicomaco (Positive n) =
  sumasParciales [1,3..] !! n == n^3

import Test.QuickCheck

listasParciales :: [a] -> [[a]]

listasParciales = aux 0

where aux n xs = ys : aux (n+1) zs

where (ys,zs) = splitAt n xs

sumasParciales :: [Int] -> [Int]

sumasParciales = map sum . listasParciales

prop_Nicomaco :: (Positive Int) -> Bool

prop_Nicomaco (Positive n) =

sumasParciales [1,3..] !! n == n^3

Números malvados y odiosos

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

Un número malvado es un número natural cuya expresión en base 2 (binaria) contiene un número par de unos.

Un número odioso es un número natural cuya expresión en base 2 (binaria) contiene un número impar de unos.

Podemos representar los números malvados y odiosos mediante el siguiente tipo de dato

  data MalvadoOdioso = Malvado | Odioso deriving Show

1	data MalvadoOdioso = Malvado \| Odioso deriving Show

Definir la función

  malvadoOdioso :: Integer -> MalvadoOdioso

1	malvadoOdioso :: Integer -> MalvadoOdioso

tal que (malvadoOdioso n) devuelve el tipo de número que es n. Por ejemplo,

   λ> malvadoOdioso 11
   Odioso
   λ> malvadoOdioso 12
   Malvado
   λ> malvadoOdioso3 (10^20000000)
   Odioso
   λ> malvadoOdioso3 (1+10^20000000)
   Malvado

λ> malvadoOdioso 11

Odioso

λ> malvadoOdioso 12

Malvado

λ> malvadoOdioso3 (10^20000000)

Odioso

λ> malvadoOdioso3 (1+10^20000000)

Malvado

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

Soluciones

import Data.List (genericLength)
import Data.Bits (popCount)

data MalvadoOdioso = Malvado | Odioso
  deriving (Eq, Show)

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

malvadoOdioso :: Integer -> MalvadoOdioso
malvadoOdioso n | (even . numeroUnosBin) n = Malvado
                | otherwise                = Odioso

-- (numeroUnosBin n) es el número de unos de la representación binaria
-- del número decimal n. Por ejemplo,
--   numeroUnosBin 11  ==  3
--   numeroUnosBin 12  ==  2
numeroUnosBin :: Integer -> Integer
numeroUnosBin = genericLength . filter (/= 0) . intBin

-- (intBin n) es el número binario correspondiente al número decimal n.
-- Por ejemplo, 
--   intBin 11  ==  [1,1,0,1]
--   intBin 12  ==  [0,0,1,1]
intBin :: Integer -> [Integer]
intBin n | n < 2     = [n]
         | otherwise = n `mod` 2 : intBin (n `div` 2)

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

malvadoOdioso2 :: Integer -> MalvadoOdioso
malvadoOdioso2 n | (even . numeroIntBin) n = Malvado
                 | otherwise               = Odioso

-- (numeroIntBin n) es el número de unos que contiene la representación
-- binaria del número decimal n. Por ejemplo,
--   numeroIntBin 11  ==  3
--   numeroIntBin 12  ==  2
numeroIntBin :: Integer -> Integer
numeroIntBin n | n < 2     = n
               | otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

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

malvadoOdioso3 :: Integer -> MalvadoOdioso
malvadoOdioso3 n | (even . popCount) n = Malvado
                 | otherwise           = Odioso

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

--   λ> malvadoOdioso (10^40000)
--   Odioso
--   (3.25 secs, 1,167,416,968 bytes)
--   λ> malvadoOdioso2 (10^40000)
--   Odioso
--   (4.03 secs, 1,164,863,744 bytes)
--   λ> malvadoOdioso3 (10^40000)
--   Odioso
--   (0.00 secs, 165,312 bytes)

import Data.List (genericLength)

import Data.Bits (popCount)

data MalvadoOdioso = Malvado | Odioso

deriving (Eq, Show)

-- 1ª solución

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

malvadoOdioso :: Integer -> MalvadoOdioso

malvadoOdioso n | (even . numeroUnosBin) n = Malvado

| otherwise = Odioso

-- (numeroUnosBin n) es el número de unos de la representación binaria

-- del número decimal n. Por ejemplo,

-- numeroUnosBin 11 == 3

-- numeroUnosBin 12 == 2

numeroUnosBin :: Integer -> Integer

numeroUnosBin = genericLength . filter (/= 0) . intBin

-- (intBin n) es el número binario correspondiente al número decimal n.

-- Por ejemplo,

-- intBin 11 == [1,1,0,1]

-- intBin 12 == [0,0,1,1]

intBin :: Integer -> [Integer]

intBin n | n < 2 = [n]

| otherwise = n `mod` 2 : intBin (n `div` 2)

-- 2ª solución

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

malvadoOdioso2 :: Integer -> MalvadoOdioso

malvadoOdioso2 n | (even . numeroIntBin) n = Malvado

| otherwise = Odioso

-- (numeroIntBin n) es el número de unos que contiene la representación

-- binaria del número decimal n. Por ejemplo,

-- numeroIntBin 11 == 3

-- numeroIntBin 12 == 2

numeroIntBin :: Integer -> Integer

numeroIntBin n | n < 2 = n

| otherwise = n `mod` 2 + numeroIntBin (n `div` 2)

-- 3ª solución

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

malvadoOdioso3 :: Integer -> MalvadoOdioso

malvadoOdioso3 n | (even . popCount) n = Malvado

| otherwise = Odioso

-- Comparación de eficiencia

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

-- λ> malvadoOdioso (10^40000)

-- Odioso

-- (3.25 secs, 1,167,416,968 bytes)

-- λ> malvadoOdioso2 (10^40000)

-- Odioso

-- (4.03 secs, 1,164,863,744 bytes)

-- λ> malvadoOdioso3 (10^40000)

-- Odioso

-- (0.00 secs, 165,312 bytes)

Ordenación por frecuencia

PorJosé A. Alonso 11-enero-201819-febrero-2018

Definir la función

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

1	ordPorFrecuencia :: Ord a => [a] -> [a]

tal que (ordPorFrecuencia xs) es la lista obtenidas ordenando los elementos de xs por su frecuencia, de los que aparecen más a los que aparecen menos, y los que aparecen el mismo número de veces se ordenan de manera creciente según su valor. Por ejemplo,

   ordPorFrecuencia "canalDePanama"      ==  "aaaaannmlecPD"
   ordPorFrecuencia "11012018"           ==  "11110082"
   ordPorFrecuencia [2,3,5,3,7,9,5,3,7]  ==  [3,3,3,7,7,5,5,9,2]

ordPorFrecuencia "canalDePanama" == "aaaaannmlecPD"

ordPorFrecuencia "11012018" == "11110082"

ordPorFrecuencia [2,3,5,3,7,9,5,3,7] == [3,3,3,7,7,5,5,9,2]

Soluciones

import Test.QuickCheck

import Data.List (group, sort, sortBy)
import Data.Function (on)

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

ordPorFrecuencia1 :: Ord a => [a] -> [a]
ordPorFrecuencia1 xs =
  concatMap snd (reverse (sort [(length xs,xs) | xs <- group (sort xs)]))

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

ordPorFrecuencia2 :: Ord a => [a] -> [a]
ordPorFrecuencia2 =
    concat . reverse . sortBy comparaPorLongitud . group . sort

comparaPorLongitud :: [a] -> [a] -> Ordering
comparaPorLongitud xs ys = compare (length xs) (length ys)

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

ordPorFrecuencia3 :: Ord a => [a] -> [a]
ordPorFrecuencia3 =
    concat . reverse . sortBy (compare `on` length). group . sort

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

--    λ> xs = show (2^2000000)
--    λ> last (ordPorFrecuencia1 xs)
--    '8'
--    (1.45 secs, 938,345,320 bytes)
--    λ> last (ordPorFrecuencia2 xs)
--    '8'
--    (1.33 secs, 900,239,200 bytes)
--    λ> last (ordPorFrecuencia3 xs)
--    '8'
--    (1.30 secs, 900,241,848 bytes)

import Test.QuickCheck

import Data.List (group, sort, sortBy)

import Data.Function (on)

-- 1ª solución

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

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

ordPorFrecuencia1 xs =

concatMap snd (reverse (sort [(length xs,xs) | xs <- group (sort xs)]))

-- 2ª solución

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

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

ordPorFrecuencia2 =

concat . reverse . sortBy comparaPorLongitud . group . sort

comparaPorLongitud :: [a] -> [a] -> Ordering

comparaPorLongitud xs ys = compare (length xs) (length ys)

-- 3ª solución

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

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

ordPorFrecuencia3 =

concat . reverse . sortBy (compare `on` length). group . sort

-- Comparación de eficiencia

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

-- λ> xs = show (2^2000000)

-- λ> last (ordPorFrecuencia1 xs)

-- '8'

-- (1.45 secs, 938,345,320 bytes)

-- λ> last (ordPorFrecuencia2 xs)

-- '8'

-- (1.33 secs, 900,239,200 bytes)

-- λ> last (ordPorFrecuencia3 xs)

-- '8'

-- (1.30 secs, 900,241,848 bytes)

Números somirp

PorJosé A. Alonso 10-enero-201819-febrero-2018

Un número omirp es un número primo que forma un primo distinto al invertir el orden de sus dígitos.

Definir las funciones

  esOmirp            :: Integer -> Bool
  omirps             :: [Integer]
  nOmirpsIntermedios :: Int -> Int

esOmirp :: Integer -> Bool

omirps :: [Integer]

nOmirpsIntermedios :: Int -> Int

tales que

(esOmirp n) se verifica si n es un número omirp. Por ejemplo,

     esOmirp 13      ==  True
     esOmirp 11      ==  False
     esOmirp 112207  ==  True

esOmirp 13 == True

esOmirp 11 == False

esOmirp 112207 == True

omirps es la lista de los números omirps. Por ejemplo,

     take 15 omirps  ==  [13,17,31,37,71,73,79,97,107,113]
     omirps !! 2000  ==  112207

1 2	take 15 omirps == [13,17,31,37,71,73,79,97,107,113] omirps !! 2000 == 112207

(nOmirpsIntermedios n) es la cantidad de números omirps entre el n-ésimo número omirp y el obtenido al invertir el orden de sus dígitos. Por ejemplo,

     nOmirpsIntermedios 2000  ==  4750

1	nOmirpsIntermedios 2000 == 4750

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

Soluciones

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool
esOmirp n = n /= rn && isPrime rn
  where rn = read . reverse . show $ n

omirps :: [Integer]
omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int
nOmirpsIntermedios n =
  length
  . filter esOmirp
  . takeWhile (< rx)
  . dropWhile (<= x) $ primes
  where x  = omirps !! n
        rx = read . reverse . show $ x

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool

esOmirp n = n /= rn && isPrime rn

where rn = read . reverse . show $ n

omirps :: [Integer]

omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int

nOmirpsIntermedios n =

length

. filter esOmirp

. takeWhile (< rx)

. dropWhile (<= x) $ primes

where x = omirps !! n

rx = read . reverse . show $ x

Enumeración de los números enteros

PorJosé A. Alonso 9-enero-201825-marzo-2022

Definir la sucesión

   enteros :: [Int]

1	enteros :: [Int]

tal que sus elementos son los números enteros comenzando en el 0 e intercalando los positivos y los negativos. Por ejemplo,

   ghci> take 23 enteros
   [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

1 2	ghci> take 23 enteros [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es
(1-(2*n+1)*(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_enteros

1	quickCheckWith (stdArgs {maxSize=7}) prop_enteros

Soluciones

import Test.QuickCheck
import Control.Applicative ((<**>))

-- 1ª definición
enteros :: [Int]
enteros = 0 : concat [[n,-n] | n <- [1..]]

-- 2ª definición
enteros2 :: [Int]
enteros2 = 0 : [y | x <- [1..], y <- [x, -x]]

-- 3ª definición
enteros3 :: [Int]
enteros3 = iterate siguiente 0
  where siguiente i | i > 0     = -i
                    | otherwise = 1 - i

-- 4ª definición
enteros4 :: [Int]
enteros4 = iterate (\i -> if i > 0 then -i else 1-i) 0

-- 5ª definición
enteros5 :: [Int]
enteros5 = 0 : [f x | x <- [1..], f <- [id, negate]]

-- 6ª definición
enteros6 :: [Int]
enteros6 = 0 : ([1..] <**> [id, negate])

-- La propiedad es
prop_enteros :: Int -> Property
prop_enteros n = 
    n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros
--    +++ OK, passed 100 tests.

import Test.QuickCheck

import Control.Applicative ((<**>))

-- 1ª definición

enteros :: [Int]

enteros = 0 : concat [[n,-n] | n <- [1..]]

-- 2ª definición

enteros2 :: [Int]

enteros2 = 0 : [y | x <- [1..], y <- [x, -x]]

-- 3ª definición

enteros3 :: [Int]

enteros3 = iterate siguiente 0

where siguiente i | i > 0 = -i

| otherwise = 1 - i

-- 4ª definición

enteros4 :: [Int]

enteros4 = iterate (\i -> if i > 0 then -i else 1-i) 0

-- 5ª definición

enteros5 :: [Int]

enteros5 = 0 : [f x | x <- [1..], f <- [id, negate]]

-- 6ª definición

enteros6 :: [Int]

enteros6 = 0 : ([1..] <**> [id, negate])

-- La propiedad es

prop_enteros :: Int -> Property

prop_enteros n =

n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros

-- +++ OK, passed 100 tests.

Números apocalípticos

PorJosé A. Alonso 8-enero-201819-febrero-2018

Un número apocalíptico es aquel número natural n tal que 2^n contiene la secuencia 666.

Definir las funciones

   esApocaliptico           :: Integer -> Bool
   apocalipticos            :: [Integer]
   mayorNoApocalipticoMenor :: Integer -> Maybe Integer
   grafica                  :: Integer -> IO ()

esApocaliptico :: Integer -> Bool

apocalipticos :: [Integer]

mayorNoApocalipticoMenor :: Integer -> Maybe Integer

grafica :: Integer -> IO ()

tales que

(esApocaliptico n) se verifica si n es un número apocalíptico. Por ejemplo,

     esApocaliptico 666    ==  True
     esApocaliptico 29784  ==  False

1 2	esApocaliptico 666 == True esApocaliptico 29784 == False

apocalipticos es la lista de los números apocalípticos. Por ejemplo,

     take 9 apocalipticos  ==  [157,192,218,220,222,224,226,243,245]
     apocalipticos !! 55   ==  666

1 2	take 9 apocalipticos == [157,192,218,220,222,224,226,243,245] apocalipticos !! 55 == 666

(mayorNoApocalipticoMenor n) es justo el mayor número no apocalíptico menor que n. Por ejemplo,

     mayorNoApocalipticoMenor  40000  ==  Just 29784
     mayorNoApocalipticoMenor  29784  ==  Just 26667

1 2	mayorNoApocalipticoMenor 40000 == Just 29784 mayorNoApocalipticoMenor 29784 == Just 26667

(grafica n) dibuja las gráficas de los n primeros términos de la sucesión de los números apocalípticos junto con los de la sucesión a(n) = 3715+n. Por ejemplo, (grafica 3000) dibuja

y (grafica 30000) dibuja

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

Soluciones

import Data.List (isInfixOf, find, genericTake)
import Graphics.Gnuplot.Simple

esApocaliptico :: Integer -> Bool
esApocaliptico = isInfixOf "666" . show . (2^)

apocalipticos :: [Integer]
apocalipticos = filter esApocaliptico [1..]

mayorNoApocalipticoMenor :: Integer -> Maybe Integer
mayorNoApocalipticoMenor n = find (not . esApocaliptico) [n-1,n-2..1]

grafica :: Integer -> IO ()
grafica n = 
  plotLists [ Key Nothing
            , PNG ("Numeros_apocalipticos_" ++ show n ++ ".png")
            ]
            [ genericTake n apocalipticos
            , [3715..3715+n-1] ]

import Data.List (isInfixOf, find, genericTake)

import Graphics.Gnuplot.Simple

esApocaliptico :: Integer -> Bool

esApocaliptico = isInfixOf "666" . show . (2^)

apocalipticos :: [Integer]

apocalipticos = filter esApocaliptico [1..]

mayorNoApocalipticoMenor :: Integer -> Maybe Integer

mayorNoApocalipticoMenor n = find (not . esApocaliptico) [n-1,n-2..1]

grafica :: Integer -> IO ()

grafica n =

plotLists [ Key Nothing

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

]

[ genericTake n apocalipticos

, [3715..3715+n-1] ]

Padres como sumas de hijos

PorJosé A. Alonso 5-enero-201819-febrero-2018

Los árboles binarios con valores en las hojas y en los nodos se definen por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a) 
     deriving (Eq, Show)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

         10
        /  \
       /    \
      8      2
     / \    / \
    3   5  2   0

/ \

8 2

/ \ / \

3 5 2 0

se pueden representar por

   ejArbol :: Arbol Int
   ejArbol = N 10 (N 8 (H 3) (H 5))
                  (N 2 (H 2) (H 0))

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 5))

(N 2 (H 2) (H 0))

Un árbol cumple la propiedad de la suma si el valor de cada nodo es igual a la suma de los valores de sus hijos. Por ejemplo, el árbol anterior cumple la propiedad de la suma.

Definir la función

   propSuma :: Arbol Int -> Bool

1	propSuma :: Arbol Int -> Bool

tal que (propSuma a) se verifica si el árbol a cumple la propiedad de la suma. Por ejemplo,

   λ> propSuma (N 10 (N 8 (H 3) (H 5)) (N 2 (H 2) (H 0)))
   True
   λ> propSuma (N 10 (N 8 (H 4) (H 5)) (N 2 (H 2) (H 0)))
   False
   λ> propSuma (N 10 (N 8 (H 3) (H 5)) (N 2 (H 2) (H 1)))
   False

λ> propSuma (N 10 (N 8 (H 3) (H 5)) (N 2 (H 2) (H 0)))

True

λ> propSuma (N 10 (N 8 (H 4) (H 5)) (N 2 (H 2) (H 0)))

False

λ> propSuma (N 10 (N 8 (H 3) (H 5)) (N 2 (H 2) (H 1)))

False

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a)
  deriving Show

ejArbol :: Arbol Int
ejArbol = N 10 (N 8 (H 3) (H 5))
               (N 2 (H 2) (H 0))

propSuma :: Arbol Int -> Bool
propSuma (H _)     = True
propSuma (N x i d) = x == raiz i + raiz d && propSuma i && propSuma d
             
raiz :: Arbol Int -> Int
raiz (H x)     = x
raiz (N x _ _) = x

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving Show

ejArbol :: Arbol Int

ejArbol = N 10 (N 8 (H 3) (H 5))

(N 2 (H 2) (H 0))

propSuma :: Arbol Int -> Bool

propSuma (H _) = True

propSuma (N x i d) = x == raiz i + raiz d && propSuma i && propSuma d

raiz :: Arbol Int -> Int

raiz (H x) = x

raiz (N x _ _) = x

Problema del cambio de monedas

PorJosé A. Alonso 4-enero-201819-febrero-2018

El problema del cambio de monedas consiste en dada una lista ms de tipos de monedas (con infinitas monedas de cada tipo) y una cantidad objetivo x, calcular el número de formas de obtener y usando los tipos de monedas de ms. Por ejemplo, con monedas de 1, 5 y 10 céntimos se puede obtener 12 céntimos de 4 formas

   1,1,1,1,1,1,1,1,1,1,1,1
   1,1,1,1,1,1,1,5
   1,1,5,5
   1,1,10

1,1,1,1,1,1,1,1,1,1,1,1

1,1,1,1,1,1,1,5

1,1,5,5

1,1,10

Definir las funciones

   numeroCambios :: [Int] -> Int -> Int
   sucCambios :: [Int]
   grafica_cambios :: Int -> IO ()

numeroCambios :: [Int] -> Int -> Int

sucCambios :: [Int]

grafica_cambios :: Int -> IO ()

tales que

(numeroCambios ms x) es el número de formas de obtener x usando los tipos de monedas de ms. Por ejemplo,

     numeroCambios [1,5,10] 12  ==  4
     numeroCambios [4,1,3] 6    ==  4
     numeroCambios [1,5,10] 50  ==  36

numeroCambios [1,5,10] 12 == 4

numeroCambios [4,1,3] 6 == 4

numeroCambios [1,5,10] 50 == 36

sucCambios es la sucesión cuyo k-ésimo término es el número de cambios de k usando monedas de 1, 2, 5 y 10 céntimos. Por ejemplo,

   λ> take 20 sucCambios
   [1,1,2,2,3,4,5,6,7,8,11,12,15,16,19,22,25,28,31,34]

1 2	λ> take 20 sucCambios [1,1,2,2,3,4,5,6,7,8,11,12,15,16,19,22,25,28,31,34]

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

Soluciones

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

numeroCambios :: [Int] -> Int -> Int
numeroCambios ms = aux (sort ms) 
  where
    aux _      0 = 1
    aux []     _ = 0
    aux (m:ms) x | x < m     = 0
                 | otherwise = aux (m:ms) (x - m) + aux ms x

cambios :: [Int] -> Int -> [[Int]]
cambios xs y = aux (sort xs) y
  where
    aux _      0 = [[]]
    aux []     _ = []
    aux (k:ks) m | m < k     = []
                 | otherwise = [k:zs | zs <- aux (k:ks) (m - k)] ++
                               aux ks m
                               
sucCambios :: [Int]
sucCambios = [numeroCambios [1,2,5,10] k | k <- [0..]]

grafica_cambios :: Int -> IO ()
grafica_cambios n =
  plotList [ Title "Cambios con monedas de 1, 2, 5 y 10"
           , Key Nothing
           , XLabel "Objetivo"
           , YLabel "Numero de cambios"
           , PNG "Problema_del_cambio_de_monedas.png"
           ]
           (take n sucCambios)

import Data.List (sort)

import Graphics.Gnuplot.Simple

numeroCambios :: [Int] -> Int -> Int

numeroCambios ms = aux (sort ms)

where

aux _ 0 = 1

aux [] _ = 0

aux (m:ms) x | x < m = 0

| otherwise = aux (m:ms) (x - m) + aux ms x

cambios :: [Int] -> Int -> [[Int]]

cambios xs y = aux (sort xs) y

where

aux _ 0 = [[]]

aux [] _ = []

aux (k:ks) m | m < k = []

| otherwise = [k:zs | zs <- aux (k:ks) (m - k)] ++

aux ks m

sucCambios :: [Int]

sucCambios = [numeroCambios [1,2,5,10] k | k <- [0..]]

grafica_cambios :: Int -> IO ()

grafica_cambios n =

plotList [ Title "Cambios con monedas de 1, 2, 5 y 10"

, Key Nothing

, XLabel "Objetivo"

, YLabel "Numero de cambios"

, PNG "Problema_del_cambio_de_monedas.png"

]

(take n sucCambios)

Ofertas 3 por 2

PorJosé A. Alonso 3-enero-201825-abril-2021

En una tienda tienen la «oferta 3 por 2» de forma que cada cliente que elige 3 artículos obtiene el más barato de forma gratuita. Por ejemplo, si los precios de los artículos elegidos por un cliente son 10, 2, 4, 5 euros pagará 19 euros si agrupa los artículos en (10,2,4) y (5) o pagará 17 si lo agupa en (5,10,4) y (2).

Definir la función

   minimoConOferta :: [Int] -> Int

1	minimoConOferta :: [Int] -> Int

tal que (minimoConOferta xs) es lo mínimo que pagará el cliente si los precios de la compra son xs; es decir, lo que pagará agrupando los artículos de forma óptima para aplicar la oferta 3 por 2. Por ejemplo,

   minimoConOferta [10,2,4,5]     ==  17
   minimoConOferta [3,2,3,2]      ==  8
   minimoConOferta [6,4,5,5,5,5]  ==  21

minimoConOferta [10,2,4,5] == 17

minimoConOferta [3,2,3,2] == 8

minimoConOferta [6,4,5,5,5,5] == 21

Soluciones

import Data.List (sort)

minimoConOferta :: [Int] -> Int
minimoConOferta xs = aux (reverse (sort xs)) 0
  where aux (a:b:_:ds) n = aux ds (a+b+n)
        aux as         n = n + sum as

import Data.List (sort)

minimoConOferta :: [Int] -> Int

minimoConOferta xs = aux (reverse (sort xs)) 0

where aux (a:b:_:ds) n = aux ds (a+b+n)

aux as n = n + sum as

El problema 3SUM

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

El problem 3SUM consiste en dado una lista xs, decidir si xs posee tres elementos cuya suma sea cero. Por ejemplo, en [7,5,-9,5,2] se pueden elegir los elementos 7, -9 y 2 que suman 0.

Definir las funciones

   sols3Sum :: [Int] -> [[Int]]
   pb3Sum :: [Int] -> Bool

1 2	sols3Sum :: [Int] -> [[Int]] pb3Sum :: [Int] -> Bool

tales que
+ (sols3Sum xs) son las listas de tres elementos de xs cuya suma sea cero. Por ejemplo,

      sols3Sum [8,10,-10,-7,2,-3]   ==  [[-10,2,8],[-7,-3,10]]
      sols3Sum [-2..3]              ==  [[-2,-1,3],[-2,0,2],[-1,0,1]]
      sols3Sum [1,-2]               ==  []
      sols3Sum [-2,1]               ==  []
      sols3Sum [1,-2,1]             ==  [[-2,1,1]]
      length (sols3Sum [-100..100]) ==  5000

sols3Sum [8,10,-10,-7,2,-3] == [[-10,2,8],[-7,-3,10]]

sols3Sum [-2..3] == [[-2,-1,3],[-2,0,2],[-1,0,1]]

sols3Sum [1,-2] == []

sols3Sum [-2,1] == []

sols3Sum [1,-2,1] == [[-2,1,1]]

length (sols3Sum [-100..100]) == 5000

(pb3Sum xs) se verifica si xs posee tres elementos cuya suma sea cero. Por ejemplo,

     pb3Sum [8,10,-10,-7,2,-3]  ==  True
     pb3Sum [1,-2]              ==  False
     pb3Sum [-2,1]              ==  False
     pb3Sum [1,-2,1]            ==  True
     pb3Sum [1..400]            ==  False

pb3Sum [8,10,-10,-7,2,-3] == True

pb3Sum [1,-2] == False

pb3Sum [-2,1] == False

pb3Sum [1,-2,1] == True

pb3Sum [1..400] == False

Soluciones

import Data.List

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

sols3Sum1 :: [Int] -> [[Int]]
sols3Sum1 = normaliza . sols3Sum1Aux 

sols3Sum1Aux :: [Int] -> [[Int]]
sols3Sum1Aux xs =
  [ys | ys <- subsequences xs
      , length ys == 3
      , sum ys == 0]

normaliza :: [[Int]] -> [[Int]]
normaliza = sort . nub . map sort

pb3Sum1 :: [Int] -> Bool
pb3Sum1 = not . null . sols3Sum1Aux


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

sols3Sum2 :: [Int] -> [[Int]]
sols3Sum2 = normaliza . sols3Sum2Aux 

sols3Sum2Aux :: [Int] -> [[Int]]
sols3Sum2Aux xs =
  [[a,b,c] | (a:bs) <- tails xs
           , (b:cs) <- tails bs
           , c <- cs
           , a + b + c == 0]
  
pb3Sum2 :: [Int] -> Bool
pb3Sum2 = not . null . sols3Sum2Aux

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

sols3Sum3 :: [Int] -> [[Int]]
sols3Sum3 = normaliza . sols3Sum3Aux 

sols3Sum3Aux :: [Int] -> [[Int]]
sols3Sum3Aux xs =
  [[a,b,-a-b] | (a:bs) <- tails xs
              , b <- bs
              , (-a-b) `elem` (delete a (delete b xs))]

pb3Sum3 :: [Int] -> Bool
pb3Sum3 = not . null . sols3Sum3Aux

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

--    λ> pb3Suma [1..23]
--    False
--    (2.61 secs, 1,812,734,176 bytes)
--    λ> pb3Sumb [1..23]
--    False
--    (0.01 secs, 554,496 bytes)
--    λ> pb3Sumc [1..23]
--    False
--    (0.01 secs, 584,344 bytes)
--    λ> pb3Suma ([1..23] ++ [-3]) 
--    True
--    (2.54 secs, 1,812,735,784 bytes)
--    λ> pb3Sumb ([1..23] ++ [-3]) 
--    True
--    (0.01 secs, 148,904 bytes)
--    λ> pb3Sumc ([1..23] ++ [-3]) 
--    True
--    (0.00 secs, 145,320 bytes)
--
--    λ> pb3Sumb [1..300]
--    False
--    (1.66 secs, 933,699,824 bytes)
--    λ> pb3Sumc [1..300]
--    False
--    (0.41 secs, 873,168,120 bytes)

import Data.List

-- 1ª solución

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

sols3Sum1 :: [Int] -> [[Int]]

sols3Sum1 = normaliza . sols3Sum1Aux

sols3Sum1Aux :: [Int] -> [[Int]]

sols3Sum1Aux xs =

[ys | ys <- subsequences xs

, length ys == 3

, sum ys == 0]

normaliza :: [[Int]] -> [[Int]]

normaliza = sort . nub . map sort

pb3Sum1 :: [Int] -> Bool

pb3Sum1 = not . null . sols3Sum1Aux

-- 2ª solución

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

sols3Sum2 :: [Int] -> [[Int]]

sols3Sum2 = normaliza . sols3Sum2Aux

sols3Sum2Aux :: [Int] -> [[Int]]

sols3Sum2Aux xs =

[[a,b,c] | (a:bs) <- tails xs

, (b:cs) <- tails bs

, c <- cs

, a + b + c == 0]

pb3Sum2 :: [Int] -> Bool

pb3Sum2 = not . null . sols3Sum2Aux

-- 3ª solución

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

sols3Sum3 :: [Int] -> [[Int]]

sols3Sum3 = normaliza . sols3Sum3Aux

sols3Sum3Aux :: [Int] -> [[Int]]

sols3Sum3Aux xs =

[[a,b,-a-b] | (a:bs) <- tails xs

, b <- bs

, (-a-b) `elem` (delete a (delete b xs))]

pb3Sum3 :: [Int] -> Bool

pb3Sum3 = not . null . sols3Sum3Aux

-- Comparación de eficiencia

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

-- λ> pb3Suma [1..23]

-- False

-- (2.61 secs, 1,812,734,176 bytes)

-- λ> pb3Sumb [1..23]

-- False

-- (0.01 secs, 554,496 bytes)

-- λ> pb3Sumc [1..23]

-- False

-- (0.01 secs, 584,344 bytes)

-- λ> pb3Suma ([1..23] ++ [-3])

-- True

-- (2.54 secs, 1,812,735,784 bytes)

-- λ> pb3Sumb ([1..23] ++ [-3])

-- True

-- (0.01 secs, 148,904 bytes)

-- λ> pb3Sumc ([1..23] ++ [-3])

-- True

-- (0.00 secs, 145,320 bytes)

-- λ> pb3Sumb [1..300]

-- False

-- (1.66 secs, 933,699,824 bytes)

-- λ> pb3Sumc [1..300]

-- False

-- (0.41 secs, 873,168,120 bytes)

De hexadecimal a decimal

PorJosé A. Alonso 1-enero-201819-febrero-2018

El sistema hexadecimal es el sistema de numeración posicional que tiene como base el 16.

En principio, dado que el sistema usual de numeración es de base decimal y, por ello, sólo se dispone de diez dígitos, se adoptó la convención de usar las seis primeras letras del alfabeto latino para suplir los dígitos que nos faltan. El conjunto de símbolos es el siguiente: {0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F}. En ocasiones se emplean letras minúsculas en lugar de mayúsculas. Se debe notar que A = 10, B = 11, C = 12, D = 13, E = 14 y F = 15.

Como en cualquier sistema de numeración posicional, el valor numérico de cada dígito es alterado dependiendo de su posición en la cadena de dígitos, quedando multiplicado por una cierta potencia de la base del sistema, que en este caso es 16. Por ejemplo, el valor decimal del número hexadecimal 3E0A es

     3×16^3 + E×16^2 + 0×16^1 + A×16^0
   = 3×4096 + 14×256 + 0×16   + 10×1
   = 15882

3×16^3 + E×16^2 + 0×16^1 + A×16^0

= 3×4096 + 14×256 + 0×16 + 10×1

= 15882

Definir la función

   hexAdec :: String -> Int

1	hexAdec :: String -> Int

tal que (hexAdec cs) es el valor decimal del número hexadecimal representado meiante la cadena cs. Por ejemplo,

   hexAdec "3E0A"   == 15882
   hexAdec "ABCDEF" == 11259375
   hexAdec "FEDCBA" == 16702650

hexAdec "3E0A" == 15882

hexAdec "ABCDEF" == 11259375

hexAdec "FEDCBA" == 16702650

Soluciones

import Data.Char (digitToInt)
import Numeric(readHex)
import Data.List (foldl')

-- 1ª solución
hexAdec1 :: String -> Int
hexAdec1 s =
  sum (zipWith (*) (map digitToInt (reverse s)) (iterate (*16) 1))

-- 2ª solución
hexAdec2 :: String -> Int
hexAdec2 = foldl' (\acc x -> acc * 16 + digitToInt x) 0

-- 3ª solución
hexAdec3 :: String -> Int
hexAdec3 = read . ("0x" ++)

-- 4ª solución
hexAdec4 :: String -> Int
hexAdec4 = fst . head . readHex

import Data.Char (digitToInt)

import Numeric(readHex)

import Data.List (foldl')

-- 1ª solución

hexAdec1 :: String -> Int

hexAdec1 s =

sum (zipWith (*) (map digitToInt (reverse s)) (iterate (*16) 1))

-- 2ª solución

hexAdec2 :: String -> Int

hexAdec2 = foldl' (\acc x -> acc * 16 + digitToInt x) 0

-- 3ª solución

hexAdec3 :: String -> Int

hexAdec3 = read . ("0x" ++)

-- 4ª solución

hexAdec4 :: String -> Int

hexAdec4 = fst . head . readHex

Ordenación según una cadena

PorJosé A. Alonso 29-diciembre-201726-marzo-2022

Dada una lista xs y una cadena cs de la misma longitud, la ordenación de xs según cs consiste en emparejar los elementos de cs con los de xs (de forma que al menor elemento de cs le corresponde el menor de xs, al segundo de cs el segundo de xs, etc.) y ordenar los elementos de xs en el mismo orden que sus correspondientes elementos de cs. Por ejemplo, si xs es [6,4,2] y cs es «CAB» entonces a ‘A’ le corresponde el 2, a ‘B’ el 4 y a ‘C’ el 6; luego la ordenación es [6,2,4].

Definir la función

   ordenacion :: Ord a => [a] -> String -> [a]

1	ordenacion :: Ord a => [a] -> String -> [a]

tal que (ordenacion xs ys) es la ordenación de la lista xs según la cadena cs. Por ejemplo,

   ordenacion [6,4,2] "CAB"     ==  [6,2,4]
   ordenacion [1,5,3] "ABC"     ==  [1,3,5]
   ordenacion [1,5,3,7] "ABEC"  ==  [1,3,7,5]

ordenacion [6,4,2] "CAB" == [6,2,4]

ordenacion [1,5,3] "ABC" == [1,3,5]

ordenacion [1,5,3,7] "ABEC" == [1,3,7,5]

Soluciones

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

ordenacion :: Ord a => [a] -> String -> [a]
ordenacion xs cs =
  [fromJust (lookup y diccionario) | y <- cs]
  where diccionario = zip (sort cs) (sort xs)

import Data.List (sort)

import Data.Maybe (fromJust)

ordenacion :: Ord a => [a] -> String -> [a]

ordenacion xs cs =

[fromJust (lookup y diccionario) | y <- cs]

where diccionario = zip (sort cs) (sort xs)

Factorial módulo

PorJosé A. Alonso 28-diciembre-201719-febrero-2018

Definir la función

   factorialMod :: Integer -> Integer -> Integer

1	factorialMod :: Integer -> Integer -> Integer

tal que (factorialMod n x) es el factorial de x módulo n. Por ejemplo,

   factorialMod (7+10^9) 100       ==  437918130
   factorialMod (7+10^9) (5*10^6)  ==  974067448

1 2	factorialMod (7+10^9) 100 == 437918130 factorialMod (7+10^9) (5*10^6) == 974067448

Soluciones

import Data.List (foldl')

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

factorialMod :: Integer -> Integer -> Integer
factorialMod n x =
  factorial x `mod` n

-- (factorial x) es el factorial de x. Por ejemplo,
--    factorial 3  ==  6
factorial :: Integer -> Integer
factorial x = product [1..x]

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

factorialMod2 :: Integer -> Integer -> Integer
factorialMod2 n x =
  foldl' (prodMod n) 1 [1..x]

-- (prodMod n x y) es el producto de x e y módulo n. Por ejemplo,
--    prodMod 3 4 7  ==  1
--    prodMod 5 4 7  ==  -- 3
prodMod :: Integer -> Integer -> Integer -> Integer
prodMod n x y =
  ((x `mod` n) * (y `mod` n)) `mod` n
  
-- Comparación de eficiencia
-- =========================

--    λ> factorialMod (7+10^9) (5*10^4)
--    737935835
--    (2.62 secs, 2,601,358,640 bytes)
--    λ> factorialMod2 (7+10^9) (5*10^4)
--    737935835
--    (0.07 secs, 23,471,880 bytes)

import Data.List (foldl')

-- 1ª definición

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

factorialMod :: Integer -> Integer -> Integer

factorialMod n x =

factorial x `mod` n

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

-- factorial 3 == 6

factorial :: Integer -> Integer

factorial x = product [1..x]

-- 2ª definición

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

factorialMod2 :: Integer -> Integer -> Integer

factorialMod2 n x =

foldl' (prodMod n) 1 [1..x]

-- (prodMod n x y) es el producto de x e y módulo n. Por ejemplo,

-- prodMod 3 4 7 == 1

-- prodMod 5 4 7 == -- 3

prodMod :: Integer -> Integer -> Integer -> Integer

prodMod n x y =

((x `mod` n) * (y `mod` n)) `mod` n

-- Comparación de eficiencia

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

-- λ> factorialMod (7+10^9) (5*10^4)

-- 737935835

-- (2.62 secs, 2,601,358,640 bytes)

-- λ> factorialMod2 (7+10^9) (5*10^4)

-- 737935835

-- (0.07 secs, 23,471,880 bytes)

Recorrido por niveles de árboles binarios

PorJosé A. Alonso 27-diciembre-201719-febrero-2018

Los árboles binarios con valores en las hojas y en los nodos se definen por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a) 
     deriving (Eq, Show)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

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

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

se pueden representar por

   ejArbol :: Arbol Int
   ejArbol = N 1 (N 2 (H 4)
                      (N 5 (H 8) (H 9)))
                 (N 3 (H 6) (H 7))

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

Definir la función

   recorrido :: Arbol t -> [t]

1	recorrido :: Arbol t -> [t]

tal que (recorrido a) es el recorrido del árbol a por niveles desde la raíz a las hojas y de izquierda a derecha. Por ejemplo,

   λ> recorrido (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
   [1,2,3,4,5,6,7,8,9]
   λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (N 5 (H 8) (H 9))))
   [1,3,2,6,7,4,5,8,9]
   λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (H 5)))
   [1,3,2,6,7,4,5]
   λ> recorrido (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7)))
   [1,2,3,4,5,6,7]
   λ> recorrido (N 1 (N 2 (H 4) (H 5)) (H 3))
   [1,2,3,4,5]
   λ> recorrido (N 1 (H 4) (H 3))
   [1,4,3]
   λ> recorrido (H 3)
   [3]

λ> recorrido (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

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

λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (N 5 (H 8) (H 9))))

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

λ> recorrido (N 1 (N 3 (H 6) (H 7)) (N 2 (H 4) (H 5)))

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

λ> recorrido (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7)))

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

λ> recorrido (N 1 (N 2 (H 4) (H 5)) (H 3))

[1,2,3,4,5]

λ> recorrido (N 1 (H 4) (H 3))

[1,4,3]

λ> recorrido (H 3)

[3]

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a) 
  deriving (Eq, Show)

ejArbol :: Arbol Int
ejArbol = N 1 (N 2 (H 4)
                   (N 5 (H 8) (H 9)))
              (N 3 (H 6) (H 7))

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

recorrido :: Arbol t -> [t]
recorrido = concat . niveles

-- (niveles a) es la lista de los niveles del árbol a. Por ejemplo,
--    λ> niveles (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    [[1],[2,3],[4,5,6,7],[8,9]]
niveles :: Arbol t -> [[t]]
niveles (H x)     = [[x]]
niveles (N x i d) = [x] : mezcla (niveles i) (niveles d)

-- (mezcla xss yss) es la lista obtenida concatenando los
-- correspondientes elementos de xss e yss. Por ejemplo,
--    λ> mezcla [[1,3],[2,5,7]] [[4],[1,9],[0,14]]
--    [[1,3,4],[2,5,7,1,9],[0,14]]
--    λ> mezcla [[1,3],[2,5,7]] [[4]]
--    [[1,3,4],[2,5,7]]
mezcla :: [[a]] -> [[a]] -> [[a]]
mezcla [] yss            = yss
mezcla xss []            = xss
mezcla (xs:xss) (ys:yss) = (xs ++ ys) : mezcla xss yss

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

recorrido2 :: Arbol t -> [t]
recorrido2 = concat . niveles2

-- (niveles2 a) es la lista de los niveles del árbol a. Por ejemplo,
--    λ> niveles2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    [[1],[2,3],[4,5,6,7],[8,9]]
niveles2 :: Arbol t -> [[t]]
niveles2 a = takeWhile (not . null) [nivel n a | n <- [0..]]

-- (nivel n a) es el nivel iésimo del árbol a. Por ejemplo,
--    λ> nivel 2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    [4,5,6,7]
--    λ> nivel 5 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))
--    []
nivel :: Int -> Arbol t -> [t]
nivel 0 (H x)      = [x]
nivel n (H _)      = []
nivel 0 (N x _ _)  = [x]
nivel n (N x i d)  = nivel (n-1) i ++ nivel (n-1) d

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

-- 1ª definición

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

recorrido :: Arbol t -> [t]

recorrido = concat . niveles

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

-- λ> niveles (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

-- [[1],[2,3],[4,5,6,7],[8,9]]

niveles :: Arbol t -> [[t]]

niveles (H x) = [[x]]

niveles (N x i d) = [x] : mezcla (niveles i) (niveles d)

-- (mezcla xss yss) es la lista obtenida concatenando los

-- correspondientes elementos de xss e yss. Por ejemplo,

-- λ> mezcla [[1,3],[2,5,7]] [[4],[1,9],[0,14]]

-- [[1,3,4],[2,5,7,1,9],[0,14]]

-- λ> mezcla [[1,3],[2,5,7]] [[4]]

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

mezcla :: [[a]] -> [[a]] -> [[a]]

mezcla [] yss = yss

mezcla xss [] = xss

mezcla (xs:xss) (ys:yss) = (xs ++ ys) : mezcla xss yss

-- 2ª definición

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

recorrido2 :: Arbol t -> [t]

recorrido2 = concat . niveles2

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

-- λ> niveles2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

-- [[1],[2,3],[4,5,6,7],[8,9]]

niveles2 :: Arbol t -> [[t]]

niveles2 a = takeWhile (not . null) [nivel n a | n <- [0..]]

-- (nivel n a) es el nivel iésimo del árbol a. Por ejemplo,

-- λ> nivel 2 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

-- [4,5,6,7]

-- λ> nivel 5 (N 1 (N 2 (H 4) (N 5 (H 8) (H 9))) (N 3 (H 6) (H 7)))

-- []

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

nivel 0 (H x) = [x]

nivel n (H _) = []

nivel 0 (N x _ _) = [x]

nivel n (N x i d) = nivel (n-1) i ++ nivel (n-1) d

Sucesión de raíces enteras de los números primos

PorJosé A. Alonso 26-diciembre-201719-febrero-2018

Definir las siguientes funciones

   raicesEnterasPrimos :: [Integer]
   posiciones :: Integer -> (Int,Int)
   frecuencia :: Integer -> Int
   grafica_raicesEnterasPrimos :: Int -> IO ()
   grafica_posicionesIniciales :: Integer -> IO ()
   grafica_frecuencias :: Integer -> IO ()

raicesEnterasPrimos :: [Integer]

posiciones :: Integer -> (Int,Int)

frecuencia :: Integer -> Int

grafica_raicesEnterasPrimos :: Int -> IO ()

grafica_posicionesIniciales :: Integer -> IO ()

grafica_frecuencias :: Integer -> IO ()

tales que

raicesEnterasPrimos es la sucesión de las raíces enteras (por defecto) de los números primos. Por ejemplo,

     λ> take 20 raicesEnterasPrimos
     [1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8]
     λ> raicesEnterasPrimos !! 2500000
     6415

λ> take 20 raicesEnterasPrimos

[1,1,2,2,3,3,4,4,4,5,5,6,6,6,6,7,7,7,8,8]

λ> raicesEnterasPrimos !! 2500000

6415

(posiciones x) es el par formado por la menor y la mayor posición de x en la sucesión de las raíces enteras de los números primos. Por ejemplo,

      posiciones 2     ==  (2,3)
      posiciones 4     ==  (6,8)
      posiciones 2017  ==  (287671,287931)
      posiciones 2018  ==  (287932,288208)

posiciones 2 == (2,3)

posiciones 4 == (6,8)

posiciones 2017 == (287671,287931)

posiciones 2018 == (287932,288208)

(frecuencia x) es el número de veces que aparece x en la sucesión de las raíces enteras de los números primos. Por ejemplo,

      frecuencia 2     ==  2
      frecuencia 4     ==  3
      frecuencia 2017  ==  261
      frecuencia 2018  ==  277

frecuencia 2 == 2

frecuencia 4 == 3

frecuencia 2017 == 261

frecuencia 2018 == 277

(grafica_raicesEnterasPrimos n) dibuja la gráfica de los n primeros términos de la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_raicesEnterasPrimos 200) dibuja
(grafica_posicionesIniciales n) dibuja la gráfica de las menores posiciones de los n primeros números en la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_posicionesIniciales 200) dibuja
(grafica_frecuencia n) dibuja la gráfica de las frecuencia de los n primeros números en la sucesión de las raíces enteras de los números primos. Por ejemplo, (grafica_frecuencia 200) dibuja

Soluciones

import Data.Numbers.Primes (primes)
import Graphics.Gnuplot.Simple

raicesEnterasPrimos :: [Integer]
raicesEnterasPrimos = map raizEntera primes                       

raizEntera :: Integer -> Integer
raizEntera = floor . sqrt . fromIntegral

posiciones :: Integer -> (Int,Int)
posiciones x = (n,n+m-1)
  where (as,bs) = span (<x) raicesEnterasPrimos
        cs      = takeWhile (==x) bs 
        n       = length as
        m       = length cs

frecuencia :: Integer -> Int
frecuencia x =
  ( length
  . takeWhile (==x)
  . dropWhile (<x)
  ) raicesEnterasPrimos

grafica_raicesEnterasPrimos :: Int -> IO ()
grafica_raicesEnterasPrimos n = 
  plotList [ Title "Raices enteras de primos"
           , XLabel "Posiciones de numeros primos"
           , YLabel "Raiz entera del n-esimo primo"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_1.png"
           ]
           (take n raicesEnterasPrimos)

grafica_posicionesIniciales :: Integer -> IO ()
grafica_posicionesIniciales n = 
  plotList [ Title "Posiciones iniciales en raices enteras de primos"
           , XLabel "Numeros enteros"
           , YLabel "Posicion del numero n en las raices enteras de primos"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_2.png"
           ]
           (map (fst . posiciones) [1..n])

grafica_frecuencias :: Integer -> IO ()
grafica_frecuencias n = 
  plotList [ Title "Frecuencias en raices enteras de primos"
           , XLabel "Numeros enteros n"
           , YLabel "Frecuencia del numero n en las raices enteras de primos"
           , Key Nothing
           , PNG "Sucesion_de_raices_enteras_de_primos_3.png"
           ]
           (map frecuencia [1..n])

import Data.Numbers.Primes (primes)

import Graphics.Gnuplot.Simple

raicesEnterasPrimos :: [Integer]

raicesEnterasPrimos = map raizEntera primes

raizEntera :: Integer -> Integer

raizEntera = floor . sqrt . fromIntegral

posiciones :: Integer -> (Int,Int)

posiciones x = (n,n+m-1)

where (as,bs) = span (<x) raicesEnterasPrimos

cs = takeWhile (==x) bs

n = length as

m = length cs

frecuencia :: Integer -> Int

frecuencia x =

( length

. takeWhile (==x)

. dropWhile (<x)

) raicesEnterasPrimos

grafica_raicesEnterasPrimos :: Int -> IO ()

grafica_raicesEnterasPrimos n =

plotList [ Title "Raices enteras de primos"

, XLabel "Posiciones de numeros primos"

, YLabel "Raiz entera del n-esimo primo"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_1.png"

]

(take n raicesEnterasPrimos)

grafica_posicionesIniciales :: Integer -> IO ()

grafica_posicionesIniciales n =

plotList [ Title "Posiciones iniciales en raices enteras de primos"

, XLabel "Numeros enteros"

, YLabel "Posicion del numero n en las raices enteras de primos"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_2.png"

]

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

grafica_frecuencias :: Integer -> IO ()

grafica_frecuencias n =

plotList [ Title "Frecuencias en raices enteras de primos"

, XLabel "Numeros enteros n"

, YLabel "Frecuencia del numero n en las raices enteras de primos"

, Key Nothing

, PNG "Sucesion_de_raices_enteras_de_primos_3.png"

]

(map frecuencia [1..n])

Posiciones de las mayúsculas

PorJosé A. Alonso 25-diciembre-201719-febrero-2018

Definir la función

   posicionesMayusculas :: String -> [Int]

1	posicionesMayusculas :: String -> [Int]

tal que (posicionesMayusculas cs) es la lista de las posiciones de las mayúsculas de la cadena cs. Por ejemplo,

   posicionesMayusculas "SeViLLa"  == [0,2,4,5]
   posicionesMayusculas "aAbB"     == [1,3]
   posicionesMayusculas "ABCDEF"   == [0,1,2,3,4,5]
   posicionesMayusculas "4ysdf4"   == []
   posicionesMayusculas ""         == []

posicionesMayusculas "SeViLLa" == [0,2,4,5]

posicionesMayusculas "aAbB" == [1,3]

posicionesMayusculas "ABCDEF" == [0,1,2,3,4,5]

posicionesMayusculas "4ysdf4" == []

posicionesMayusculas "" == []

Soluciones

import Data.Char (isUpper)
import Data.List (findIndices)

-- 1ª solución
posicionesMayusculas :: String -> [Int]
posicionesMayusculas xs = [n | (n,x) <- zip [0..] xs, isUpper x] 

-- 2ª solución
posicionesMayusculas2 :: String -> [Int]
posicionesMayusculas2 = aux 0 []
  where aux n ns [] = reverse ns
        aux n ns (y:ys) | isUpper y = aux (n+1) (n:ns) ys
                        | otherwise = aux (n+1)    ns  ys

-- 3ª solución
posicionesMayusculas3 :: String -> [Int]
posicionesMayusculas3 = findIndices isUpper

import Data.Char (isUpper)

import Data.List (findIndices)

-- 1ª solución

posicionesMayusculas :: String -> [Int]

posicionesMayusculas xs = [n | (n,x) <- zip [0..] xs, isUpper x]

-- 2ª solución

posicionesMayusculas2 :: String -> [Int]

posicionesMayusculas2 = aux 0 []

where aux n ns [] = reverse ns

aux n ns (y:ys) | isUpper y = aux (n+1) (n:ns) ys

| otherwise = aux (n+1) ns ys

-- 3ª solución

posicionesMayusculas3 :: String -> [Int]

posicionesMayusculas3 = findIndices isUpper

Rotaciones divisibles por 8

PorJosé A. Alonso 22-diciembre-201719-febrero-2018

Las rotaciones de 928160 son 928160, 281609, 816092, 160928, 609281 y 92816 de las que 3 son divisibles por 8 (928160, 160928 y 92816).

Definir la función

   nRotacionesDivisiblesPor8 :: Integer -> Int

1	nRotacionesDivisiblesPor8 :: Integer -> Int

tal que (nRotacionesDivisiblesPor8 x) es el número de rotaciones de x divisibles por 8. Por ejemplo,

   nRotacionesDivisiblesPor8 928160       ==  3
   nRotacionesDivisiblesPor8 43262488612  ==  4
   nRotacionesDivisiblesPor8 (read (take (10^4) (cycle "248")))  ==  6666

nRotacionesDivisiblesPor8 928160 == 3

nRotacionesDivisiblesPor8 43262488612 == 4

nRotacionesDivisiblesPor8 (read (take (10^4) (cycle "248"))) == 6666

Soluciones

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

nRotacionesDivisiblesPor8 :: Integer -> Int
nRotacionesDivisiblesPor8 x =
  length [y | y <- rotaciones x
            , y `mod` 8 == 0]

--    rotaciones 1234  ==  [1234,2341,3412,4123]
rotaciones :: Integer -> [Integer]
rotaciones x = [read ys | ys <- rotacionesLista xs]
  where xs = show x

--    rotacionesLista "abcd"  ==  ["abcd","bcda","cdab","dabc"]
rotacionesLista :: [a] -> [[a]]
rotacionesLista xs =
  [zs ++ ys | k <- [0 .. length xs - 1]
            , let (ys,zs) = splitAt k xs] 

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

nRotacionesDivisiblesPor8b :: Integer -> Int
nRotacionesDivisiblesPor8b x =
  length [y | y <- tresDigitosConsecutivos x
            , y `mod` 8 == 0]

--    tresDigitosConsecutivos 1234  ==  [123,234,341,412]
tresDigitosConsecutivos :: Integer -> [Integer]
tresDigitosConsecutivos x =
  [read (take 3 ys) | ys <- rotacionesLista (show x)]

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

--    λ> nRotacionesDivisiblesPor8 (read (take (3*10^3) (cycle "248")))
--    2000
--    (3.59 secs, 4,449,162,144 bytes)
--    λ> nRotacionesDivisiblesPor8b (read (take (3*10^3) (cycle "248")))
--    2000
--    (0.48 secs, 593,670,656 bytes)

-- 1ª definición

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

nRotacionesDivisiblesPor8 :: Integer -> Int

nRotacionesDivisiblesPor8 x =

length [y | y <- rotaciones x

, y `mod` 8 == 0]

-- rotaciones 1234 == [1234,2341,3412,4123]

rotaciones :: Integer -> [Integer]

rotaciones x = [read ys | ys <- rotacionesLista xs]

where xs = show x

-- rotacionesLista "abcd" == ["abcd","bcda","cdab","dabc"]

rotacionesLista :: [a] -> [[a]]

rotacionesLista xs =

[zs ++ ys | k <- [0 .. length xs - 1]

, let (ys,zs) = splitAt k xs]

-- 2ª definición

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

nRotacionesDivisiblesPor8b :: Integer -> Int

nRotacionesDivisiblesPor8b x =

length [y | y <- tresDigitosConsecutivos x

, y `mod` 8 == 0]

-- tresDigitosConsecutivos 1234 == [123,234,341,412]

tresDigitosConsecutivos :: Integer -> [Integer]

tresDigitosConsecutivos x =

[read (take 3 ys) | ys <- rotacionesLista (show x)]

-- Comparación de eficiencia

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

-- λ> nRotacionesDivisiblesPor8 (read (take (3*10^3) (cycle "248")))

-- 2000

-- (3.59 secs, 4,449,162,144 bytes)

-- λ> nRotacionesDivisiblesPor8b (read (take (3*10^3) (cycle "248")))

-- 2000

-- (0.48 secs, 593,670,656 bytes)

Sumable sin vecinos

PorJosé A. Alonso 21-diciembre-201719-febrero-2018

En la lista [3,2,5,7,4] el número 12 se puede escribir como una suma de elementos de la lista sin incluir sus vecinos (ya que es la suma de 3, 5 y 4); en cambio, 14 no lo es (porque es la suma de 3, 7 y 4, pero 7 y 4 son vecinos).

Definir la función

   esSumableSinVecinos :: [Int] -> Int -> Bool

1	esSumableSinVecinos :: [Int] -> Int -> Bool

tal que (esSumableSinVecinos xs n) se verifica si n se puede escribir como una suma de elementos de xs que no incluye a ninguno de sus vecinos. Por ejemplo,

   esSumableSinVecinos [3,2,5,7,4] 12  ==  True
   esSumableSinVecinos [3,2,5,7,4] 9   ==  True
   esSumableSinVecinos [3,2,5,7,4] 6   ==  True
   esSumableSinVecinos [3,2,5,7,4] 14  ==  False
   esSumableSinVecinos [3,2,5,7,4] 1   ==  False

esSumableSinVecinos [3,2,5,7,4] 12 == True

esSumableSinVecinos [3,2,5,7,4] 9 == True

esSumableSinVecinos [3,2,5,7,4] 6 == True

esSumableSinVecinos [3,2,5,7,4] 14 == False

esSumableSinVecinos [3,2,5,7,4] 1 == False

Soluciones

esSumableSinVecinos :: [Int] -> Int -> Bool
esSumableSinVecinos _  0       = True
esSumableSinVecinos []  _      = False
esSumableSinVecinos [x] n      = x == n
esSumableSinVecinos (x:y:zs) n = esSumableSinVecinos zs (n - x) ||
                                 esSumableSinVecinos (y:zs) n

esSumableSinVecinos :: [Int] -> Int -> Bool

esSumableSinVecinos _ 0 = True

esSumableSinVecinos [] _ = False

esSumableSinVecinos [x] n = x == n

esSumableSinVecinos (x:y:zs) n = esSumableSinVecinos zs (n - x) ||

esSumableSinVecinos (y:zs) n

Suma de las hojas de mínimo nivel

PorJosé A. Alonso 20-diciembre-201727-diciembre-2017

Los árboles binarios con valores en las hojas y en los nodos se definen por

   data Arbol a = H a
                | N a (Arbol a) (Arbol a) 
     deriving (Eq, Show)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

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

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

se pueden representar por

   ejArbol :: Arbol Int
   ejArbol = N 1 (N 2 (H 4)
                      (N 5 (H 8) (H 9)))
                 (N 3 (H 6) (H 7))

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

En el árbol anterior, los valores de las hojas de menor nivel son 4, 6 y 7 cuya suma es 17.

Definir la función

   suma :: Num t => Arbol t -> t

1	suma :: Num t => Arbol t -> t

tal que (suma a) es la suma de los valores de las hojas de menor nivel del árbol a. Por ejemplo,

   suma ejArbol                                    ==  17
   suma (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7)))  ==  22
   suma (N 1 (H 2) (N 3 (H 6) (H 7)))              ==  2
   suma (N 1 (H 2) (H 3))                          ==  5
   suma (H 2)                                      ==  2

suma ejArbol == 17

suma (N 1 (N 2 (H 4) (H 5)) (N 3 (H 6) (H 7))) == 22

suma (N 1 (H 2) (N 3 (H 6) (H 7))) == 2

suma (N 1 (H 2) (H 3)) == 5

suma (H 2) == 2

Soluciones

data Arbol a = H a
             | N a (Arbol a) (Arbol a) 
  deriving (Eq, Show)

ejArbol :: Arbol Int
ejArbol = N 1 (N 2 (H 4)
                   (N 5 (H 8) (H 9)))
              (N 3 (H 6) (H 7))
                      
suma :: Num t => Arbol t -> t
suma a = aux [a]
  where aux as | null xs   = aux (concat [[i,d] | (N _ i d) <- as])
               | otherwise = sum xs
          where xs = [x | (H x) <- as]

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

ejArbol :: Arbol Int

ejArbol = N 1 (N 2 (H 4)

(N 5 (H 8) (H 9)))

(N 3 (H 6) (H 7))

suma :: Num t => Arbol t -> t

suma a = aux [a]

where aux as | null xs = aux (concat [[i,d] | (N _ i d) <- as])

| otherwise = sum xs

where xs = [x | (H x) <- as]

Vecino en lista circular

PorJosé A. Alonso 19-diciembre-201726-marzo-2022

En la lista circular [3,2,5,7,9]

el vecino izquierdo de 5 es 2 y su vecino derecho es 7,
el vecino izquierdo de 9 es 7 y su vecino derecho es 3,
el vecino izquierdo de 3 es 9 y su vecino derecho es 2,
el elemento 4 no tiene vecinos (porque no está en la lista).

Para indicar las direcciones se define el tipo de datos

   data Direccion = I | D deriving Eq

1	data Direccion = I \| D deriving Eq

Definir la función

   vecino :: Eq a => Direccion -> [a] -> a -> Maybe a

1	vecino :: Eq a => Direccion -> [a] -> a -> Maybe a

tal que (vecino d xs x) es el vecino de x en la lista de elementos distintos xs según la dirección d. Por ejemplo,

   vecino I [3,2,5,7,9] 5  ==  Just 2
   vecino D [3,2,5,7,9] 5  ==  Just 7
   vecino I [3,2,5,7,9] 9  ==  Just 7
   vecino D [3,2,5,7,9] 9  ==  Just 3
   vecino I [3,2,5,7,9] 3  ==  Just 9
   vecino D [3,2,5,7,9] 3  ==  Just 2
   vecino I [3,2,5,7,9] 4  ==  Nothing
   vecino D [3,2,5,7,9] 4  ==  Nothing

vecino I [3,2,5,7,9] 5 == Just 2

vecino D [3,2,5,7,9] 5 == Just 7

vecino I [3,2,5,7,9] 9 == Just 7

vecino D [3,2,5,7,9] 9 == Just 3

vecino I [3,2,5,7,9] 3 == Just 9

vecino D [3,2,5,7,9] 3 == Just 2

vecino I [3,2,5,7,9] 4 == Nothing

vecino D [3,2,5,7,9] 4 == Nothing

Soluciones

data Direccion = I | D deriving Eq

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

vecino1 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino1 d xs x = busca x (vecinos d xs)

-- (vecinos d xs) es la lista de elementos de xs y sus vecinos según la
-- direccioń d. Por ejemplo,
--    vecinos I [1..5]  ==  [(2,1),(3,2),(4,3),(5,4),(1,5)]
--    vecinos D [1..5]  ==  [(1,2),(2,3),(3,4),(4,5),(5,1)]
vecinos :: Direccion -> [a] -> [(a,a)]
vecinos I xs = zip (tail (cycle xs)) xs
vecinos D xs = zip xs (tail (cycle xs))

-- (busca x ps) es el la segunda componente de primer par de ps cuya
-- primera componente es igual a x. Por ejemplo, 
--    busca 3 [(4,1),(3,2),(3,7)]  ==  Just 2
--    busca 7 [(4,1),(3,2),(3,7)]  ==  Nothing
busca :: Eq a => a -> [(a,b)] -> Maybe b
busca x ps
  | null zs   = Nothing
  | otherwise = Just (head zs)
  where zs = [z | (x',z) <- ps, x' == x]

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

vecino2 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino2 d xs x = lookup x (vecinos d xs)

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

vecino3 :: Eq a => Direccion -> [a] -> a -> Maybe a
vecino3 I xs x = lookup x (zip (tail (cycle xs)) xs) 
vecino3 D xs x = lookup x (zip xs (tail (cycle xs)))

data Direccion = I | D deriving Eq

-- 1ª solución

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

vecino1 :: Eq a => Direccion -> [a] -> a -> Maybe a

vecino1 d xs x = busca x (vecinos d xs)

-- (vecinos d xs) es la lista de elementos de xs y sus vecinos según la

-- direccioń d. Por ejemplo,

-- vecinos I [1..5] == [(2,1),(3,2),(4,3),(5,4),(1,5)]

-- vecinos D [1..5] == [(1,2),(2,3),(3,4),(4,5),(5,1)]

vecinos :: Direccion -> [a] -> [(a,a)]

vecinos I xs = zip (tail (cycle xs)) xs

vecinos D xs = zip xs (tail (cycle xs))

-- (busca x ps) es el la segunda componente de primer par de ps cuya

-- primera componente es igual a x. Por ejemplo,

-- busca 3 [(4,1),(3,2),(3,7)] == Just 2

-- busca 7 [(4,1),(3,2),(3,7)] == Nothing

busca :: Eq a => a -> [(a,b)] -> Maybe b

busca x ps

| null zs = Nothing

| otherwise = Just (head zs)

where zs = [z | (x',z) <- ps, x' == x]

-- 2ª solución

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

vecino2 :: Eq a => Direccion -> [a] -> a -> Maybe a

vecino2 d xs x = lookup x (vecinos d xs)

-- 3ª solución

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

vecino3 :: Eq a => Direccion -> [a] -> a -> Maybe a

vecino3 I xs x = lookup x (zip (tail (cycle xs)) xs)

vecino3 D xs x = lookup x (zip xs (tail (cycle xs)))

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

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