map – Página 4 – Exercitium

Intercambio de la primera y última columna de una matriz

PorJosé A. Alonso 17-diciembre-201824-diciembre-2018

Las matrices se pueden representar mediante listas de listas. Por ejemplo, la matriz

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

8 9 7 6

4 7 6 5

3 2 1 8

se puede representar por la lista

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

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

Definir la función

   intercambia :: [[a]] -> [[a]]

1	intercambia :: [[a]] -> [[a]]

tal que (intercambia xss) es la matriz obtenida intercambiando la primera y la última columna de xss. Por ejemplo,

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

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

Soluciones

intercambia :: [[a]] -> [[a]]
intercambia = map intercambiaL

-- (intercambiaL xs) es la lista obtenida intercambiando el primero y el
-- último elemento de xs. Por ejemplo,
--    intercambiaL [8,9,7,6]  ==  [6,9,7,8]
intercambiaL :: [a] -> [a]
intercambiaL xs =
  last xs : tail (init xs) ++ [head xs]

intercambia :: [[a]] -> [[a]]

intercambia = map intercambiaL

-- (intercambiaL xs) es la lista obtenida intercambiando el primero y el

-- último elemento de xs. Por ejemplo,

-- intercambiaL [8,9,7,6] == [6,9,7,8]

intercambiaL :: [a] -> [a]

intercambiaL xs =

last xs : tail (init xs) ++ [head xs]

Pensamiento

«¡Que difícil es,
cuando todo baja
no bajar también!»

Antonio Machado

Superación de límites

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

Una sucesión de puntuaciones se puede representar mediante una lista de números. Por ejemplo, [7,5,9,9,4,5,4,2,5,9,12,1]. En la lista anterior, los puntos en donde se alcanzan un nuevo máximo son 7, 9 y 12 (porque son mayores que todos sus anteriores) y en donde se alcanzan un nuevo mínimo son 7, 5, 4, 2 y 1 (porque son menores que todos sus anteriores). Por tanto, el máximo se ha superado 2 veces y el mínimo 4 veces.

Definir las funciones

   nuevosMaximos :: [Int] -> [Int]
   nuevosMinimos :: [Int] -> [Int]
   nRupturas     :: [Int] -> (Int,Int)

nuevosMaximos :: [Int] -> [Int]

nuevosMinimos :: [Int] -> [Int]

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

tales que

(nuevosMaximos xs) es la lista de los nuevos máximos de xs. Por ejemplo,

     nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,9,12]

1	nuevosMaximos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,9,12]

(nuevosMinimos xs) es la lista de los nuevos mínimos de xs. Por ejemplo,

     nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1]  ==  [7,5,4,2,1]

1	nuevosMinimos [7,5,9,9,4,5,4,2,5,9,12,1] == [7,5,4,2,1]

(nRupturas xs) es el par formado por el número de veces que se supera el máximo y el número de veces que se supera el mínimo en xs. Por ejemplo,

     nRupturas [7,5,9,9,4,5,4,2,5,9,12,1]  ==  (2,4)

1	nRupturas [7,5,9,9,4,5,4,2,5,9,12,1] == (2,4)

Soluciones

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]
nuevosMaximos xs = map head (group (map maximum xss))
  where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]
nuevosMinimos xs = map head (group (map minimum xss))
  where xss = tail (inits xs)

nRupturas :: [Int] -> (Int,Int)
nRupturas [] = (0,0)
nRupturas xs =
  ( length (nuevosMaximos xs) - 1
  , length (nuevosMinimos xs) - 1)

import Data.List (group, inits)

nuevosMaximos :: [Int] -> [Int]

nuevosMaximos xs = map head (group (map maximum xss))

where xss = tail (inits xs)

nuevosMinimos :: [Int] -> [Int]

nuevosMinimos xs = map head (group (map minimum xss))

where xss = tail (inits xs)

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

nRupturas [] = (0,0)

nRupturas xs =

( length (nuevosMaximos xs) - 1

, length (nuevosMinimos xs) - 1)

Pensamiento

«Todo necio confunde valor y precio.» ~ Antonio Machado.

Expresiones aritméticas generales

PorJosé A. Alonso 13-diciembre-201825-marzo-2022

Las expresiones aritméticas. generales se contruyen con las sumas generales (sumatorios) y productos generales (productorios). Su tipo es

   data Expresion = N Int
                  | S [Expresion]
                  | P [Expresion]
     deriving Show

data Expresion = N Int

| S [Expresion]

| P [Expresion]

deriving Show

Por ejemplo, la expresión (2 * (1 + 2 + 1) * (2 + 3)) + 1 se representa por S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1]

Definir la función

   valor :: Expresion -> Int

1	valor :: Expresion -> Int

tal que (valor e) es el valor de la expresión e. Por ejemplo,

   λ> valor (S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1])
   41

1 2	λ> valor (S [P [N 2, S [N 1, N 2, N 1], S [N 2, N 3]], N 1]) 41

Soluciones

data Expresion = N Int
               | S [Expresion]
               | P [Expresion]
  deriving Show

valor :: Expresion -> Int
valor (N x)  = x
valor (S es) = sum (map valor es)
valor (P es) = product (map valor es)

data Expresion = N Int

| S [Expresion]

| P [Expresion]

deriving Show

valor :: Expresion -> Int

valor (N x) = x

valor (S es) = sum (map valor es)

valor (P es) = product (map valor es)

Pensamiento

Vivir es devorar tiempo, esperar; y por muy trascendente que quiera ser nuestra espera, siempre será espera de seguir esperando.

Antonio Machado

Elemento del árbol binario completo según su posición

PorJosé A. Alonso 6-diciembre-201817-enero-2019

Un árbol binario completo es un árbol binario que tiene todos los nodos posibles hasta el penúltimo nivel, y donde los elementos del último nivel están colocados de izquierda a derecha sin dejar huecos entre ellos.

La numeración de los árboles binarios completos se realiza a partir de la raíz, recorriendo los niveles de izquierda a derecha. Por ejemplo,

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

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

Los árboles binarios se puede representar mediante el siguiente tipo

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

data Arbol = H

| N Integer Arbol Arbol

deriving (Show, Eq)

Cada posición de un elemento de un árbol es una lista de movimientos hacia la izquierda o hacia la derecha. Por ejemplo, la posición de 9 en al árbol anterior es [I,I,D].

Los tipos de los movimientos y de las posiciones se definen por

   data Movimiento = I | D deriving (Show, Eq)
   type Posicion   = [Movimiento]

1 2	data Movimiento = I \| D deriving (Show, Eq) type Posicion = [Movimiento]

Definir la función

   elementoEnPosicion :: Posicion -> Integer

1	elementoEnPosicion :: Posicion -> Integer

tal que (elementoEnPosicion ms) es el elemento en la posición ms. Por ejemplo,

   elementoEnPosicion [D,I]    ==  6
   elementoEnPosicion [D,D]    ==  7
   elementoEnPosicion [I,I,D]  ==  9
   elementoEnPosicion []       ==  1

elementoEnPosicion [D,I] == 6

elementoEnPosicion [D,D] == 7

elementoEnPosicion [I,I,D] == 9

elementoEnPosicion [] == 1

Soluciones

import Test.QuickCheck

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

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

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

elementoEnPosicion :: Posicion -> Integer
elementoEnPosicion ms =
  aux ms (arbolBinarioCompleto (2^(1 + length ms)))
  where aux []     (N x _ _) = x
        aux (I:ms) (N _ i _) = aux ms i
        aux (D:ms) (N _ _ d) = aux ms d

-- (arbolBinarioCompleto n) es el árbol binario completo con n
-- nodos. Por ejemplo, 
--    λ> arbolBinarioCompleto 4
--    N 1 (N 2 (N 4 H H) H) (N 3 H H)
--    λ> pPrint (arbolBinarioCompleto 9)
--    N 1
--      (N 2
--         (N 4
--            (N 8 H H)
--            (N 9 H H))
--         (N 5 H H))
--      (N 3
--         (N 6 H H)
--         (N 7 H H))
arbolBinarioCompleto :: Integer -> Arbol
arbolBinarioCompleto n = aux 1
  where aux i | i <= n    = N i (aux (2*i)) (aux (2*i+1))
              | otherwise = H

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

elementoEnPosicion2 :: Posicion -> Integer
elementoEnPosicion2 = aux . reverse
  where aux []     = 1
        aux (I:ms) = 2 * aux ms
        aux (D:ms) = 2 * aux ms + 1

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

-- La propiedad es
prop_elementoEnPosicion_equiv :: Positive Integer -> Bool
prop_elementoEnPosicion_equiv (Positive n) =
  elementoEnPosicion  ps == n &&
  elementoEnPosicion2 ps == n 
  where ps = posicionDeElemento n

-- tal que (posicionDeElemento n) es la posición del elemento n en el
-- árbol binario completo. Por ejemplo,
--    posicionDeElemento 6  ==  [D,I]
--    posicionDeElemento 7  ==  [D,D]
--    posicionDeElemento 9  ==  [I,I,D]
--    posicionDeElemento 1  ==  []
posicionDeElemento :: Integer -> Posicion
posicionDeElemento n =
  [f x | x <- tail (reverse (binario n))]
  where f 0 = I
        f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria
-- de n. Por ejemplo,
--    binario 11  ==  [1,1,0,1]
binario :: Integer -> [Integer]
binario n
  | n < 2     = [n]
  | otherwise = n `mod` 2 : binario (n `div` 2)

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

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

--    λ> length (show (elementoEnPosicion (replicate (3*10^5) D)))
--    90310
--    (1.96 secs, 11,518,771,016 bytes)
--    λ> length (show (elementoEnPosicion2 (replicate (3*10^5) D)))
--    90310
--    (14.32 secs, 11,508,181,176 bytes)

import Test.QuickCheck

data Arbol = H

| N Integer Arbol Arbol

deriving (Eq, Show)

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

-- 1ª solución

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

elementoEnPosicion :: Posicion -> Integer

elementoEnPosicion ms =

aux ms (arbolBinarioCompleto (2^(1 + length ms)))

where aux [] (N x _ _) = x

aux (I:ms) (N _ i _) = aux ms i

aux (D:ms) (N _ _ d) = aux ms d

-- (arbolBinarioCompleto n) es el árbol binario completo con n

-- nodos. Por ejemplo,

-- λ> arbolBinarioCompleto 4

-- N 1 (N 2 (N 4 H H) H) (N 3 H H)

-- λ> pPrint (arbolBinarioCompleto 9)

-- N 1

-- (N 2

-- (N 4

-- (N 8 H H)

-- (N 9 H H))

-- (N 5 H H))

-- (N 3

-- (N 6 H H)

-- (N 7 H H))

arbolBinarioCompleto :: Integer -> Arbol

arbolBinarioCompleto n = aux 1

where aux i | i <= n = N i (aux (2*i)) (aux (2*i+1))

| otherwise = H

-- 2ª solución

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

elementoEnPosicion2 :: Posicion -> Integer

elementoEnPosicion2 = aux . reverse

where aux [] = 1

aux (I:ms) = 2 * aux ms

aux (D:ms) = 2 * aux ms + 1

-- Equivalencia

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

-- La propiedad es

prop_elementoEnPosicion_equiv :: Positive Integer -> Bool

prop_elementoEnPosicion_equiv (Positive n) =

elementoEnPosicion ps == n &&

elementoEnPosicion2 ps == n

where ps = posicionDeElemento n

-- tal que (posicionDeElemento n) es la posición del elemento n en el

-- árbol binario completo. Por ejemplo,

-- posicionDeElemento 6 == [D,I]

-- posicionDeElemento 7 == [D,D]

-- posicionDeElemento 9 == [I,I,D]

-- posicionDeElemento 1 == []

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

[f x | x <- tail (reverse (binario n))]

where f 0 = I

f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria

-- de n. Por ejemplo,

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

binario :: Integer -> [Integer]

binario n

| n < 2 = [n]

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

-- La comprobación es

-- λ> quickCheck prop_elementoEnPosicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> length (show (elementoEnPosicion (replicate (3*10^5) D)))

-- 90310

-- (1.96 secs, 11,518,771,016 bytes)

-- λ> length (show (elementoEnPosicion2 (replicate (3*10^5) D)))

-- 90310

-- (14.32 secs, 11,508,181,176 bytes)

Pensamiento

Las más hondas palabras
del sabio nos enseñan
lo que el silbar del viento cuando sopla
o el sonar de las aguas cuando ruedan.

Antonio Machado

Posiciones en árboles binarios completos

PorJosé A. Alonso 5-diciembre-201819-enero-2019

La numeración de los árboles binarios completos se realiza a partir de la raíz, recorriendo los niveles de izquierda a derecha. Por ejemplo,

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

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

Los árboles binarios se puede representar mediante el siguiente tipo

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

data Arbol = H

| N Integer Arbol Arbol

deriving (Show, Eq)

Cada posición de un elemento de un árbol es una lista de movimientos hacia la izquierda o hacia la derecha. Por ejemplo, la posición de 9 en al árbol anterior es [I,I,D].

Los tipos de los movimientos y de las posiciones se definen por

   data Movimiento = I | D deriving (Show, Eq)
   type Posicion   = [Movimiento]

1 2	data Movimiento = I \| D deriving (Show, Eq) type Posicion = [Movimiento]

Definir la función

   posicionDeElemento :: Integer -> Posicion

1	posicionDeElemento :: Integer -> Posicion

tal que (posicionDeElemento n) es la posición del elemento n en el árbol binario completo. Por ejemplo,

   posicionDeElemento 6  ==  [D,I]
   posicionDeElemento 7  ==  [D,D]
   posicionDeElemento 9  ==  [I,I,D]
   posicionDeElemento 1  ==  []

   length (posicionDeElemento (10^50000))  ==  166096

posicionDeElemento 6 == [D,I]

posicionDeElemento 7 == [D,D]

posicionDeElemento 9 == [I,I,D]

posicionDeElemento 1 == []

length (posicionDeElemento (10^50000)) == 166096

Soluciones

import Test.QuickCheck

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

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

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

posicionDeElemento :: Integer -> Posicion
posicionDeElemento n =
  head (posiciones n (arbolBinarioCompleto n))

-- (arbolBinarioCompleto n) es el árbol binario completo con n
-- nodos. Por ejemplo, 
--    λ> arbolBinarioCompleto 4
--    N 1 (N 2 (N 4 H H) H) (N 3 H H)
--    λ> pPrint (arbolBinarioCompleto 9)
--    N 1
--      (N 2
--         (N 4
--            (N 8 H H)
--            (N 9 H H))
--         (N 5 H H))
--      (N 3
--         (N 6 H H)
--         (N 7 H H))
arbolBinarioCompleto :: Integer -> Arbol
arbolBinarioCompleto n = aux 1
  where aux i | i <= n    = N i (aux (2*i)) (aux (2*i+1))
              | otherwise = H

-- (posiciones n a) es la lista de las posiciones del elemento n
-- en el árbol a. Por ejemplo,
--    posiciones 9 (arbolBinarioCompleto 9)  ==  [[I,I,D]]
posiciones :: Integer -> Arbol -> [Posicion]
posiciones n a = aux n a [[]]
  where aux _ H _                      = []
        aux n (N x i d) cs | x == n    = cs ++ ps
                           | otherwise = ps
          where ps = map (I:) (aux n i cs) ++
                     map (D:) (aux n d cs)

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

posicionDeElemento2 :: Integer -> Posicion
posicionDeElemento2 1 = []
posicionDeElemento2 n
  | even n    = posicionDeElemento2 (n `div` 2) ++ [I]
  | otherwise = posicionDeElemento2 (n `div` 2) ++ [D]

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

posicionDeElemento3 :: Integer -> Posicion
posicionDeElemento3 = reverse . aux
  where aux 1 = []
        aux n | even n    = I : aux (n `div` 2) 
              | otherwise = D : aux (n `div` 2) 

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

posicionDeElemento4 :: Integer -> Posicion
posicionDeElemento4 n =
  [f x | x <- tail (reverse (binario n))]
  where f 0 = I
        f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria
-- de n. Por ejemplo,
--    binario 11  ==  [1,1,0,1]
binario :: Integer -> [Integer]
binario n
  | n < 2     = [n]
  | otherwise = n `mod` 2 : binario (n `div` 2)

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

-- La propiedad es
prop_posicionDeElemento_equiv :: Positive Integer -> Bool
prop_posicionDeElemento_equiv (Positive n) =
  posicionDeElemento n == posicionDeElemento2 n &&
  posicionDeElemento n == posicionDeElemento3 n &&
  posicionDeElemento n == posicionDeElemento4 n

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

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

--    λ> posicionDeElemento (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (5.72 secs, 3,274,535,328 bytes)
--    λ> posicionDeElemento2 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 189,560 bytes)
--    λ> posicionDeElemento3 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 180,728 bytes)
--    λ> posicionDeElemento4 (10^7)
--    [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]
--    (0.01 secs, 184,224 bytes)
--    
--    λ> length (posicionDeElemento2 (10^4000))
--    13287
--    (2.80 secs, 7,672,011,280 bytes)
--    λ> length (posicionDeElemento3 (10^4000))
--    13287
--    (0.03 secs, 19,828,744 bytes)
--    λ> length (posicionDeElemento4 (10^4000))
--    13287
--    (0.03 secs, 18,231,536 bytes)
--    
--    λ> length (posicionDeElemento3 (10^50000))
--    166096
--    (1.34 secs, 1,832,738,136 bytes)
--    λ> length (posicionDeElemento4 (10^50000))
--    166096
--    (1.70 secs, 1,812,806,080 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

import Test.QuickCheck

data Arbol = H

| N Integer Arbol Arbol

deriving (Eq, Show)

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

-- 1ª solución

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

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

head (posiciones n (arbolBinarioCompleto n))

-- (arbolBinarioCompleto n) es el árbol binario completo con n

-- nodos. Por ejemplo,

-- λ> arbolBinarioCompleto 4

-- N 1 (N 2 (N 4 H H) H) (N 3 H H)

-- λ> pPrint (arbolBinarioCompleto 9)

-- N 1

-- (N 2

-- (N 4

-- (N 8 H H)

-- (N 9 H H))

-- (N 5 H H))

-- (N 3

-- (N 6 H H)

-- (N 7 H H))

arbolBinarioCompleto :: Integer -> Arbol

arbolBinarioCompleto n = aux 1

where aux i | i <= n = N i (aux (2*i)) (aux (2*i+1))

| otherwise = H

-- (posiciones n a) es la lista de las posiciones del elemento n

-- en el árbol a. Por ejemplo,

-- posiciones 9 (arbolBinarioCompleto 9) == [[I,I,D]]

posiciones :: Integer -> Arbol -> [Posicion]

posiciones n a = aux n a [[]]

where aux _ H _ = []

aux n (N x i d) cs | x == n = cs ++ ps

| otherwise = ps

where ps = map (I:) (aux n i cs) ++

map (D:) (aux n d cs)

-- 2ª solución

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

posicionDeElemento2 :: Integer -> Posicion

posicionDeElemento2 1 = []

posicionDeElemento2 n

| even n = posicionDeElemento2 (n `div` 2) ++ [I]

| otherwise = posicionDeElemento2 (n `div` 2) ++ [D]

-- 3ª solución

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

posicionDeElemento3 :: Integer -> Posicion

posicionDeElemento3 = reverse . aux

where aux 1 = []

aux n | even n = I : aux (n `div` 2)

| otherwise = D : aux (n `div` 2)

-- 4ª solución

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

posicionDeElemento4 :: Integer -> Posicion

posicionDeElemento4 n =

[f x | x <- tail (reverse (binario n))]

where f 0 = I

f 1 = D

-- (binario n) es la lista de los dígitos de la representación binaria

-- de n. Por ejemplo,

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

binario :: Integer -> [Integer]

binario n

| n < 2 = [n]

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

-- Equivalencia

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

-- La propiedad es

prop_posicionDeElemento_equiv :: Positive Integer -> Bool

prop_posicionDeElemento_equiv (Positive n) =

posicionDeElemento n == posicionDeElemento2 n &&

posicionDeElemento n == posicionDeElemento3 n &&

posicionDeElemento n == posicionDeElemento4 n

-- La comprobación es

-- λ> quickCheck prop_posicionDeElemento_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> posicionDeElemento (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (5.72 secs, 3,274,535,328 bytes)

-- λ> posicionDeElemento2 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 189,560 bytes)

-- λ> posicionDeElemento3 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 180,728 bytes)

-- λ> posicionDeElemento4 (10^7)

-- [I,I,D,D,I,I,I,D,I,I,D,I,D,D,I,D,I,I,I,I,I,I,I]

-- (0.01 secs, 184,224 bytes)

-- λ> length (posicionDeElemento2 (10^4000))

-- 13287

-- (2.80 secs, 7,672,011,280 bytes)

-- λ> length (posicionDeElemento3 (10^4000))

-- 13287

-- (0.03 secs, 19,828,744 bytes)

-- λ> length (posicionDeElemento4 (10^4000))

-- 13287

-- (0.03 secs, 18,231,536 bytes)

-- λ> length (posicionDeElemento3 (10^50000))

-- 166096

-- (1.34 secs, 1,832,738,136 bytes)

-- λ> length (posicionDeElemento4 (10^50000))

-- 166096

-- (1.70 secs, 1,812,806,080 bytes)

Pensamiento

El ojo que ves no es
ojo porque tú lo veas;
es ojo porque te ve.

Antonio Machado

Posiciones en árboles binarios

PorJosé A. Alonso 4-diciembre-201819-enero-2019

Los árboles binarios con datos en los nodos se definen por

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

Por ejemplo, el árbol

          3
         / \
        /   \
       0     5
      / \   / \
     5   0 0   3
    / \
   2   4

/ \

0 5

/ \ / \

5 0 0 3

/ \

2 4

se representa por

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

ejArbol :: Arbol Int

ejArbol = N 3

(N 0

(N 5

(N 2 H H)

(N 4 H H))

(N 0 H H))

(N 5

(N 0 H H)

(N 3 H H))

Cada posición de un elemento de un árbol es una lista de movimientos hacia la izquierda o hacia la derecha. Por ejemplo, la posición de 4 en al árbol anterior es [I,I,D].

Los tipos de los movimientos y de las posiciones se definen por

   data Movimiento = I | D deriving (Show, Eq)
   type Posicion   = [Movimiento]

1 2	data Movimiento = I \| D deriving (Show, Eq) type Posicion = [Movimiento]

Definir la función

   posiciones :: Eq b => b -> Arbol b -> [Posicion]

1	posiciones :: Eq b => b -> Arbol b -> [Posicion]

tal que (posiciones n a) es la lista de las posiciones del elemento n en el árbol a. Por ejemplo,

   posiciones 0 ejArbol  ==  [[I],[I,D],[D,I]]
   posiciones 2 ejArbol  ==  [[I,I,I]]
   posiciones 3 ejArbol  ==  [[],[D,D]]
   posiciones 4 ejArbol  ==  [[I,I,D]]
   posiciones 5 ejArbol  ==  [[I,I],[D]]
   posiciones 1 ejArbol  ==  []

posiciones 0 ejArbol == [[I],[I,D],[D,I]]

posiciones 2 ejArbol == [[I,I,I]]

posiciones 3 ejArbol == [[],[D,D]]

posiciones 4 ejArbol == [[I,I,D]]

posiciones 5 ejArbol == [[I,I],[D]]

posiciones 1 ejArbol == []

Soluciones

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

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

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

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

posiciones :: Eq b => b -> Arbol b -> [Posicion]
posiciones n a = aux n a [[]]
  where aux _ H _                      = []
        aux n (N x i d) cs | x == n    = cs ++
                                         [I:xs | xs <- aux n i cs] ++
                                         [D:xs | xs <- aux n d cs]
                           | otherwise = [I:xs | xs <- aux n i cs] ++
                                         [D:xs | xs <- aux n d cs]
                   
-- 2ª solución
-- ===========

posiciones2 :: Eq b => b -> Arbol b -> [Posicion]
posiciones2 n a = aux n a [[]]
  where aux _ H _                      = []
        aux n (N x i d) cs | x == n    = cs ++ ps
                           | otherwise = ps
          where ps = [I:xs | xs <- aux n i cs] ++
                     [D:xs | xs <- aux n d cs]

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

posiciones3 :: Eq b => b -> Arbol b -> [Posicion]
posiciones3 n a = aux n a [[]]
  where aux _ H _                      = []
        aux n (N x i d) cs | x == n    = cs ++ ps
                           | otherwise = ps
          where ps = map (I:) (aux n i cs) ++
                     map (D:) (aux n d cs)

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

-- Generador de árboles
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized genArbol

genArbol :: (Arbitrary a, Integral a1) => a1 -> Gen (Arbol a)
genArbol 0         = return H 
genArbol n | n > 0 = N <$> arbitrary <*> subarbol <*> subarbol
  where subarbol = genArbol (div n 2)

-- La propiedad es
prop_posiciones_equiv :: Arbol Int -> Bool
prop_posiciones_equiv a =
  and [posiciones n a == posiciones2 n a | n <- xs] &&
  and [posiciones n a == posiciones3 n a | n <- xs]  
  where xs = take 3 (elementos a)

-- (elementos a) son los elementos del árbol a. Por ejemplo,
--    elementos ejArbol  ==  [3,0,5,2,4]
elementos :: Eq b => Arbol b -> [b]
elementos H         = []
elementos (N x i d) = nub (x : elementos i ++ elementos d)

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving (Eq, Show)

ejArbol :: Arbol Int

ejArbol = N 3

(N 0

(N 5

(N 2 H H)

(N 4 H H))

(N 0 H H))

(N 5

(N 0 H H)

(N 3 H H))

data Movimiento = I | D deriving (Show, Eq)

type Posicion = [Movimiento]

-- 1ª solución

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

posiciones :: Eq b => b -> Arbol b -> [Posicion]

posiciones n a = aux n a [[]]

where aux _ H _ = []

aux n (N x i d) cs | x == n = cs ++

[I:xs | xs <- aux n i cs] ++

[D:xs | xs <- aux n d cs]

| otherwise = [I:xs | xs <- aux n i cs] ++

[D:xs | xs <- aux n d cs]

-- 2ª solución

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

posiciones2 :: Eq b => b -> Arbol b -> [Posicion]

posiciones2 n a = aux n a [[]]

where aux _ H _ = []

aux n (N x i d) cs | x == n = cs ++ ps

| otherwise = ps

where ps = [I:xs | xs <- aux n i cs] ++

[D:xs | xs <- aux n d cs]

-- 3ª solución

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

posiciones3 :: Eq b => b -> Arbol b -> [Posicion]

posiciones3 n a = aux n a [[]]

where aux _ H _ = []

aux n (N x i d) cs | x == n = cs ++ ps

| otherwise = ps

where ps = map (I:) (aux n i cs) ++

map (D:) (aux n d cs)

-- Equivalencia

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

-- Generador de árboles

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized genArbol

genArbol :: (Arbitrary a, Integral a1) => a1 -> Gen (Arbol a)

genArbol 0 = return H

genArbol n | n > 0 = N <$> arbitrary <*> subarbol <*> subarbol

where subarbol = genArbol (div n 2)

-- La propiedad es

prop_posiciones_equiv :: Arbol Int -> Bool

prop_posiciones_equiv a =

and [posiciones n a == posiciones2 n a | n <- xs] &&

and [posiciones n a == posiciones3 n a | n <- xs]

where xs = take 3 (elementos a)

-- (elementos a) son los elementos del árbol a. Por ejemplo,

-- elementos ejArbol == [3,0,5,2,4]

elementos :: Eq b => Arbol b -> [b]

elementos H = []

elementos (N x i d) = nub (x : elementos i ++ elementos d)

-- La comprobación es

-- λ> quickCheck prop_posiciones_equiv

-- +++ OK, passed 100 tests.

Pensamiento

Nunca traces tu frontera,
ni cuides de tu perfil;
todo eso es cosa de fuera.

Antonio Machado

Números colinas

PorJosé A. Alonso 29-noviembre-201819-enero-2019

Se dice que un número natural n es una colina si su primer dígito es igual a su último dígito, los primeros dígitos son estrictamente creciente hasta llegar al máximo, el máximo se puede repetir y los dígitos desde el máximo al final son estrictamente decrecientes.

Definir la función

   esColina :: Integer -> Bool

1	esColina :: Integer -> Bool

tal que (esColina n) se verifica si n es un número colina. Por ejemplo,

   esColina 12377731  ==  True
   esColina 1237731   ==  True
   esColina 123731    ==  True
   esColina 122731    ==  False
   esColina 12377730  ==  False
   esColina 12377730  ==  False
   esColina 10377731  ==  False
   esColina 12377701  ==  False
   esColina 33333333  ==  True

esColina 12377731 == True

esColina 1237731 == True

esColina 123731 == True

esColina 122731 == False

esColina 12377730 == False

esColina 10377731 == False

esColina 12377701 == False

esColina 33333333 == True

Soluciones

import Data.Char (digitToInt)

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

esColina :: Integer -> Bool
esColina n =
  head ds == last ds &&
  esCreciente xs &&
  esDecreciente ys
  where ds = digitos n
        m  = maximum ds
        xs = takeWhile (<m) ds
        ys = dropWhile (==m) (dropWhile (<m) ds)

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

-- (esCreciente xs) se verifica si la lista xs es estrictamente
-- creciente. Por ejemplo,
--    esCreciente [2,4,7]  ==  True
--    esCreciente [2,2,7]  ==  False
--    esCreciente [2,1,7]  ==  False
esCreciente :: [Int] -> Bool
esCreciente xs = and [x < y | (x,y) <- zip xs (tail xs)]

-- (esDecreciente xs) se verifica si la lista xs es estrictamente
-- decreciente. Por ejemplo,
--    esDecreciente [7,4,2]  ==  True
--    esDecreciente [7,2,2]  ==  False
--    esDecreciente [7,1,2]  ==  False
esDecreciente :: [Int] -> Bool
esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]

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

esColina2 :: Integer -> Bool
esColina2 n =
  head ds == last ds &&
  null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))
  where ds = digitos n
        xs = [signum (y-x) | (x,y) <- zip ds (tail ds)] 

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

-- La propiedad de equivalencia es
prop_esColina :: Integer -> Property
prop_esColina n =
  n >= 0 ==> esColina n == esColina2 n 

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

import Data.Char (digitToInt)

-- 1ª definición

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

esColina :: Integer -> Bool

esColina n =

head ds == last ds &&

esCreciente xs &&

esDecreciente ys

where ds = digitos n

m = maximum ds

xs = takeWhile (<m) ds

ys = dropWhile (==m) (dropWhile (<m) ds)

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

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

digitos :: Integer -> [Int]

digitos n = map digitToInt (show n)

-- (esCreciente xs) se verifica si la lista xs es estrictamente

-- creciente. Por ejemplo,

-- esCreciente [2,4,7] == True

-- esCreciente [2,2,7] == False

-- esCreciente [2,1,7] == False

esCreciente :: [Int] -> Bool

esCreciente xs = and [x < y | (x,y) <- zip xs (tail xs)]

-- (esDecreciente xs) se verifica si la lista xs es estrictamente

-- decreciente. Por ejemplo,

-- esDecreciente [7,4,2] == True

-- esDecreciente [7,2,2] == False

-- esDecreciente [7,1,2] == False

esDecreciente :: [Int] -> Bool

esDecreciente xs = and [x > y | (x,y) <- zip xs (tail xs)]

-- 2ª definición

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

esColina2 :: Integer -> Bool

esColina2 n =

head ds == last ds &&

null (dropWhile (==(-1)) (dropWhile (==0) (dropWhile (==1) xs)))

where ds = digitos n

xs = [signum (y-x) | (x,y) <- zip ds (tail ds)]

-- Equivalencia

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

-- La propiedad de equivalencia es

prop_esColina :: Integer -> Property

prop_esColina n =

n >= 0 ==> esColina n == esColina2 n

-- La comprobación es

-- λ> quickCheck prop_esColina

-- +++ OK, passed 100 tests.

Referencia

Basado en el problema Is this number a hill number? de Code Golf

Pensamiento

Si me tengo que morir
poco me importa aprender.
Y si no puedo saber,
poco me importa vivir.

Antonio Machado

Número medio

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

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

Definir las siguientes funciones

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

numeroMedio :: Integer -> Bool

densidadesNumeroMedio :: [Double]

graficaDensidadNumeroMedio :: Int -> IO ()

tales que

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

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

λ> numeroMedio 370

True

λ> numeroMedio 371

False

λ> numeroMedio 485596707818930041152263374

True

λ> filter numeroMedio [100..600]

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

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

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

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

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

λ> mapM_ print (take 30 densidades)

1.0

0.9

0.9090909090909091

0.8333333333333334

0.7692307692307693

0.7142857142857143

0.6666666666666666

0.625

0.5882352941176471

0.5555555555555556

0.5263157894736842

0.5

0.47619047619047616

0.5

0.4782608695652174

0.4583333333333333

0.44

0.4230769230769231

0.4074074074074074

0.39285714285714285

0.3793103448275862

0.36666666666666664

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

y (graficaDensidadNumeroMedio 1000) dibuja

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de numeroMedio

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

numeroMedio :: Integer -> Bool

numeroMedio n =

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

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

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

digitos :: Integer -> [Integer]

digitos n =

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

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

-- ejemplo,

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

-- 1ª definición de digitosAnumero

digitosAnumero1 :: [Integer] -> Integer

digitosAnumero1 = aux . reverse

where aux [] = 0

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

-- 1ª definición de digitosAnumero

digitosAnumero2 :: [Integer] -> Integer

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

-- Comparación de eficiencia de definiciones de digitosAnumero

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

-- 100000

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

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

-- 100000

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

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

digitosAnumero :: [Integer] -> Integer

digitosAnumero = digitosAnumero2

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

-- valor es entero). Por ejemplo,

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

media :: [Integer] -> Integer

media xs = sum xs `div` genericLength xs

-- 2ª definición de numeroMedio

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

numeroMedio2 :: Integer -> Bool

numeroMedio2 n =

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

where xs = digitos n

k = genericLength xs

s = sum xs

-- Equivalencia de las definiciones de numeroMedio

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

-- La propiedad es

prop_numeroMedio :: Positive Integer -> Bool

prop_numeroMedio (Positive n) =

numeroMedio n == numeroMedio2 n

-- La comprobación es

-- λ> quickCheck prop_numeroMedio

-- +++ OK, passed 100 tests.

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

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

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

-- [11111]

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

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

-- [11111]

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

-- Definición de densidadesNumeroMedio

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

densidadesNumeroMedio :: [Double]

densidadesNumeroMedio =

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

-- Definición de graficaDensidadNumeroMedio

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

graficaDensidadNumeroMedio :: Int -> IO ()

graficaDensidadNumeroMedio n =

plotList [ Title ("graficaDensidadNumeroMedio")

, Key Nothing

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

, XRange (1, fromIntegral n)]

(take n densidadesNumeroMedio)

[/expand]

Tren de potencias

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

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

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

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

Definir las funciones

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

trenDePotencias :: Integer -> Integer

esPuntoFijoTrenDePotencias :: Integer -> Bool

puntosFijosTrenDePotencias :: [Integer]

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

tales que

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

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

trenDePotencias 20 == 1

trenDePotencias 21 == 2

trenDePotencias 24 == 16

trenDePotencias 39 == 19683

trenDePotencias 623 == 108

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

     esPuntoFijoTrenDePotencias 2592                        ==  True
     esPuntoFijoTrenDePotencias 24547284284866560000000000  ==  True

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

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

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

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

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

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

λ> tablaTrenDePotencias 20 39

| 20 | 1 |

| 21 | 2 |

| 22 | 4 |

| 23 | 8 |

| 24 | 16 |

| 25 | 32 |

| 26 | 64 |

| 27 | 128 |

| 28 | 256 |

| 29 | 512 |

| 30 | 1 |

| 31 | 3 |

| 32 | 9 |

| 33 | 27 |

| 34 | 81 |

| 35 | 243 |

| 36 | 729 |

| 37 | 2187 |

| 38 | 6561 |

| 39 | 19683 |

λ> tablaTrenDePotencias 2340 2359

| 2340 | 8 |

| 2341 | 32 |

| 2342 | 128 |

| 2343 | 512 |

| 2344 | 2048 |

| 2345 | 8192 |

| 2346 | 32768 |

| 2347 | 131072 |

| 2348 | 524288 |

| 2349 | 2097152 |

| 2350 | 8 |

| 2351 | 40 |

| 2352 | 200 |

| 2353 | 1000 |

| 2354 | 5000 |

| 2355 | 25000 |

| 2356 | 125000 |

| 2357 | 625000 |

| 2358 | 3125000 |

| 2359 | 15625000 |

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

Soluciones

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

import Test.QuickCheck
import Text.Printf

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

import Test.QuickCheck

import Text.Printf

-- 1ª definición de trenDePotencias

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

trenDePotencias :: Integer -> Integer

trenDePotencias = trenDePotenciasLN . digitos

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

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

digitos :: Integer -> [Integer]

digitos n =

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

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

-- xs. Por ejemplo,

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

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

trenDePotenciasLN :: [Integer] -> Integer

trenDePotenciasLN [] = 1

trenDePotenciasLN [x] = x

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

-- 2ª definición de trenDePotencias

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

trenDePotencias2 :: Integer -> Integer

trenDePotencias2 = trenDePotenciasLN2 . digitos

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

-- xs. Por ejemplo,

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

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

trenDePotenciasLN2 :: [Integer] -> Integer

trenDePotenciasLN2 xs =

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

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

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

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

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

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

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

pares [] = []

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

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

-- Equivalencia

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

-- La propiedad es

prop_equivalencia :: (Positive Integer) -> Bool

prop_equivalencia (Positive n) =

trenDePotencias n == trenDePotencias2 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

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

-- True

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

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

-- True

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

-- Definición de esPuntoFijoTrenDePotencias

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

esPuntoFijoTrenDePotencias :: Integer -> Bool

esPuntoFijoTrenDePotencias n =

trenDePotencias n == n

-- Definición de puntosFijosTrenDePotencias

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

puntosFijosTrenDePotencias :: [Integer]

puntosFijosTrenDePotencias =

filter esPuntoFijoTrenDePotencias [1..]

-- Definición de tablaTrenDePotencias

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

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

tablaTrenDePotencias a b =

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

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

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

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

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

-- Comprobación

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

-- La propiedad es

prop_puntosFijos :: Positive Integer -> Property

prop_puntosFijos (Positive n) =

x < 24547284284866560000000000 ==> not (esPuntoFijoTrenDePotencias x)

where x = 2593 + n

-- La comprobación es

-- λ> quickCheck prop_puntosFijos

-- +++ OK, passed 100 tests.

[/expand]

Sucesión fractal

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

La sucesión fractal

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

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

está construida de la siguiente forma:

los términos pares forman la sucesión de los números naturales

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

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

los términos impares forman la misma sucesión original

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

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

Definir las funciones

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

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

tales que

sucFractal es la lista de los términos de la sucesión fractal. Por ejemplo,

     take 20 sucFractal   == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]
     sucFractal !! 30     == 15
     sucFractal !! (10^7) == 5000000

take 20 sucFractal == [0,0,1,0,2,1,3,0,4,2,5,1,6,3,7,0,8,4,9,2]

sucFractal !! 30 == 15

sucFractal !! (10^7) == 5000000

(sumaSucFractal n) es la suma de los n primeros términos de la sucesión fractal. Por ejemplo,

     sumaSucFractal 10      == 13
     sumaSucFractal (10^5)  == 1666617368
     sumaSucFractal (10^10) == 16666666661668691669
     sumaSucFractal (10^15) == 166666666666666166673722792954
     sumaSucFractal (10^20) == 1666666666666666666616666684103392376198
     length (show (sumaSucFractal (10^15000))) == 30000
     sumaSucFractal (10^15000) `mod` (10^9)    == 455972157

sumaSucFractal 10 == 13

sumaSucFractal (10^5) == 1666617368

sumaSucFractal (10^10) == 16666666661668691669

sumaSucFractal (10^15) == 166666666666666166673722792954

sumaSucFractal (10^20) == 1666666666666666666616666684103392376198

length (show (sumaSucFractal (10^15000))) == 30000

sumaSucFractal (10^15000) `mod` (10^9) == 455972157

Soluciones

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

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

[/schedule]

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

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

sucFractal1 :: [Integer]
sucFractal1 = 
  map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,
--   termino 0            ==  0
--   termino 1            ==  0
--   map termino [0..10]  ==  [0,0,1,0,2,1,3,0,4,2,5]
termino :: Integer -> Integer
termino 0 = 0
termino n 
  | even n    = n `div` 2
  | otherwise = termino (n `div` 2)

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

sucFractal2 :: [Integer]
sucFractal2 =
    0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas
-- xs e ys. Por ejemplo,
--    take 10 (mezcla [0,2..] [0,-2..])  ==  [0,0,2,-2,4,-4,6,-6,8,-8]
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla (x:xs) (y:ys) =
  x : y : mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal
-- =======================================================

--    λ> sum (take (10^6) sucFractal1)
--    166666169612
--    (5.56 secs, 842,863,264 bytes)
--    λ> sum (take (10^6) sucFractal2)
--    166666169612
--    (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición
sucFractal :: [Integer]
sucFractal = sucFractal2

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

sumaSucFractal1 :: Integer -> Integer
sumaSucFractal1 n =
  sum (map termino [0..n-1])

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

sumaSucFractal2 :: Integer -> Integer
sumaSucFractal2 n =
    sum (take (fromIntegral n) sucFractal)

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

sumaSucFractal3 :: Integer -> Integer
sumaSucFractal3 0 = 0
sumaSucFractal3 1 = 0
sumaSucFractal3 n
  | even n    = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)
  | otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)
  where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal
-- ===========================================================

--    λ> sumaSucFractal1 (10^6)
--    166666169612
--    (5.25 secs, 810,622,504 bytes)
--    λ> sumaSucFractal2 (10^6)
--    166666169612
--    (1.72 secs, 286,444,048 bytes)
--    λ> sumaSucFractal3 (10^6)
--    166666169612
--    (0.01 secs, 0 bytes)
--    
--    λ> sumaSucFractal2 (10^7)
--    16666661685034
--    (17.49 secs, 3,021,580,920 bytes)
--    λ> sumaSucFractal3 (10^7)
--    16666661685034
--    (0.01 secs, 0 bytes)

-- 1ª definición de sucFractal

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

sucFractal1 :: [Integer]

sucFractal1 =

map termino [0..]

-- (termino n) es el término n de la secuencia anterior. Por ejemplo,

-- termino 0 == 0

-- termino 1 == 0

-- map termino [0..10] == [0,0,1,0,2,1,3,0,4,2,5]

termino :: Integer -> Integer

termino 0 = 0

termino n

| even n = n `div` 2

| otherwise = termino (n `div` 2)

-- 2ª definición de sucFractal

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

sucFractal2 :: [Integer]

sucFractal2 =

0 : 0 : mezcla [1..] (tail sucFractal2)

-- (mezcla xs ys) es la lista obtenida intercalando las listas infinitas

-- xs e ys. Por ejemplo,

-- take 10 (mezcla [0,2..] [0,-2..]) == [0,0,2,-2,4,-4,6,-6,8,-8]

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla (x:xs) (y:ys) =

x : y : mezcla xs ys

-- Comparación de eficiencia de definiciones de sucFractal

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

-- λ> sum (take (10^6) sucFractal1)

-- 166666169612

-- (5.56 secs, 842,863,264 bytes)

-- λ> sum (take (10^6) sucFractal2)

-- 166666169612

-- (1.81 secs, 306,262,616 bytes)

-- En lo que sigue usaremos la 2ª definición

sucFractal :: [Integer]

sucFractal = sucFractal2

-- 1ª definición de sumaSucFractal

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

sumaSucFractal1 :: Integer -> Integer

sumaSucFractal1 n =

sum (map termino [0..n-1])

-- 2ª definición de sumaSucFractal

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

sumaSucFractal2 :: Integer -> Integer

sumaSucFractal2 n =

sum (take (fromIntegral n) sucFractal)

-- 3ª definición de sumaSucFractal

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

sumaSucFractal3 :: Integer -> Integer

sumaSucFractal3 0 = 0

sumaSucFractal3 1 = 0

sumaSucFractal3 n

| even n = sumaN (n `div` 2) + sumaSucFractal3 (n `div` 2)

| otherwise = sumaN ((n+1) `div` 2) + sumaSucFractal3 (n `div` 2)

where sumaN n = (n*(n-1)) `div` 2

-- Comparación de eficiencia de definiciones de sumaSucFractal

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

-- λ> sumaSucFractal1 (10^6)

-- 166666169612

-- (5.25 secs, 810,622,504 bytes)

-- λ> sumaSucFractal2 (10^6)

-- 166666169612

-- (1.72 secs, 286,444,048 bytes)

-- λ> sumaSucFractal3 (10^6)

-- 166666169612

-- (0.01 secs, 0 bytes)

-- λ> sumaSucFractal2 (10^7)

-- 16666661685034

-- (17.49 secs, 3,021,580,920 bytes)

-- λ> sumaSucFractal3 (10^7)

-- 16666661685034

-- (0.01 secs, 0 bytes)

Referencia

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

Caminos en un grafo

PorJosé A. Alonso 18-mayo-201825-abril-2021

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

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

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
    where ns = map fst as ++ map snd as
          m  = minimum ns
          n  = maximum ns

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
    aux [] = []
    aux ((x:xs):yss)
        | x == a    = (x:xs) : aux yss
        | otherwise = aux ([z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
                           ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
    where inicial          = [b]
          sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                     , z `notElem` (x:xs)] 
          esFinal (x:xs)   = x == a

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

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

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

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

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

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

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

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Problema del dominó

PorJosé A. Alonso 16-mayo-201823-mayo-2018

Las fichas del dominó se pueden representar por pares de números enteros. El problema del dominó consiste en colocar todas las fichas de una lista dada de forma que el segundo número de cada ficha coincida con el primero de la siguiente.

Definir la función

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

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   λ> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   λ> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   λ> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   λ> domino [(1,2),(2,3),(5,4)]
   []
   λ> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])
   9
   λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0
   λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])
   84480

λ> domino [(1,2),(2,3),(1,4)]

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

λ> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

λ> domino [(1,2),(3,4),(2,3)]

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

λ> domino [(1,2),(2,3),(5,4)]

[]

λ> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

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

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

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

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

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

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

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

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

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

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

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

λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])

λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])

84480

Soluciones

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)
-- =====================================

-- Las fichas son pares de números enteros.
type Ficha  = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar
type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.
inicial :: Problema -> Estado
inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.
esFinal :: Estado -> Bool
esFinal (fs,_) = null fs 

sucesores :: Estado -> [Estado]
sucesores (fs,[]) =
  [(delete f fs, [f]) | f <- fs]
sucesores (fs,n@((x,y):qs)) =
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
  [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

soluciones :: Problema -> [Estado]
soluciones p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]
domino ps = map snd (soluciones ps)
      
-- 2ª solución (por búsqueda en profundidad)
-- =========================================

soluciones2 :: Problema -> [Estado]
soluciones2 p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]
domino2 ps = map snd (soluciones2 ps)
      
-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)
-- =================================================

domino3 :: Problema -> [[Ficha]]
domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]
soluciones3 ps = buscaEE sucesores
                         esFinal         
                         (inicial ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)

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

-- Las fichas son pares de números enteros.

type Ficha = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar

type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.

inicial :: Problema -> Estado

inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.

esFinal :: Estado -> Bool

esFinal (fs,_) = null fs

sucesores :: Estado -> [Estado]

sucesores (fs,[]) =

[(delete f fs, [f]) | f <- fs]

sucesores (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

soluciones :: Problema -> [Estado]

soluciones p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]

domino ps = map snd (soluciones ps)

-- 2ª solución (por búsqueda en profundidad)

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

soluciones2 :: Problema -> [Estado]

soluciones2 p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]

domino2 ps = map snd (soluciones2 ps)

-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)

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

domino3 :: Problema -> [[Ficha]]

domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]

soluciones3 ps = buscaEE sucesores

esFinal

(inicial ps)

El problema de las celebridades

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

La celebridad de una reunión es una persona al que todos conocen pero que no conoce a nadie. Por ejemplo, si en la reunión hay tres personas tales que la 1 conoce a la 3 y la 2 conoce a la 1 y a la 3, entonces la celebridad de la reunión es la 3.

La relación de conocimiento se puede representar mediante una lista de pares (x,y) indicando que x conoce a y. Por ejemplo, la reunión anterior se puede representar por [(1,3),(2,1),(2,3)].

Definir la función

   celebridad :: Ord a => [(a,a)] -> Maybe a

1	celebridad :: Ord a => [(a,a)] -> Maybe a

tal que (celebridad r) es el justo la celebridad de r, si en r hay una celebridad y Nothing, en caso contrario. Por ejemplo,

   celebridad [(1,3),(2,1),(2,3)]            ==  Just 3
   celebridad [(1,3),(2,1),(3,2)]            ==  Nothing
   celebridad [(1,3),(2,1),(2,3),(3,1)]      ==  Nothing
   celebridad [(x,1) | x <- [2..10^6]]       ==  Just 1
   celebridad [(x,10^6) | x <- [1..10^6-1]]  ==  Just 1000000

celebridad [(1,3),(2,1),(2,3)] == Just 3

celebridad [(1,3),(2,1),(3,2)] == Nothing

celebridad [(1,3),(2,1),(2,3),(3,1)] == Nothing

celebridad [(x,1) | x <- [2..10^6]] == Just 1

celebridad [(x,10^6) | x <- [1..10^6-1]] == Just 1000000

Soluciones

import Data.List (delete, nub)
import Data.Maybe (listToMaybe)
import qualified Data.Set as S

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

celebridad1 :: Ord a => [(a,a)] -> Maybe a
celebridad1 r =
  listToMaybe [x | x <- personas r, esCelebridad r x]

personas :: Ord a => [(a,a)] -> [a]
personas r =
  nub (map fst r ++ map snd r)

esCelebridad :: Ord a => [(a,a)] -> a -> Bool
esCelebridad r x =
     [y | y <- ys, (y,x) `elem` r] == ys
  && null [y | y <- ys, (x,y) `elem` r]
  where ys = delete x (personas r)

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

celebridad2 :: Ord a => [(a,a)] -> Maybe a
celebridad2 r =
  listToMaybe [x | x <- personas2 c, esCelebridad2 c x]
  where c = S.fromList r

--    λ> personas2 (S.fromList [(1,3),(2,1),(2,3)])
--    [1,2,3]
personas2 :: Ord a => S.Set (a,a) -> [a]
personas2 c =
  S.toList (S.map fst c `S.union` S.map snd c)

esCelebridad2 :: Ord a => S.Set (a,a) -> a -> Bool
esCelebridad2 c x = 
      [y | y <- ys, (y,x) `S.member` c] == ys
   && null [y | y <- ys, (x,y) `S.member` c]
   where ys = delete x (personas2 c)

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

celebridad3 :: Ord a => [(a,a)] -> Maybe a
celebridad3 r
  | S.null candidatos = Nothing
  | esCelebridad      = Just candidato
  | otherwise         = Nothing
  where
    conjunto          = S.fromList r
    dominio           = S.map fst conjunto
    rango             = S.map snd conjunto
    total             = dominio `S.union` rango
    candidatos        = rango `S.difference` dominio
    candidato         = S.findMin candidatos
    noCandidatos      = S.delete candidato total
    esCelebridad      =
      S.filter (\x -> (x,candidato) `S.member` conjunto) total == noCandidatos
     
-- Comparación de eficiencia
-- =========================

--    λ> celebridad1 [(x,1) | x <- [2..300]]
--    Just 1
--    (2.70 secs, 38,763,888 bytes)
--    λ> celebridad2 [(x,1) | x <- [2..300]]
--    Just 1
--    (0.01 secs, 0 bytes)
-- 
--    λ> celebridad2 [(x,1000) | x <- [1..999]]
--    Just 1000
--    (2.23 secs, 483,704,224 bytes)
--    λ> celebridad3 [(x,1000) | x <- [1..999]]
--    Just 1000
--    (0.02 secs, 0 bytes)
-- 
--    λ> celebridad3 [(x,10^6) | x <- [1..10^6-1]]
--    Just 1000000
--    (9.56 secs, 1,572,841,088 bytes)
--    λ> celebridad3 [(x,1) | x <- [2..10^6]]
--    Just 1
--    (6.17 secs, 696,513,320 bytes)

import Data.List (delete, nub)

import Data.Maybe (listToMaybe)

import qualified Data.Set as S

-- 1ª solución

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

celebridad1 :: Ord a => [(a,a)] -> Maybe a

celebridad1 r =

listToMaybe [x | x <- personas r, esCelebridad r x]

personas :: Ord a => [(a,a)] -> [a]

personas r =

nub (map fst r ++ map snd r)

esCelebridad :: Ord a => [(a,a)] -> a -> Bool

esCelebridad r x =

[y | y <- ys, (y,x) `elem` r] == ys

&& null [y | y <- ys, (x,y) `elem` r]

where ys = delete x (personas r)

-- 2ª solución

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

celebridad2 :: Ord a => [(a,a)] -> Maybe a

celebridad2 r =

listToMaybe [x | x <- personas2 c, esCelebridad2 c x]

where c = S.fromList r

-- λ> personas2 (S.fromList [(1,3),(2,1),(2,3)])

-- [1,2,3]

personas2 :: Ord a => S.Set (a,a) -> [a]

personas2 c =

S.toList (S.map fst c `S.union` S.map snd c)

esCelebridad2 :: Ord a => S.Set (a,a) -> a -> Bool

esCelebridad2 c x =

[y | y <- ys, (y,x) `S.member` c] == ys

&& null [y | y <- ys, (x,y) `S.member` c]

where ys = delete x (personas2 c)

-- 3ª definición

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

celebridad3 :: Ord a => [(a,a)] -> Maybe a

celebridad3 r

| S.null candidatos = Nothing

| esCelebridad = Just candidato

| otherwise = Nothing

where

conjunto = S.fromList r

dominio = S.map fst conjunto

rango = S.map snd conjunto

total = dominio `S.union` rango

candidatos = rango `S.difference` dominio

candidato = S.findMin candidatos

noCandidatos = S.delete candidato total

esCelebridad =

S.filter (\x -> (x,candidato) `S.member` conjunto) total == noCandidatos

-- Comparación de eficiencia

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

-- λ> celebridad1 [(x,1) | x <- [2..300]]

-- Just 1

-- (2.70 secs, 38,763,888 bytes)

-- λ> celebridad2 [(x,1) | x <- [2..300]]

-- Just 1

-- (0.01 secs, 0 bytes)

-- λ> celebridad2 [(x,1000) | x <- [1..999]]

-- Just 1000

-- (2.23 secs, 483,704,224 bytes)

-- λ> celebridad3 [(x,1000) | x <- [1..999]]

-- Just 1000

-- (0.02 secs, 0 bytes)

-- λ> celebridad3 [(x,10^6) | x <- [1..10^6-1]]

-- Just 1000000

-- (9.56 secs, 1,572,841,088 bytes)

-- λ> celebridad3 [(x,1) | x <- [2..10^6]]

-- Just 1

-- (6.17 secs, 696,513,320 bytes)

Sucesión de Recamán

PorJosé A. Alonso 11-mayo-201826-marzo-2022

La sucesión de Recamán está definida como sigue:

   a(0) = 0
   a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión
   a(n) = a(n-1) + n, en caso contrario.

a(0) = 0

a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión

a(n) = a(n-1) + n, en caso contrario.

Definir las funciones

   sucRecaman :: [Int]
   invRecaman :: Int -> Int
   graficaSucRecaman :: Int -> IO ()
   graficaInvRecaman :: Int -> IO ()

sucRecaman :: [Int]

invRecaman :: Int -> Int

graficaSucRecaman :: Int -> IO ()

graficaInvRecaman :: Int -> IO ()

tales que

sucRecaman es la lista de los términos de la sucesión de Recamám. Por ejemplo,

      λ> take 25 sucRecaman3
      [0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]
      λ> sucRecaman !! 1000
      3686
      λ> sucRecaman !! 1000001
      1057163

λ> take 25 sucRecaman3

[0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]

λ> sucRecaman !! 1000

3686

λ> sucRecaman !! 1000001

1057163

(invRecaman n) es la primera posición de n en la sucesión de Recamán. Por ejemplo,

      invRecaman 10       ==  12
      invRecaman 3686     ==  1000
      invRecaman 1057163  ==  1000001

invRecaman 10 == 12

invRecaman 3686 == 1000

invRecaman 1057163 == 1000001

(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja

y (graficaInvRecaman 100) dibuja

Soluciones

import qualified Data.Set as S

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

sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
       | otherwise                   = y + n
  where y  = suc1 (n - 1)
        ys = [suc1 k | k <- [0..n - 1]]

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

sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
  where f y n ys | y > n && y - n `notElem` take n ys = y - n
                 | otherwise                          = y + n

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

sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
  | x > n && (x-n) `S.notMember` s =
    (x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
  | otherwise =
    (x+n):recaman (S.insert (x+n) s) (n+1) (x+n) 

-- Comparación de eficiencia:
--    λ> sucRecaman1 !! 25
--    17
--    (3.76 secs, 2,394,593,952 bytes)
--    λ> sucRecaman2 !! 25
--    17
--    (0.00 secs, 0 bytes)
--    λ> sucRecaman3 !! 25
--    17
--    (0.00 secs, 0 bytes)
--
--    λ> sucRecaman2 !! (2*10^4)
--    14358
--    (2.69 secs, 6,927,559,784 bytes)
--    λ> sucRecaman3 !! (2*10^4)
--    14358
--    (0.04 secs, 0 bytes)

-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
  length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
  plotList [Key Nothing]
           (take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
  plotList [Key Nothing]
           [invRecaman k | k <- [0..n]]

import qualified Data.Set as S

-- 1ª solución

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

sucRecaman1 :: [Int]

sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int

suc1 0 = 0

suc1 n | y > n && y - n `notElem` ys = y - n

| otherwise = y + n

where y = suc1 (n - 1)

ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución

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

sucRecaman2 :: [Int]

sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)

where f y n ys | y > n && y - n `notElem` take n ys = y - n

| otherwise = y + n

-- 3ª solución

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

sucRecaman3 :: [Int]

sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]

recaman s n x

| x > n && (x-n) `S.notMember` s =

(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)

| otherwise =

(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)

-- Comparación de eficiencia:

-- λ> sucRecaman1 !! 25

-- 17

-- (3.76 secs, 2,394,593,952 bytes)

-- λ> sucRecaman2 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman3 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman2 !! (2*10^4)

-- 14358

-- (2.69 secs, 6,927,559,784 bytes)

-- λ> sucRecaman3 !! (2*10^4)

-- 14358

-- (0.04 secs, 0 bytes)

-- Definición de invRecaman

invRecaman :: Int -> Int

invRecaman n =

length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()

graficaSucRecaman n =

plotList [Key Nothing]

(take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()

graficaInvRecaman n =

plotList [Key Nothing]

[invRecaman k | k <- [0..n]]

Problema de las jarras

PorJosé A. Alonso 10-mayo-201817-mayo-2018

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en alguna de las dos jarras.

Definir la función

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

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

tal (jarras (a,b,c)) es una solución del problema de las jarras (a,b,c) con el mínimo número de movimientos, si el problema tiene solución y Nothing, en caso contrario. Por ejemplo,

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

1 2	λ> jarras (5,3,4) Just [(0,0),(5,0),(2,3),(2,0),(0,2),(5,2),(4,3)]

La interpretación de la solución anterior es

   (0,0) se inicia con las dos jarras vacías,
   (5,0) se llena la jarra de 5 con el grifo,
   (2,3) se llena la de 3 con la de 5,
   (2,0) se vacía la de 3,
   (0,2) se pasa el contenido de la primera a la segunda,
   (5,2) se llena la primera con el grifo,
   (4,3) se llena la segunda con la primera.

(0,0) se inicia con las dos jarras vacías,

(5,0) se llena la jarra de 5 con el grifo,

(2,3) se llena la de 3 con la de 5,

(2,0) se vacía la de 3,

(0,2) se pasa el contenido de la primera a la segunda,

(5,2) se llena la primera con el grifo,

(4,3) se llena la segunda con la primera.

Otros ejemplos:

   λ> jarras (3,5,4)
   Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]
   λ> jarras (15,10,5)
   Just [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   Nothing
   λ> length <$> jarras (181,179,100)
   Just 199

λ> jarras (3,5,4)

Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]

λ> jarras (15,10,5)

Just [(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

Nothing

λ> length <$> jarras (181,179,100)

Just 199

Soluciones

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero es el número
-- de litros que hay que obtener.
type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la
-- jarra de A litros y el segundo el de la de B litros.  
type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]
jarras p | null ns   = Nothing
         | otherwise = Just (head ns)
  where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo, 
--    λ> take 2 (soluciones (15,10,5))
--    [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]
--    λ> length (soluciones (15,10,5))
--    6
--    λ> soluciones (15,10,4)
--    []
soluciones :: Problema -> [[Estado]]
soluciones p = busca [[inicial]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = (reverse (e:es)) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- inicial es el estado inicial
inicial :: Estado
inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- jarras p. Por ejemplo,
--    esFinal (5,4,3) (3,2)  ==  True
--    esFinal (5,4,3) (2,3)  ==  True
--    esFinal (5,4,1) (2,3)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por
-- ejemplo, 
--    λ> sucesores (7,4,3) (1,2)
--    [(7,2),(1,4),(0,2),(1,0),(3,0),(0,3)]
--    λ> sucesores (7,4,3) (6,3)
--    [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > a - x] ++
    [(x-(b-y),b) | y < b, x > b - y] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe
jarras2 :: Problema -> Maybe [Estado]
jarras2 p = listToMaybe (soluciones p)

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero es el número

-- de litros que hay que obtener.

type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la

-- jarra de A litros y el segundo el de la de B litros.

type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]

jarras p | null ns = Nothing

| otherwise = Just (head ns)

where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo,

-- λ> take 2 (soluciones (15,10,5))

-- [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]

-- λ> length (soluciones (15,10,5))

-- 6

-- λ> soluciones (15,10,4)

-- []

soluciones :: Problema -> [[Estado]]

soluciones p = busca [[inicial]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = (reverse (e:es)) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- inicial es el estado inicial

inicial :: Estado

inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- jarras p. Por ejemplo,

-- esFinal (5,4,3) (3,2) == True

-- esFinal (5,4,3) (2,3) == True

-- esFinal (5,4,1) (2,3) == False

esFinal :: Problema -> Estado -> Bool

esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por

-- ejemplo,

-- λ> sucesores (7,4,3) (1,2)

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

-- λ> sucesores (7,4,3) (6,3)

-- [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > a - x] ++

[(x-(b-y),b) | y < b, x > b - y] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe

jarras2 :: Problema -> Maybe [Estado]

jarras2 p = listToMaybe (soluciones p)

Las sucesiones de Loomis

PorJosé A. Alonso 30-abril-201825-abril-2021

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

λ> take 15 (sucLoomis 1)

[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 2)

[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 3)

[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 4)

[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]

λ> take 15 (sucLoomis 5)

[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 20)

[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]

λ> take 15 (sucLoomis 100)

[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]

λ> sucLoomis 1 !! (2*10^5)

235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

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

sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']

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

sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 

siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y

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

sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)


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

--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)

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

convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys

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

convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           

-- 4ª definición de convergencia
-- =============================

convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n

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

--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia
-- ==================================

graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

import Data.List ((\\))

import Data.Char (digitToInt)

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

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

[read [c] | c <- show x, c /= '0']

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

-- (2.45 secs, 987,955,944 bytes)

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

-- (2.26 secs, 979,543,328 bytes)

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

-- (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

where aux as@(x:xs) bs@(y:ys) | x == y = x

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

-- (interseccion xs ys) es la intersección entre las listas ordenadas xs

-- e ys. Por ejemplo,

-- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))

-- [2,4,8,16,22,26,38,62,74,102]

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

interseccion = aux

where aux as@(x:xs) bs@(y:ys) = case compare x y of

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

where perteneceA (y:ys) n | y == c = y

| otherwise = perteneceA ys c

where c = head $ dropWhile (< y) $ sucLoomis3 n

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

-- (2.94 secs, 1,260,809,808 bytes)

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

-- (0.03 secs, 1,165,496 bytes)

-- λ> convergencia4 (10^4)

-- 150056

-- (0.02 secs, 1,119,648 bytes)

-- λ> convergencia2 (10^12)

-- 1000101125092

-- (1.81 secs, 714,901,080 bytes)

-- λ> convergencia3 (10^12)

-- 1000101125092

-- (1.92 secs, 744,932,184 bytes)

-- λ> convergencia4 (10^12)

-- 1000101125092

-- (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

, XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))

, PNG "Las_sucesiones_de_Loomis_2.png"

]

[(x,convergencia2 x) | x <- xs]

Operaciones con series de potencias

PorJosé A. Alonso 27-abril-201825-marzo-2022

Una serie de potencias es una serie de la forma

   a₀ + a₁x + a₂x² + a₃x³ + ...

1	a₀ + a₁x + a₂x² + a₃x³ + ...

Las series de potencias se pueden representar mediante listas infinitas. Por ejemplo, la serie de la función exponencial es

   e^x = 1 + x + x²/2! + x³/3! + ...

1	e^x = 1 + x + x²/2! + x³/3! + ...

y se puede representar por [1, 1, 1/2, 1/6, 1/24, 1/120, …]

Las operaciones con series se pueden ver como una generalización de las de los polinomios.

En lo que sigue, usaremos el tipo (Serie a) para representar las series de potencias con coeficientes en a y su definición es

   type Serie a = [a]

1	type Serie a = [a]

Definir las siguientes funciones

   opuesta      :: Num a => Serie a -> Serie a
   suma         :: Num a => Serie a -> Serie a -> Serie a
   resta        :: Num a => Serie a -> Serie a -> Serie a
   producto     :: Num a => Serie a -> Serie a -> Serie a
   cociente     :: Fractional a => Serie a -> Serie a -> Serie a
   derivada     :: (Num a, Enum a) => Serie a -> Serie a
   integral     :: (Fractional a, Enum a) => Serie a -> Serie a
   expx         :: Serie Rational

opuesta :: Num a => Serie a -> Serie a

suma :: Num a => Serie a -> Serie a -> Serie a

resta :: Num a => Serie a -> Serie a -> Serie a

producto :: Num a => Serie a -> Serie a -> Serie a

cociente :: Fractional a => Serie a -> Serie a -> Serie a

derivada :: (Num a, Enum a) => Serie a -> Serie a

integral :: (Fractional a, Enum a) => Serie a -> Serie a

expx :: Serie Rational

tales que

(opuesta xs) es la opuesta de la serie xs. Por ejemplo,

     λ> take 7 (opuesta [-6,-4..])
     [6,4,2,0,-2,-4,-6]

1 2	λ> take 7 (opuesta [-6,-4..]) [6,4,2,0,-2,-4,-6]

(suma xs ys) es la suma de las series xs e ys. Por ejemplo,

     λ> take 7 (suma [1,3..] [2,4..])
     [3,7,11,15,19,23,27]

1 2	λ> take 7 (suma [1,3..] [2,4..]) [3,7,11,15,19,23,27]

(resta xs ys) es la resta de las series xs es ys. Por ejemplo,

     λ> take 7 (resta [3,5..] [2,4..])
     [1,1,1,1,1,1,1]
     λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])
     [2,4,6,8,10,12,14]

λ> take 7 (resta [3,5..] [2,4..])

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

λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])

[2,4,6,8,10,12,14]

(producto xs ys) es el producto de las series xs e ys. Por ejemplo,

     λ> take 7 (producto [3,5..] [2,4..])
     [6,22,52,100,170,266,392]

1 2	λ> take 7 (producto [3,5..] [2,4..]) [6,22,52,100,170,266,392]

(cociente xs ys) es el cociente de las series xs e ys. Por ejemplo,

     λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..])
     [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..]) [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

(derivada xs) es la derivada de la serie xs. Por ejemplo,

     λ> take 7 (derivada [2,4..])
     [4,12,24,40,60,84,112]

1 2	λ> take 7 (derivada [2,4..]) [4,12,24,40,60,84,112]

(integral xs) es la integral de la serie xs. Por ejemplo,

     λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0))
     [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0)) [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

expx es la serie de la función exponencial. Por ejemplo,

     λ> take 8 expx
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (derivada expx)
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (integral expx)
     [0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 expx

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (derivada expx)

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (integral expx)

[0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

Soluciones

type Serie a = [a] 

opuesta :: Num a => Serie a -> Serie a
opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a
suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a
resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a
producto (x:xs) zs@(y:ys) = 
    x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a
cociente (x:xs) (y:ys) = zs 
    where zs = x/y : map (/y) (resta xs (producto zs ys))  

derivada :: (Num a, Enum a) => Serie a -> Serie a
derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a
integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational
expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    take 7 factoriales  ==  [1,1,2,6,24,120,720]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

type Serie a = [a]

opuesta :: Num a => Serie a -> Serie a

opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a

suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a

resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a

producto (x:xs) zs@(y:ys) =

x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a

cociente (x:xs) (y:ys) = zs

where zs = x/y : map (/y) (resta xs (producto zs ys))

derivada :: (Num a, Enum a) => Serie a -> Serie a

derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a

integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational

expx = map (1/) (map fromIntegral factoriales)

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

-- take 7 factoriales == [1,1,2,6,24,120,720]

factoriales :: [Integer]

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

Subconjuntos con suma dada

PorJosé A. Alonso 25-abril-20182-mayo-2018

Sea S un conjunto finito de números enteros positivos y n un número natural. El problema consiste en calcular los subconjuntos de S cuya suma es n.

Definir la función

   subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

1	subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

tal que (subconjuntosSuma xs n) es la lista de los subconjuntos de xs cuya suma es n. Por ejemplo,

   λ> subconjuntosSuma [3,34,4,12,5,2] 9
   [[4,5],[3,4,2]]
   λ> subconjuntosSuma [3,34,4,12,5,2] 13
   []
   λ> length (subconjuntosSuma [1..100] (sum [1..100]))
   1

λ> subconjuntosSuma [3,34,4,12,5,2] 9

[[4,5],[3,4,2]]

λ> subconjuntosSuma [3,34,4,12,5,2] 13

[]

λ> length (subconjuntosSuma [1..100] (sum [1..100]))

Soluciones

import Data.Array
import qualified Data.Matrix as M
import Data.Maybe
import Data.List
import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]
subconjuntosSuma1 xs n =
  [ys | ys <- subsequences xs, sum ys == n]

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

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]
subconjuntosSuma2 _  0 = [[]]
subconjuntosSuma2 [] _ = []
subconjuntosSuma2 (x:xs) n
  | n < x     = subconjuntosSuma2 xs n
  | otherwise = subconjuntosSuma2 xs n ++
                [x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)
-- =========================================

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]
subconjuntosSuma3 xs n =
  map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la
-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,
--    λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)
--    [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
-- Con las cabeceras,
--            0    1     2  3     4       5     6       7  8       9 
--    []     [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--    [1]     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--    [1,3]   [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--    [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma3 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)
-- =========================================

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]
subconjuntosSuma4 xs = aux (sort xs)
  where aux _  0 = [[]]
        aux [] _ = []
        aux (y:ys) n
          | y > n     = []
          | otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)
-- ====================================

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]
subconjuntosSuma5 xs n =
  matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma5 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | v ! i > j = []
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

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

prop_subconjuntosSuma :: [Int] -> Int -> Bool
prop_subconjuntosSuma xs n =
  all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m
                                       , subconjuntosSuma4 ys m
                                       , subconjuntosSuma5 ys m ]
  where ys = map (\y -> 1 + abs y) xs 
        m  = abs n
        ordenado = sort . map sort
        igual xss yss = ordenado xss == ordenado yss

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

100

101

102

import Data.Array

import qualified Data.Matrix as M

import Data.Maybe

import Data.List

import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)

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

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]

subconjuntosSuma1 xs n =

[ys | ys <- subsequences xs, sum ys == n]

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

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

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]

subconjuntosSuma2 _ 0 = [[]]

subconjuntosSuma2 [] _ = []

subconjuntosSuma2 (x:xs) n

| n < x = subconjuntosSuma2 xs n

| otherwise = subconjuntosSuma2 xs n ++

[x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)

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

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]

subconjuntosSuma3 xs n =

map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la

-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,

-- λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)

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

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

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

-- [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

-- Con las cabeceras,

-- 0 1 2 3 4 5 6 7 8 9

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

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

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

-- [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma3 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | j < v ! i = q ! (i-1,j)

| otherwise = q ! (i-1,j) ++

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)

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

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]

subconjuntosSuma4 xs = aux (sort xs)

where aux _ 0 = [[]]

aux [] _ = []

aux (y:ys) n

| y > n = []

| otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)

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

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]

subconjuntosSuma5 xs n =

matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma5 xs n = q

where m = length xs

v = listArray (1,m) xs

q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | v ! i > j = []

| otherwise = q ! (i-1,j) ++

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- Equivalencia

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

prop_subconjuntosSuma :: [Int] -> Int -> Bool

prop_subconjuntosSuma xs n =

all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m

, subconjuntosSuma4 ys m

, subconjuntosSuma5 ys m ]

where ys = map (\y -> 1 + abs y) xs

m = abs n

ordenado = sort . map sort

igual xss yss = ordenado xss == ordenado yss

-- La comprobación es

-- λ> quickCheck prop_subconjuntosSuma

-- +++ OK, passed 100 tests.

Sumas de subconjuntos

PorJosé A. Alonso 24-abril-20181-mayo-2018

Definir la función

   sumasSubconjuntos :: Set Int -> Set Int

1	sumasSubconjuntos :: Set Int -> Set Int

tal que (sumasSubconjuntos xs) es el conjunto de las sumas de cada uno de los subconjuntos de xs. Por ejemplo,

   λ> sumasSubconjuntos (fromList [3,2,5])
   fromList [0,2,3,5,7,8,10]
   λ> length (sumasSubconjuntos (fromList [-40,-39..40]))
   1641

λ> sumasSubconjuntos (fromList [3,2,5])

fromList [0,2,3,5,7,8,10]

λ> length (sumasSubconjuntos (fromList [-40,-39..40]))

1641

Soluciones

import Data.List
import Data.Set ( Set
                , deleteFindMin
                , fromList
                , singleton
                , toList
                )
import qualified Data.Set as S

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

sumasSubconjuntos :: Set Int -> Set Int
sumasSubconjuntos xs =
  fromList (map sum (subsequences (toList xs))) 

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

sumasSubconjuntos2 :: Set Int -> Set Int
sumasSubconjuntos2 =
  fromList . sumasSubconjuntosL . toList  

sumasSubconjuntosL :: [Int] -> [Int]
sumasSubconjuntosL []     = [0]
sumasSubconjuntosL (x:xs) = ys `union` map (+x) ys
  where ys = sumasSubconjuntosL xs

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

sumasSubconjuntos3 :: Set Int -> Set Int
sumasSubconjuntos3 xs
  | S.null xs = singleton 0
  | otherwise = zs `S.union` (S.map (+y) zs)
  where (y,ys) = deleteFindMin xs
        zs     = sumasSubconjuntos2 ys

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

--    λ> length (sumasSubconjuntos (fromList [1..22]))
--    254
--    (4.17 secs, 4,574,495,128 bytes)
--    λ> length (sumasSubconjuntos2 (fromList [1..22]))
--    254
--    (0.03 secs, 5,583,200 bytes)
--    λ> length (sumasSubconjuntos3 (fromList [1..22]))
--    254
--    (0.03 secs, 5,461,064 bytes)
--
--    λ> length (sumasSubconjuntos2 (fromList [1..60]))
--    1831
--    (2.75 secs, 611,912,128 bytes)
--    λ> length (sumasSubconjuntos3 (fromList [1..60]))
--    1831
--    (2.81 secs, 610,476,992 bytes)

import Data.List

import Data.Set ( Set

, deleteFindMin

, fromList

, singleton

, toList

)

import qualified Data.Set as S

-- 1ª definición

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

sumasSubconjuntos :: Set Int -> Set Int

sumasSubconjuntos xs =

fromList (map sum (subsequences (toList xs)))

-- 2ª definición

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

sumasSubconjuntos2 :: Set Int -> Set Int

sumasSubconjuntos2 =

fromList . sumasSubconjuntosL . toList

sumasSubconjuntosL :: [Int] -> [Int]

sumasSubconjuntosL [] = [0]

sumasSubconjuntosL (x:xs) = ys `union` map (+x) ys

where ys = sumasSubconjuntosL xs

-- 3ª solución

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

sumasSubconjuntos3 :: Set Int -> Set Int

sumasSubconjuntos3 xs

| S.null xs = singleton 0

| otherwise = zs `S.union` (S.map (+y) zs)

where (y,ys) = deleteFindMin xs

zs = sumasSubconjuntos2 ys

-- Comparación de eficiencia

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

-- λ> length (sumasSubconjuntos (fromList [1..22]))

-- 254

-- (4.17 secs, 4,574,495,128 bytes)

-- λ> length (sumasSubconjuntos2 (fromList [1..22]))

-- 254

-- (0.03 secs, 5,583,200 bytes)

-- λ> length (sumasSubconjuntos3 (fromList [1..22]))

-- 254

-- (0.03 secs, 5,461,064 bytes)

-- λ> length (sumasSubconjuntos2 (fromList [1..60]))

-- 1831

-- (2.75 secs, 611,912,128 bytes)

-- λ> length (sumasSubconjuntos3 (fromList [1..60]))

-- 1831

-- (2.81 secs, 610,476,992 bytes)

Números compuestos por un conjunto de primos

PorJosé A. Alonso 20-abril-201830-abril-2018

Los números compuestos por un conjunto de primos son los números cuyos factores primos pertenecen al conjunto. Por ejemplo, los primeros números compuestos por [2,5,7] son

   1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

1	1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70,...

El 28 es compuesto ya que sus divisores primos son 2 y 7 que están en [2,5,7].

Definir la función

   compuestos :: [Integer] -> [Integer]

1	compuestos :: [Integer] -> [Integer]

tal que (compuesto ps) es la lista de los números compuestos por el conjunto de primos ps. Por ejemplo,

   λ> take 20 (compuestos [2,5,7])
   [1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]
   λ> take 20 (compuestos [2,5])
   [1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]
   λ> take 20 (compuestos [2,3,5])
   [1,2,3,4,5,6,8,9,10,12,15,16,18,20,24,25,27,30,32,36]
   λ> take 20 (compuestos [3,5,7,11,13])
   [1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]
   λ> take 15 (compuestos [2])
   [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]
   λ> compuestos [2,7] !! (10^4)
   57399514149595471961908157955229677377312712667508119466382354072731648
   λ> compuestos [2,3,5] !! (10^5)
   290237644800000000000000000000000000000

λ> take 20 (compuestos [2,5,7])

[1,2,4,5,7,8,10,14,16,20,25,28,32,35,40,49,50,56,64,70]

λ> take 20 (compuestos [2,5])

[1,2,4,5,8,10,16,20,25,32,40,50,64,80,100,125,128,160,200,250]

λ> take 20 (compuestos [2,3,5])

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

λ> take 20 (compuestos [3,5,7,11,13])

[1,3,5,7,9,11,13,15,21,25,27,33,35,39,45,49,55,63,65,75]

λ> take 15 (compuestos [2])

[1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384]

λ> compuestos [2,7] !! (10^4)

57399514149595471961908157955229677377312712667508119466382354072731648

λ> compuestos [2,3,5] !! (10^5)

290237644800000000000000000000000000000

Soluciones

import Data.Numbers.Primes (primeFactors)

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

compuestos1 :: [Integer] -> [Integer]
compuestos1 ps =
  [n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen
-- a ps. Por ejemplo, 
--    esCompuesto [2,3,7]    28  ==  True
--    esCompuesto [2,3,7]   140  ==  False
--    esCompuesto [2,3,5,7] 140  ==  True
esCompuesto :: [Integer] -> Integer -> Bool
esCompuesto ps n =
  subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs
-- pertenecen a ys. Por ejemplo, 
--    subconjunto [2,7,2] [7,5,2]  ==  True
--    subconjunto [2,7,3] [7,5,2]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem` ys) xs

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

compuestos2 :: [Integer] -> [Integer]
compuestos2 ps =
   1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de
-- ps por los números compuestos con ps. Por ejemplo,
--    λ> take 8 (compuestos4 [2,5,7])
--    [1,2,4,5,7,8,10,14]
--    λ> map (take 6) (combinaciones [2,5,7])
--    [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]
combinaciones :: [Integer] -> [[Integer]]
combinaciones ps =
  [[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo, 
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: [[Integer]] -> [Integer]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista
-- ordenadas xs e ys. Por ejemplo,  
mezcla :: [Integer] -> [Integer] -> [Integer]
mezcla []     ys              = ys
mezcla xs     []              = xs
mezcla us@(x:xs) vs@(y:ys) | x == y     = x : mezcla xs ys
                           | x < y      = x : mezcla xs vs
                           | otherwise  = y : mezcla us ys

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

compuestos3 :: [Integer] -> [Integer]
compuestos3 [] = [1]
compuestos3 (p:ps) =
  mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

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

compuestos4 :: [Integer] -> [Integer]
compuestos4 ps = foldl aux xs (tail ps)
  where p        = head ps
        xs       = [p^k | k <- [0..]]
        aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

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

compuestos5 :: [Integer] -> [Integer]
compuestos5 = foldl aux [1] 
  where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

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

compuestos6 :: [Integer] -> [Integer]
compuestos6 xs = aux
  where aux = 1 : mezclas xs aux
        mezclas []     _  = []
        mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

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

--    λ> compuestos1 [2,3,5] !! 300
--    84375
--    (5.85 secs, 2,961,101,088 bytes)
--    λ> compuestos2 [2,3,5] !! 300
--    84375
--    (3.54 secs, 311,137,952 bytes)
--    λ> compuestos2 [2,3,5] !! 400
--    312500
--    (13.01 secs, 1,229,801,184 bytes)
--    λ> compuestos3 [2,3,5] !! 400
--    312500
--    (0.02 secs, 2,066,152 bytes)
--    λ> compuestos3 [2,3,5] !! 20000
--    15441834907098675000000
--    (1.57 secs, 203,061,864 bytes)
--    λ> compuestos4 [2,3,5] !! 20000
--    15441834907098675000000
--    (0.40 secs, 53,335,080 bytes)
--    λ> compuestos4 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.25 secs, 170,058,496 bytes)
--    λ> compuestos5 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (1.26 secs, 170,104,648 bytes)
--    λ> compuestos6 [2,3,5] !! 50000
--    2379528690747474604574166220800
--    (0.26 secs, 40,490,280 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

compuestos1 :: [Integer] -> [Integer]

compuestos1 ps =

[n | n <- [1..], esCompuesto ps n]

-- (esCompuesto ps n) se verifica si los factores primos de n pertenecen

-- a ps. Por ejemplo,

-- esCompuesto [2,3,7] 28 == True

-- esCompuesto [2,3,7] 140 == False

-- esCompuesto [2,3,5,7] 140 == True

esCompuesto :: [Integer] -> Integer -> Bool

esCompuesto ps n =

subconjunto (primeFactors n) ps

-- (subconjunto xs ys) se verifica si todos los elementos de xs

-- pertenecen a ys. Por ejemplo,

-- subconjunto [2,7,2] [7,5,2] == True

-- subconjunto [2,7,3] [7,5,2] == False

subconjunto :: Eq a => [a] -> [a] -> Bool

subconjunto xs ys =

all (`elem` ys) xs

-- 2ª solución

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

compuestos2 :: [Integer] -> [Integer]

compuestos2 ps =

1 : mezclaTodas (combinaciones ps)

-- (combinaciones ps) es la lista de los productos de cada elemento de

-- ps por los números compuestos con ps. Por ejemplo,

-- λ> take 8 (compuestos4 [2,5,7])

-- [1,2,4,5,7,8,10,14]

-- λ> map (take 6) (combinaciones [2,5,7])

-- [[2,4,8,10,14,16],[5,10,20,25,35,40],[7,14,28,35,49,56]]

combinaciones :: [Integer] -> [[Integer]]

combinaciones ps =

[[p * q | q <- compuestos2 ps] | p <- ps]

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

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

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

mezclaTodas :: [[Integer]] -> [Integer]

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla, eliminando repetidos, de las lista

-- ordenadas xs e ys. Por ejemplo,

mezcla :: [Integer] -> [Integer] -> [Integer]

mezcla [] ys = ys

mezcla xs [] = xs

mezcla us@(x:xs) vs@(y:ys) | x == y = x : mezcla xs ys

| x < y = x : mezcla xs vs

| otherwise = y : mezcla us ys

-- 3ª solución

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

compuestos3 :: [Integer] -> [Integer]

compuestos3 [] = [1]

compuestos3 (p:ps) =

mezclaTodas [map (*y) (compuestos3 ps) | y <- [p^k | k <- [0..]]]

-- 4ª solución

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

compuestos4 :: [Integer] -> [Integer]

compuestos4 ps = foldl aux xs (tail ps)

where p = head ps

xs = [p^k | k <- [0..]]

aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 5ª solución

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

compuestos5 :: [Integer] -> [Integer]

compuestos5 = foldl aux [1]

where aux xs p = mezclaTodas [map (*y) xs | y <- [p^k | k <- [0..]]]

-- 6ª solución

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

compuestos6 :: [Integer] -> [Integer]

compuestos6 xs = aux

where aux = 1 : mezclas xs aux

mezclas [] _ = []

mezclas (x:xs) zs = mezcla (map (x*) zs) (mezclas xs zs)

-- Comparación de eficiencia

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

-- λ> compuestos1 [2,3,5] !! 300

-- 84375

-- (5.85 secs, 2,961,101,088 bytes)

-- λ> compuestos2 [2,3,5] !! 300

-- 84375

-- (3.54 secs, 311,137,952 bytes)

-- λ> compuestos2 [2,3,5] !! 400

-- 312500

-- (13.01 secs, 1,229,801,184 bytes)

-- λ> compuestos3 [2,3,5] !! 400

-- 312500

-- (0.02 secs, 2,066,152 bytes)

-- λ> compuestos3 [2,3,5] !! 20000

-- 15441834907098675000000

-- (1.57 secs, 203,061,864 bytes)

-- λ> compuestos4 [2,3,5] !! 20000

-- 15441834907098675000000

-- (0.40 secs, 53,335,080 bytes)

-- λ> compuestos4 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.25 secs, 170,058,496 bytes)

-- λ> compuestos5 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (1.26 secs, 170,104,648 bytes)

-- λ> compuestos6 [2,3,5] !! 50000

-- 2379528690747474604574166220800

-- (0.26 secs, 40,490,280 bytes)

Notas de evaluación acumulada

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

La evaluación acumulada, las notas se calculan recursivamente con la siguiente función

   N(1) = E(1)
   N(k) = máximo(E(k), 0.4*N(k-1)+0.6*E(k))

1 2	N(1) = E(1) N(k) = máximo(E(k), 0.4N(k-1)+0.6E(k))

donde E(k) es la nota del examen k. Por ejemplo, si las notas de los exámenes son [3,7,6,3] entonces las acumuladas son [3.0,7.0,6.4,4.4]

Las notas e los exámenes se encuentran en ficheros CSV con los valores separados por comas. Cada línea representa la nota de un alumno, el primer valor es el identificador del alumno y los restantes son sus notas. Por ejemplo, el contenido de examenes.csv es

   juaruigar,3,7,9,3
   evadialop,3,6,7,4
   carrodmes,0,9,8,7

juaruigar,3,7,9,3

evadialop,3,6,7,4

carrodmes,0,9,8,7

Definir las funciones

   acumuladas      :: [Double] -> [Double]
   notasAcumuladas :: FilePath -> FilePath -> IO ()

1 2	acumuladas :: [Double] -> [Double] notasAcumuladas :: FilePath -> FilePath -> IO ()

tales que

(acumuladas xs) es la lista de las notas acumuladas (redondeadas con un decimal) de los notas de los exámenes xs. Por ejemplo,

     acumuladas [2,5]      ==  [2.0,5.0]
     acumuladas [5,2]      ==  [5.0,3.2]
     acumuladas [3,7,6,3]  ==  [3.0,7.0,6.4,4.4]
     acumuladas [3,6,7,3]  ==  [3.0,6.0,7.0,4.6]

acumuladas [2,5] == [2.0,5.0]

acumuladas [5,2] == [5.0,3.2]

acumuladas [3,7,6,3] == [3.0,7.0,6.4,4.4]

acumuladas [3,6,7,3] == [3.0,6.0,7.0,4.6]

(notasAcumuladas f1 f2) que escriba en el fichero f2 las notas acumuladas correspondientes a las notas de los exámenes del fichero f1. Por ejemplo, al evaluar

     notasAcumuladas "examenes.csv" "acumuladas.csv"

1	notasAcumuladas "examenes.csv" "acumuladas.csv"

escribe en el fichero acumuladas.csv

     juaruigar,3.0,7.0,9.0,5.4
     evadialop,3.0,6.0,7.0,5.2
     carrodmes,0.0,9.0,8.4,7.6

juaruigar,3.0,7.0,9.0,5.4

evadialop,3.0,6.0,7.0,5.2

carrodmes,0.0,9.0,8.4,7.6

Soluciones

import Text.CSV
import Data.Either

-- Definicioń de acumuladas
-- ========================

acumuladas :: [Double] -> [Double]
acumuladas = reverse . aux . reverse
  where aux []     = []
        aux [x]    = [x]
        aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys 
          where (y:ys) = aux xs

--    conUnDecimal 7.26  ==  7.3
--    conUnDecimal 7.24  ==  7.2
conUnDecimal :: Double -> Double
conUnDecimal x = fromIntegral (round (10*x)) / 10

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

notasAcumuladas :: FilePath -> FilePath -> IO ()
notasAcumuladas f1 f2 = do
  cs <- readFile f1
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             . cadenaALista
                             )
                             (contenidoALineasDeNotas cs)))

--   λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n  \n"
--   ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]
contenidoALineasDeNotas :: String -> [String]
contenidoALineasDeNotas = filter esLineaDeNotas . lines
  where esLineaDeNotas = elem ','

--    cadenaALista "a,b c,d"            ==  ["a","b c","d"]
--    cadenaALista "juaruigar,3,7,6,3"  ==  ["juaruigar","3","7","6","3"]
cadenaALista :: String -> [String]
cadenaALista cs
  | tieneComas cs = d : cadenaALista ds
  | otherwise     = [cs]
  where (d,_:ds)   = span (/=',') cs
        tieneComas = elem ','

--    λ> listaANota ["juaruigar","3","7","6","3"]
--    ("juaruigar",[3.0,7.0,6.0,3.0])
listaANota :: [String] -> (String,[Double])
listaANota (x:xs) = (x,map read xs)

--   λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])
--   ("juaruigar",[3.0,7.0,6.4,4.4])
notaAAcumuladas :: (String,[Double]) -> (String,[Double])
notaAAcumuladas (x,xs) = (x, acumuladas xs)

--    λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])
--    "juaruigar,3.0,7.0,6.4,4.4"
acumuladaACadena :: (String,[Double]) -> String
acumuladaACadena (x,xs) =
  x ++ "," ++ tail (init (show xs))

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()
notasAcumuladas2 f1 f2 = do
  cs <- readFile f1
  let (Right csv) = parseCSV f1 cs
  let notas = [xs | xs <- csv, length xs > 1]
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             )
                             notas))

import Text.CSV

import Data.Either

-- Definicioń de acumuladas

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

acumuladas :: [Double] -> [Double]

acumuladas = reverse . aux . reverse

where aux [] = []

aux [x] = [x]

aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys

where (y:ys) = aux xs

-- conUnDecimal 7.26 == 7.3

-- conUnDecimal 7.24 == 7.2

conUnDecimal :: Double -> Double

conUnDecimal x = fromIntegral (round (10*x)) / 10

-- 1ª definición de notasAcumuladas

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

notasAcumuladas :: FilePath -> FilePath -> IO ()

notasAcumuladas f1 f2 = do

cs <- readFile f1

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

. cadenaALista

)

(contenidoALineasDeNotas cs)))

-- λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n \n"

-- ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]

contenidoALineasDeNotas :: String -> [String]

contenidoALineasDeNotas = filter esLineaDeNotas . lines

where esLineaDeNotas = elem ','

-- cadenaALista "a,b c,d" == ["a","b c","d"]

-- cadenaALista "juaruigar,3,7,6,3" == ["juaruigar","3","7","6","3"]

cadenaALista :: String -> [String]

cadenaALista cs

| tieneComas cs = d : cadenaALista ds

| otherwise = [cs]

where (d,_:ds) = span (/=',') cs

tieneComas = elem ','

-- λ> listaANota ["juaruigar","3","7","6","3"]

-- ("juaruigar",[3.0,7.0,6.0,3.0])

listaANota :: [String] -> (String,[Double])

listaANota (x:xs) = (x,map read xs)

-- λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])

-- ("juaruigar",[3.0,7.0,6.4,4.4])

notaAAcumuladas :: (String,[Double]) -> (String,[Double])

notaAAcumuladas (x,xs) = (x, acumuladas xs)

-- λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])

-- "juaruigar,3.0,7.0,6.4,4.4"

acumuladaACadena :: (String,[Double]) -> String

acumuladaACadena (x,xs) =

x ++ "," ++ tail (init (show xs))

-- 2ª definición de notasAcumuladas

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()

notasAcumuladas2 f1 f2 = do

cs <- readFile f1

let (Right csv) = parseCSV f1 cs

let notas = [xs | xs <- csv, length xs > 1]

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

)

notas))

Alturas primas

PorJosé A. Alonso 10-abril-201826-marzo-2022

Se considera una enumeración de los números primos:

    p(1)=2,  p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

1	p(1)=2, p(2)=3, p(3)=5, p(4)=7, p(5)=11, p(6)=13, p(7)=17,...

Dado un entero x > 1, su altura prima es el mayor i tal que el primo p(i) aparece en la factorización de x en números primos. Por ejemplo, la altura prima de 3500 tiene longitud 4, pues 3500=2^2×5^3×7^1 y la de 34 tiene es 7, pues 34 = 2×17. Además, se define la altura prima de 1 como 0.

Definir las funciones

   alturaPrima        :: Integer -> Integer
   alturasPrimas      :: Integer -> [Integer]
   graficaAlturaPrima :: Integer -> IO ()

alturaPrima :: Integer -> Integer

alturasPrimas :: Integer -> [Integer]

graficaAlturaPrima :: Integer -> IO ()

tales que

(alturaPrima x) es la altura prima de x. Por ejemplo,

     alturaPrima 3500  ==  4
     alturaPrima 34    ==  7

1 2	alturaPrima 3500 == 4 alturaPrima 34 == 7

(alturasPrimas n) es la lista de las altura prima de los primeros n números enteros positivos. Por ejemplo,

     alturasPrimas 15  ==  [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]
     maximum (alturasPrimas 10000)  ==  1229
     maximum (alturasPrimas 20000)  ==  2262
     maximum (alturasPrimas 30000)  ==  3245
     maximum (alturasPrimas 40000)  ==  4203

alturasPrimas 15 == [0,1,2,1,3,2,4,1,2,3,5,2,6,4,3]

maximum (alturasPrimas 10000) == 1229

maximum (alturasPrimas 20000) == 2262

maximum (alturasPrimas 30000) == 3245

maximum (alturasPrimas 40000) == 4203

(graficaAlturaPrima n) dibuja las alturas primas de los números entre 2 y n. Por ejemplo, (graficaAlturaPrima 500) dibuja

Soluciones

import Data.List (genericLength)
import Data.Numbers.Primes (isPrime, primes, primeFactors)
import Data.Array
import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima
-- ============================

alturaPrima :: Integer -> Integer
alturaPrima 1 = 0
alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,
--    mayorFactorPrimo 3500  ==  7
--    mayorFactorPrimo 34    ==  17
mayorFactorPrimo :: Integer -> Integer
mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números
-- primos. Por ejemplo,
--    indice 7   ==  4
--    indice 17  ==  7
indice :: Integer -> Integer
indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima
-- ============================

alturaPrima2 :: Integer -> Integer
alturaPrima2 n = v ! n
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer
indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus
-- índices. Por ejemplo,
--    λ> take 10 indicesPrimos
--    [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]
indicesPrimos :: [(Integer,Integer)]
indicesPrimos = zip primes [1..]

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

alturasPrimas :: Integer -> [Integer]
alturasPrimas n = map alturaPrima [1..n]

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

alturasPrimas2 :: Integer -> [Integer]
alturasPrimas2 n = elems v 
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        f 1 = 0
        f k | isPrime k = indice2 k
            | otherwise = v ! (k `div` (head (primeFactors k)))

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

--    λ> maximum (alturasPrimas 20000)
--    2262
--    (29.97 secs, 13,179,984,536 bytes)
--    λ> maximum (alturasPrimas2 20000)
--    2262
--    (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima
-- ================================

graficaAlturaPrima :: Integer -> IO ()
graficaAlturaPrima n =
  plotList [ Key Nothing
           , PNG "Alturas_primas.png"
           ]
           (alturasPrimas2 n)

import Data.List (genericLength)

import Data.Numbers.Primes (isPrime, primes, primeFactors)

import Data.Array

import Graphics.Gnuplot.Simple

-- 1ª definicioń de alturaPrima

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

alturaPrima :: Integer -> Integer

alturaPrima 1 = 0

alturaPrima n = indice (mayorFactorPrimo n)

-- (mayorFactorPrimo n) es el mayor factor primo de n. Por ejemplo,

-- mayorFactorPrimo 3500 == 7

-- mayorFactorPrimo 34 == 17

mayorFactorPrimo :: Integer -> Integer

mayorFactorPrimo = last . primeFactors

-- (indice p) es el índice de p en la sucesión de los números

-- primos. Por ejemplo,

-- indice 7 == 4

-- indice 17 == 7

indice :: Integer -> Integer

indice p = genericLength (takeWhile (<=p) primes)

-- 2ª definicioń de alturaPrima

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

alturaPrima2 :: Integer -> Integer

alturaPrima2 n = v ! n

where v = array (1,n) [(i,f i) | i <- [1..n]]

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

indice2 :: Integer -> Integer

indice2 p = head [n | (x,n) <- indicesPrimos, x == p]

-- indicesPrimos es la suceción formada por los números primos y sus

-- índices. Por ejemplo,

-- λ> take 10 indicesPrimos

-- [(2,1),(3,2),(5,3),(7,4),(11,5),(13,6),(17,7),(19,8),(23,9),(29,10)]

indicesPrimos :: [(Integer,Integer)]

indicesPrimos = zip primes [1..]

-- 1ª definición de alturasPrimas

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

alturasPrimas :: Integer -> [Integer]

alturasPrimas n = map alturaPrima [1..n]

-- 2ª definición de alturasPrimas

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

alturasPrimas2 :: Integer -> [Integer]

alturasPrimas2 n = elems v

where v = array (1,n) [(i,f i) | i <- [1..n]]

f 1 = 0

f k | isPrime k = indice2 k

| otherwise = v ! (k `div` (head (primeFactors k)))

-- Comparación de eficiencia

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

-- λ> maximum (alturasPrimas 20000)

-- 2262

-- (29.97 secs, 13,179,984,536 bytes)

-- λ> maximum (alturasPrimas2 20000)

-- 2262

-- (2.11 secs, 455,259,448 bytes)

-- Definición de graficaAlturaPrima

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

graficaAlturaPrima :: Integer -> IO ()

graficaAlturaPrima n =

plotList [ Key Nothing

, PNG "Alturas_primas.png"

]

(alturasPrimas2 n)

Sucesión de antecesores y sucesores

PorJosé A. Alonso 2-abril-20189-abril-2018

Definir la lista

   antecesoresYsucesores :: [[Integer]]

1	antecesoresYsucesores :: [[Integer]]

cuyos elementos son

   [[1],[0,2],[-1,1,1,3],[-2,2,0,0,2,0,2,2,4],...]

1	[[1],[0,2],[-1,1,1,3],[-2,2,0,0,2,0,2,2,4],...]

donde cada una de las listas se obtiene de la anterior sustituyendo cada elemento por su antecesor y su sucesor; es decir, el 1 por el 0 y el 2, el 0 por el -1 y el 1, el 2 por el 1 y el 3, etc. Por ejemplo,

   λ> take 4 antecesoresYsucesores
   [[1],[0,2],[-1,1,1,3],[-2,0,0,2,0,2,2,4]]

1 2	λ> take 4 antecesoresYsucesores [[1],[0,2],[-1,1,1,3],[-2,0,0,2,0,2,2,4]]

Comprobar con Quickcheck que la suma de los elementos de la lista n-ésima de antecesoresYsucesores es 2^n.

Nota. Limitar la búsqueda a ejemplos pequeños usando

   quickCheckWith (stdArgs {maxSize=7}) prop_suma

1	quickCheckWith (stdArgs {maxSize=7}) prop_suma

Soluciones

import Test.QuickCheck

-- 1ª solución
antecesoresYsucesores :: [[Integer]]       
antecesoresYsucesores = 
  [1] : map (concatMap (\x -> [x-1,x+1])) antecesoresYsucesores

-- 2ª solución
antecesoresYsucesores2 :: [[Integer]]       
antecesoresYsucesores2 = 
  iterate (concatMap (\x -> [x-1,x+1])) [1]

-- La propiedad es
prop_suma :: (Positive Int) -> Bool
prop_suma (Positive n) =
  sum (antecesoresYsucesores2 !! n) == 2^n

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

import Test.QuickCheck

-- 1ª solución

antecesoresYsucesores :: [[Integer]]

antecesoresYsucesores =

[1] : map (concatMap (\x -> [x-1,x+1])) antecesoresYsucesores

-- 2ª solución

antecesoresYsucesores2 :: [[Integer]]

antecesoresYsucesores2 =

iterate (concatMap (\x -> [x-1,x+1])) [1]

-- La propiedad es

prop_suma :: (Positive Int) -> Bool

prop_suma (Positive n) =

sum (antecesoresYsucesores2 !! n) == 2^n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_suma

-- +++ OK, passed 100 tests.

Árbol de subconjuntos

PorJosé A. Alonso 30-marzo-20187-abril-2018

Definir las siguientes funciones

   arbolSubconjuntos       :: [a] -> Tree [a]
   nNodosArbolSubconjuntos :: Integer -> Integer
   sumaNNodos              :: Integer -> Integer

arbolSubconjuntos :: [a] -> Tree [a]

nNodosArbolSubconjuntos :: Integer -> Integer

sumaNNodos :: Integer -> Integer

tales que

(arbolSubconjuntos xs) es el árbol de los subconjuntos de xs. Por ejemplo.

     λ> putStrLn (drawTree (arbolSubconjuntos "abc"))
     abc
     |
     +- bc
     |  |
     |  +- c
     |  |
     |  `- b
     |
     +- ac
     |  |
     |  +- c
     |  |
     |  `- a
     |
     `- ab
        |
        +- b
        |
        `- a

λ> putStrLn (drawTree (arbolSubconjuntos "abc"))

abc

+- bc

| |

| +- c

| |

| `- b

+- ac

| |

| +- c

| |

| `- a

`- ab

+- b

`- a

(nNodosArbolSubconjuntos xs) es el número de nodos del árbol de xs. Por ejemplo

     nNodosArbolSubconjuntos "abc"  ==  10
     nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960

1 2	nNodosArbolSubconjuntos "abc" == 10 nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960

(sumaNNodos n) es la suma del número de nodos de los árboles de los subconjuntos de [1..k] para 1 <= k <= n. Por ejemplo,

     λ> sumaNNodos 3  ==  14
     sumaNNodos (4*10^4) `mod` (7+10^9)  ==  249479844

1 2	λ> sumaNNodos 3 == 14 sumaNNodos (4*10^4) `mod` (7+10^9) == 249479844

Soluciones

import Data.List (genericLength, genericTake)
import Data.Tree (Tree (Node))

-- Definición de arbolSubconjuntos
-- ===============================

arbolSubconjuntos :: [a] -> Tree [a]
arbolSubconjuntos [x] = Node [x] []
arbolSubconjuntos xs =
  Node xs (map arbolSubconjuntos (sinUno xs))

-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por
-- ejemplo, 
--    sinUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
sinUno :: [a] -> [[a]]
sinUno xs =
  [ys ++ zs | n <- [0..length xs - 1]
            , let (ys,_:zs) = splitAt n xs]       

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

nNodosArbolSubconjuntos :: [a] -> Integer
nNodosArbolSubconjuntos =
  fromIntegral . length . arbolSubconjuntos 

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

nNodosArbolSubconjuntos2 :: [a] -> Integer
nNodosArbolSubconjuntos2 = aux . genericLength
  where aux 1 = 1
        aux n = 1 + n * aux (n-1)

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

nNodosArbolSubconjuntos3 :: [a] -> Integer
nNodosArbolSubconjuntos3 xs =
  sucNNodos !! (n-1)
  where n = length xs

-- sucNNodos es la sucesión de los números de nodos de los árboles de
-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.
--    λ> take 10 sucNNodos
--    [1,3,10,41,206,1237,8660,69281,623530,6235301]
sucNNodos :: [Integer]
sucNNodos =
  1 : map (+ 1) (zipWith (*) [2..] sucNNodos)

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

--    λ> nNodosArbolSubconjuntos 10
--    6235301
--    (9.66 secs, 5,491,704,944 bytes)
--    λ> nNodosArbolSubconjuntos2 10
--    6235301
--    (0.00 secs, 145,976 bytes)
--
--    λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))
--    166714
--    (1.07 secs, 2,952,675,472 bytes)
--    λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))
--    166714
--    (1.53 secs, 2,959,020,680 bytes)

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

sumaNNodos :: Integer -> Integer
sumaNNodos n =
  sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]

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

sumaNNodos2 :: Integer -> Integer
sumaNNodos2 n =
  sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]

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

sumaNNodos3 :: Integer -> Integer
sumaNNodos3 n =
  sum (genericTake n sucNNodos)

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

--    λ> sumaNNodos 10 `mod` (7+10^9)
--    6938270
--    (16.00 secs, 9,552,410,688 bytes)
--    λ> sumaNNodos2 10 `mod` (7+10^9)
--    6938270
--    (0.00 secs, 177,632 bytes)
-- 
--    λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)
--    851467820
--    (2.62 secs, 4,622,117,976 bytes)
--    λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)
--    851467820
--    (0.01 secs, 8,645,336 bytes)

100

101

102

103

104

import Data.List (genericLength, genericTake)

import Data.Tree (Tree (Node))

-- Definición de arbolSubconjuntos

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

arbolSubconjuntos :: [a] -> Tree [a]

arbolSubconjuntos [x] = Node [x] []

arbolSubconjuntos xs =

Node xs (map arbolSubconjuntos (sinUno xs))

-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por

-- ejemplo,

-- sinUno "abcde" == ["bcde","acde","abde","abce","abcd"]

sinUno :: [a] -> [[a]]

sinUno xs =

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

, let (ys,_:zs) = splitAt n xs]

-- 1ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos :: [a] -> Integer

nNodosArbolSubconjuntos =

fromIntegral . length . arbolSubconjuntos

-- 2ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos2 :: [a] -> Integer

nNodosArbolSubconjuntos2 = aux . genericLength

where aux 1 = 1

aux n = 1 + n * aux (n-1)

-- 3ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos3 :: [a] -> Integer

nNodosArbolSubconjuntos3 xs =

sucNNodos !! (n-1)

where n = length xs

-- sucNNodos es la sucesión de los números de nodos de los árboles de

-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.

-- λ> take 10 sucNNodos

-- [1,3,10,41,206,1237,8660,69281,623530,6235301]

sucNNodos :: [Integer]

sucNNodos =

1 : map (+ 1) (zipWith (*) [2..] sucNNodos)

-- Comparación de eficiencia de nNodosArbolSubconjuntos

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

-- λ> nNodosArbolSubconjuntos 10

-- 6235301

-- (9.66 secs, 5,491,704,944 bytes)

-- λ> nNodosArbolSubconjuntos2 10

-- 6235301

-- (0.00 secs, 145,976 bytes)

-- λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))

-- 166714

-- (1.07 secs, 2,952,675,472 bytes)

-- λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))

-- 166714

-- (1.53 secs, 2,959,020,680 bytes)

-- 1ª definición de sumaNNodos

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

sumaNNodos :: Integer -> Integer

sumaNNodos n =

sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]

-- 2ª definición de sumaNNodos

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

sumaNNodos2 :: Integer -> Integer

sumaNNodos2 n =

sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]

-- 3ª definición de sumaNNodos

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

sumaNNodos3 :: Integer -> Integer

sumaNNodos3 n =

sum (genericTake n sucNNodos)

-- Comparación de eficiencia de sumaNNodos

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

-- λ> sumaNNodos 10 `mod` (7+10^9)

-- 6938270

-- (16.00 secs, 9,552,410,688 bytes)

-- λ> sumaNNodos2 10 `mod` (7+10^9)

-- 6938270

-- (0.00 secs, 177,632 bytes)

-- λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)

-- 851467820

-- (2.62 secs, 4,622,117,976 bytes)

-- λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)

-- 851467820

-- (0.01 secs, 8,645,336 bytes)

Números tetranacci

PorJosé A. Alonso 27-marzo-201826-marzo-2022

Los números tetranacci son una generalización de los números de Fibonacci definidos por

   T(0) = 0,
   T(1) = 1,
   T(2) = 1,
   T(3) = 2, 
   T(n) = T(n-1) + T(n-2) + T(n-3) + T(n-4), para n > 3.

T(0) = 0,

T(1) = 1,

T(2) = 1,

T(3) = 2,

T(n) = T(n-1) + T(n-2) + T(n-3) + T(n-4), para n > 3.

Los primeros números tetranacci son

   0, 1, 1, 2, 4, 8, 15, 29, 56, 108, 208

1	0, 1, 1, 2, 4, 8, 15, 29, 56, 108, 208

Definir las funciones

   tetranacci        :: Int -> Integer
   graficaTetranacci :: Int -> IO ()

1 2	tetranacci :: Int -> Integer graficaTetranacci :: Int -> IO ()

tales que

(tetranacci n) es el n-ésimo número tetranacci. Por ejemplo,

     λ> tetranacci 10
     208
     λ> map tetranacci [0..10]
     [0,1,1,2,4,8,15,29,56,108,208]
     λ> length (show (tetranacci5 (10^5)))
     28501

λ> tetranacci 10

208

λ> map tetranacci [0..10]

[0,1,1,2,4,8,15,29,56,108,208]

λ> length (show (tetranacci5 (10^5)))

28501

(graficaTetranacci n) dibuja la gráfica de los cocientes de n primeros pares de número tetranacci. Por ejemplo, (graficaTetranacci 300) dibuja

Soluciones

import Data.List (zipWith4)
import Data.Array
import Graphics.Gnuplot.Simple

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

tetranacci :: Int -> Integer
tetranacci 0 = 0
tetranacci 1 = 1
tetranacci 2 = 1
tetranacci 3 = 2
tetranacci n =
  tetranacci (n-1) + tetranacci (n-2) + tetranacci (n-3) + tetranacci (n-4) 

-- 2ª solución (programación dinámica con zipWith4)
-- ================================================

tetranacci2 :: Int -> Integer
tetranacci2 n = tetranaccis2 !! n

tetranaccis2 :: [Integer]
tetranaccis2 = 
    0 : 1 : 1 : 2 : zipWith4 f (r 0) (r 1) (r 2) (r 3)
    where f a b c d = a+b+c+d
          r n       = drop n tetranaccis2

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

tetranacci3 :: Int -> Integer
tetranacci3 n = tetranaccis3 !! n

tetranaccis3 :: [Integer]
tetranaccis3 = p (0, 1, 1, 2)
    where p (a, b, c, d) = a : p (b, c, d, a + b + c + d)

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

tetranacci4 :: Int -> Integer
tetranacci4 n = tetranaccis4 !! n

tetranaccis4 :: [Integer]
tetranaccis4 = 0 : 1 : 1 : 2 : p tetranaccis4
   where p (a:b:c:d:xs) = (a+b+c+d): p (b:c:d:xs)

-- 5ª solución (programación dinámica con vectores)
-- ================================================

tetranacci5 :: Int -> Integer
tetranacci5 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 0
  f 1 = 1
  f 2 = 1
  f 3 = 2
  f k = v!(k-1) + v!(k-2) + v!(k-3) + v!(k-4) 

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

--    λ> tetranacci 26
--    7555935
--    (3.04 secs, 1,649,520,064 bytes)
--    λ> tetranacci2 26
--    7555935
--    (0.00 secs, 148,064 bytes)
-- 
--    λ> length (show (tetranacci2 (10^5)))
--    28501
--    (1.22 secs, 1,844,457,288 bytes)
--    λ> length (show (tetranacci3 (10^5)))
--    28501
--    (0.88 secs, 1,860,453,968 bytes)
--    λ> length (show (tetranacci4 (10^5)))
--    28501
--    (0.77 secs, 1,882,852,168 bytes)
--    λ> length (show (tetranacci5 (10^5)))
--    28501
--    (0.72 secs, 1,905,707,408 bytes)

-- Gráfica
-- =======

graficaTetranacci :: Int -> IO ()
graficaTetranacci n =
  plotList [ Key Nothing
           , Title "Tasa de crecimiento de los numeros tetranacci"
           , PNG ("Numeros_tetranacci_" ++ show n ++ ".png")
           ]
           (take n (zipWith (/) (tail xs) xs))
  where xs = (map fromIntegral tetranaccis4) :: [Double]

import Data.List (zipWith4)

import Data.Array

import Graphics.Gnuplot.Simple

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

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

tetranacci :: Int -> Integer

tetranacci 0 = 0

tetranacci 1 = 1

tetranacci 2 = 1

tetranacci 3 = 2

tetranacci n =

tetranacci (n-1) + tetranacci (n-2) + tetranacci (n-3) + tetranacci (n-4)

-- 2ª solución (programación dinámica con zipWith4)

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

tetranacci2 :: Int -> Integer

tetranacci2 n = tetranaccis2 !! n

tetranaccis2 :: [Integer]

tetranaccis2 =

0 : 1 : 1 : 2 : zipWith4 f (r 0) (r 1) (r 2) (r 3)

where f a b c d = a+b+c+d

r n = drop n tetranaccis2

-- 3ª solución (con acumuladores)

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

tetranacci3 :: Int -> Integer

tetranacci3 n = tetranaccis3 !! n

tetranaccis3 :: [Integer]

tetranaccis3 = p (0, 1, 1, 2)

where p (a, b, c, d) = a : p (b, c, d, a + b + c + d)

-- 4ª solución

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

tetranacci4 :: Int -> Integer

tetranacci4 n = tetranaccis4 !! n

tetranaccis4 :: [Integer]

tetranaccis4 = 0 : 1 : 1 : 2 : p tetranaccis4

where p (a:b:c:d:xs) = (a+b+c+d): p (b:c:d:xs)

-- 5ª solución (programación dinámica con vectores)

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

tetranacci5 :: Int -> Integer

tetranacci5 n = v ! n where

v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 0

f 1 = 1

f 2 = 1

f 3 = 2

f k = v!(k-1) + v!(k-2) + v!(k-3) + v!(k-4)

-- Comparación de eficiencia

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

-- λ> tetranacci 26

-- 7555935

-- (3.04 secs, 1,649,520,064 bytes)

-- λ> tetranacci2 26

-- 7555935

-- (0.00 secs, 148,064 bytes)

-- λ> length (show (tetranacci2 (10^5)))

-- 28501

-- (1.22 secs, 1,844,457,288 bytes)

-- λ> length (show (tetranacci3 (10^5)))

-- 28501

-- (0.88 secs, 1,860,453,968 bytes)

-- λ> length (show (tetranacci4 (10^5)))

-- 28501

-- (0.77 secs, 1,882,852,168 bytes)

-- λ> length (show (tetranacci5 (10^5)))

-- 28501

-- (0.72 secs, 1,905,707,408 bytes)

-- Gráfica

-- =======

graficaTetranacci :: Int -> IO ()

graficaTetranacci n =

plotList [ Key Nothing

, Title "Tasa de crecimiento de los numeros tetranacci"

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

]

(take n (zipWith (/) (tail xs) xs))

where xs = (map fromIntegral tetranaccis4) :: [Double]

Máxima longitud de sublistas crecientes

PorJosé A. Alonso 23-marzo-201825-abril-2021

Definir la función

   longitudMayorSublistaCreciente :: Ord a => [a] -> Int

1	longitudMayorSublistaCreciente :: Ord a => [a] -> Int

tal que (longitudMayorSublistaCreciente xs) es la el máximo de las longitudes de las sublistas crecientes de xs. Por ejemplo,

   λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]
   3
   λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]
   6
   λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   6
   λ> longitudMayorSublistaCreciente [1..2000]
   2000
   λ> longitudMayorSublistaCreciente [2000,1999..1]
   1
   λ> import System.Random
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> longitudMayorSublistaCreciente xs
   61

λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]

λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]

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

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

λ> import System.Random

λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

λ> longitudMayorSublistaCreciente xs

Soluciones

import Data.List  (nub, sort)
import Data.Array (Array, (!), array, elems, listArray)

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

longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente1 =
  length . head . mayoresCrecientes

-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs
-- de mayor longitud. Por ejemplo, 
--    λ> mayoresCrecientes [3,2,6,4,5,1]
--    [[3,4,5],[2,4,5]]
--    λ> mayoresCrecientes [3,2,3,2,3,1]
--    [[2,3],[2,3],[2,3]]
--    λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
--    [[10,22,33,50,60,80],[10,22,33,41,60,80]]
--    λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
--    [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
mayoresCrecientes :: Ord a => [a] -> [[a]]
mayoresCrecientes xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes []  = [[]]
sublistasCrecientes (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes xs

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

longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente2 xs =
  longitudSCM xs (sort (nub xs))
  
-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e
-- ys. Por ejemplo, 
--   longitudSCM "amapola" "matamoscas" == 4
--   longitudSCM "atamos" "matamoscas"  == 6
--   longitudSCM "aaa" "bbbb"           == 0
longitudSCM :: Eq a => [a] -> [a] -> Int
longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)
  where n = length xs
        m = length ys

-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n
-- y m son los números de elementos de xs e ys, respectivamente) tal que
-- el valor en la posición (i,j) es la longitud de la SCM de los i
-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,
--    λ> elems (matrizLongitudSCM "amapola" "matamoscas")
--    [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,
--     0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,
--     0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]
-- Gráficamente,
--       m a t a m o s c a s
--    [0,0,0,0,0,0,0,0,0,0,0,
-- a   0,0,1,1,1,1,1,1,1,1,1,
-- m   0,1,1,1,1,2,2,2,2,2,2,
-- a   0,1,2,2,2,2,2,2,2,3,3,
-- p   0,1,2,2,2,2,2,2,2,3,3,
-- o   0,1,2,2,2,2,3,3,3,3,3,
-- l   0,1,2,2,2,2,3,3,3,3,3,
-- a   0,1,2,2,3,3,3,3,3,4,4]
matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int
matrizLongitudSCM xs ys = q
  where
    n = length xs
    m = length ys
    v = listArray (1,n) xs
    w = listArray (1,m) ys
    q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
      where f 0 _ = 0
            f _ 0 = 0
            f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)
                  | otherwise      = max (q ! (i-1,j)) (q ! (i,j-1))
  
-- 3ª solución
-- ===========

longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente3 xs =
  maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n
-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud
-- de la sucesión más larga que termina en el elemento i-ésimo de
-- xs. Por ejemplo,  
--    λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]
--    array (1,6) [(1,1),(2,1),(3,2),(4,2),(5,3),(6,1)]
vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int
vectorlongitudMayorSublistaCreciente xs = v
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        n = length xs
        w = listArray (1,n) xs
        f 1 = 1
        f i | null ls   = 1
            | otherwise = 1 + maximum ls
          where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]

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

--    λ> longitudMayorSublistaCreciente1 [1..20]
--    20
--    (4.60 secs, 597,014,240 bytes)
--    λ> longitudMayorSublistaCreciente2 [1..20]
--    20
--    (0.03 secs, 361,384 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..20]
--    20
--    (0.03 secs, 253,944 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 [1..2000]
--    2000
--    (8.00 secs, 1,796,495,488 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..2000]
--    2000
--    (5.12 secs, 1,137,667,496 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 [1000,999..1]
--    1
--    (0.95 secs, 97,029,328 bytes)
--    λ> longitudMayorSublistaCreciente2 [1000,999..1]
--    1
--    (7.48 secs, 1,540,857,208 bytes)
--    λ> longitudMayorSublistaCreciente3 [1000,999..1]
--    1
--    (0.86 secs, 160,859,128 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 (show (2^300))
--    10
--    (7.90 secs, 887,495,368 bytes)
--    λ> longitudMayorSublistaCreciente2 (show (2^300))
--    10
--    (0.04 secs, 899,152 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^300))
--    10
--    (0.04 secs, 1,907,936 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 (show (2^6000))
--    10
--    (0.06 secs, 9,950,592 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^6000))
--    10
--    (3.46 secs, 686,929,744 bytes)
--    
--    λ> import System.Random
--    (0.00 secs, 0 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.02 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    61
--    (7.73 secs, 1,538,771,392 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    61
--    (1.04 secs, 212,538,648 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.03 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    57
--    (7.56 secs, 1,538,573,680 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    57
--    (1.05 secs, 212,293,984 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

import Data.List (nub, sort)

import Data.Array (Array, (!), array, elems, listArray)

-- 1ª solución

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

longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int

longitudMayorSublistaCreciente1 =

length . head . mayoresCrecientes

-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs

-- de mayor longitud. Por ejemplo,

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

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

-- λ> mayoresCrecientes [3,2,3,2,3,1]

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

-- λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]

-- [[10,22,33,50,60,80],[10,22,33,41,60,80]]

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

-- [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]

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

mayoresCrecientes xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

-- (sublistasCrecientes xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes [3,2,5]

-- [[3,5],[3],[2,5],[2],[5],[]]

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

sublistasCrecientes [] = [[]]

sublistasCrecientes (x:xs) =

[x:ys | ys <- yss, null ys || x < head ys] ++ yss

where yss = sublistasCrecientes xs

-- 2ª solución

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

longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int

longitudMayorSublistaCreciente2 xs =

longitudSCM xs (sort (nub xs))

-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e

-- ys. Por ejemplo,

-- longitudSCM "amapola" "matamoscas" == 4

-- longitudSCM "atamos" "matamoscas" == 6

-- longitudSCM "aaa" "bbbb" == 0

longitudSCM :: Eq a => [a] -> [a] -> Int

longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)

where n = length xs

m = length ys

-- (matrizLongitudSCM xs ys) es la matriz de orden (n+1)x(m+1) (donde n

-- y m son los números de elementos de xs e ys, respectivamente) tal que

-- el valor en la posición (i,j) es la longitud de la SCM de los i

-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,

-- λ> elems (matrizLongitudSCM "amapola" "matamoscas")

-- [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,

-- 0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,

-- 0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]

-- Gráficamente,

-- m a t a m o s c a s

-- [0,0,0,0,0,0,0,0,0,0,0,

-- a 0,0,1,1,1,1,1,1,1,1,1,

-- m 0,1,1,1,1,2,2,2,2,2,2,

-- a 0,1,2,2,2,2,2,2,2,3,3,

-- p 0,1,2,2,2,2,2,2,2,3,3,

-- o 0,1,2,2,2,2,3,3,3,3,3,

-- l 0,1,2,2,2,2,3,3,3,3,3,

-- a 0,1,2,2,3,3,3,3,3,4,4]

matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int

matrizLongitudSCM xs ys = q

where

n = length xs

m = length ys

v = listArray (1,n) xs

w = listArray (1,m) ys

q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]

where f 0 _ = 0

f _ 0 = 0

f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)

| otherwise = max (q ! (i-1,j)) (q ! (i,j-1))

-- 3ª solución

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

longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int

longitudMayorSublistaCreciente3 xs =

maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n

-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud

-- de la sucesión más larga que termina en el elemento i-ésimo de

-- xs. Por ejemplo,

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

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

vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int

vectorlongitudMayorSublistaCreciente xs = v

where v = array (1,n) [(i,f i) | i <- [1..n]]

n = length xs

w = listArray (1,n) xs

f 1 = 1

f i | null ls = 1

| otherwise = 1 + maximum ls

where ls = [v ! j | j <-[1..i-1], w ! j < w ! i]

-- Comparación de eficiencia

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

-- λ> longitudMayorSublistaCreciente1 [1..20]

-- 20

-- (4.60 secs, 597,014,240 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..20]

-- 20

-- (0.03 secs, 361,384 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..20]

-- 20

-- (0.03 secs, 253,944 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..2000]

-- 2000

-- (8.00 secs, 1,796,495,488 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..2000]

-- 2000

-- (5.12 secs, 1,137,667,496 bytes)

-- λ> longitudMayorSublistaCreciente1 [1000,999..1]

-- 1

-- (0.95 secs, 97,029,328 bytes)

-- λ> longitudMayorSublistaCreciente2 [1000,999..1]

-- 1

-- (7.48 secs, 1,540,857,208 bytes)

-- λ> longitudMayorSublistaCreciente3 [1000,999..1]

-- 1

-- (0.86 secs, 160,859,128 bytes)

-- λ> longitudMayorSublistaCreciente1 (show (2^300))

-- 10

-- (7.90 secs, 887,495,368 bytes)

-- λ> longitudMayorSublistaCreciente2 (show (2^300))

-- 10

-- (0.04 secs, 899,152 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^300))

-- 10

-- (0.04 secs, 1,907,936 bytes)

-- λ> longitudMayorSublistaCreciente2 (show (2^6000))

-- 10

-- (0.06 secs, 9,950,592 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^6000))

-- 10

-- (3.46 secs, 686,929,744 bytes)

-- λ> import System.Random

-- (0.00 secs, 0 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.02 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 61

-- (7.73 secs, 1,538,771,392 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 61

-- (1.04 secs, 212,538,648 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.03 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 57

-- (7.56 secs, 1,538,573,680 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 57

-- (1.05 secs, 212,293,984 bytes)

Mayores sublistas crecientes

PorJosé A. Alonso 22-marzo-201830-marzo-2018

Definir la función

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

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

tal que (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs de mayor longitud. Por ejemplo,

   λ> mayoresCrecientes [3,2,6,4,5,1]
   [[3,4,5],[2,4,5]]
   λ> mayoresCrecientes [3,2,3,2,3,1]
   [[2,3],[2,3],[2,3]]
   λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
   [[10,22,33,50,60,80],[10,22,33,41,60,80]]
   λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
   λ> length (head (mayoresCrecientes (show (2^300))))
   10

λ> mayoresCrecientes [3,2,6,4,5,1]

[[3,4,5],[2,4,5]]

λ> mayoresCrecientes [3,2,3,2,3,1]

[[2,3],[2,3],[2,3]]

λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]

[[10,22,33,50,60,80],[10,22,33,41,60,80]]

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

[[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]

λ> length (head (mayoresCrecientes (show (2^300))))

Soluciones

import Data.List (subsequences)

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

mayoresCrecientes1 :: Ord a => [a] -> [[a]]
mayoresCrecientes1 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[],[3],[2],[5],[3,5],[2,5]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes xs =
  [ys | ys <- subsequences xs
      , esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por
-- ejemplo,  
--    esCreciente [2,3,5]  ==  True
--    esCreciente [2,3,1]  ==  False
--    esCreciente [2,3,3]  ==  False
esCreciente :: Ord a => [a] -> Bool
esCreciente (x:y:zs) = x < y && esCreciente (y:zs)
esCreciente _        = True

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

mayoresCrecientes2 :: Ord a => [a] -> [[a]]
mayoresCrecientes2 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes2 xs
        m   = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes2 [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes2 :: Ord a => [a] -> [[a]]
sublistasCrecientes2 []  = [[]]
sublistasCrecientes2 (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes2 xs

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

--    λ> length (head (mayoresCrecientes1 (show (2^70))))
--    5
--    (10.93 secs, 1,958,822,896 bytes)
--    λ> length (head (mayoresCrecientes2 (show (2^70))))
--    5
--    (0.02 secs, 0 bytes)

import Data.List (subsequences)

-- 1ª solución

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

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

mayoresCrecientes1 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes [3,2,5]

-- [[],[3],[2],[5],[3,5],[2,5]]

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

sublistasCrecientes xs =

[ys | ys <- subsequences xs

, esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por

-- ejemplo,

-- esCreciente [2,3,5] == True

-- esCreciente [2,3,1] == False

-- esCreciente [2,3,3] == False

esCreciente :: Ord a => [a] -> Bool

esCreciente (x:y:zs) = x < y && esCreciente (y:zs)

esCreciente _ = True

-- 2ª solución

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

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

mayoresCrecientes2 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes2 xs

m = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes2 [3,2,5]

-- [[3,5],[3],[2,5],[2],[5],[]]

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

sublistasCrecientes2 [] = [[]]

sublistasCrecientes2 (x:xs) =

[x:ys | ys <- yss, null ys || x < head ys] ++ yss

where yss = sublistasCrecientes2 xs

-- Comparación de eficiencia

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

-- λ> length (head (mayoresCrecientes1 (show (2^70))))

-- 5

-- (10.93 secs, 1,958,822,896 bytes)

-- λ> length (head (mayoresCrecientes2 (show (2^70))))

-- 5

-- (0.02 secs, 0 bytes)

Conjetura de Goldbach

PorJosé A. Alonso 21-marzo-201826-marzo-2022

Una forma de la conjetura de Golbach afirma que todo entero mayor que 1 se puede escribir como la suma de uno, dos o tres números primos.

Si se define el índice de Goldbach de n > 1 como la mínima cantidad de primos necesarios para que su suma sea n, entonces la conjetura de Goldbach afirma que todos los índices de Goldbach de los enteros mayores que 1 son menores que 4.

Definir las siguientes funciones

   indiceGoldbach  :: Int -> Int
   graficaGoldbach :: Int -> IO ()

1 2	indiceGoldbach :: Int -> Int graficaGoldbach :: Int -> IO ()

tales que

(indiceGoldbach n) es el índice de Goldbach de n. Por ejemplo,

     indiceGoldbach 2                        ==  1
     indiceGoldbach 4                        ==  2
     indiceGoldbach 27                       ==  3
     sum (map indiceGoldbach [2..5000])      ==  10619
     maximum (map indiceGoldbach [2..5000])  ==  3

indiceGoldbach 2 == 1

indiceGoldbach 4 == 2

indiceGoldbach 27 == 3

sum (map indiceGoldbach [2..5000]) == 10619

maximum (map indiceGoldbach [2..5000]) == 3

(graficaGoldbach n) dibuja la gráfica de los índices de Goldbach de los números entre 2 y n. Por ejemplo, (graficaGoldbach 150) dibuja

Comprobar con QuickCheck la conjetura de Goldbach anterior.

Soluciones

import Data.Array
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple
import Test.QuickCheck


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

indiceGoldbach :: Int -> Int
indiceGoldbach n =
  minimum (map length (particiones n))

particiones :: Int -> [[Int]]
particiones n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)

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

indiceGoldbach2 :: Int -> Int
indiceGoldbach2 x =
  head [n | n <- [1..], esSumaDe x n]

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n
-- primos. Por ejemplo,
--    esSumaDe 2  1  ==  True
--    esSumaDe 4  1  ==  False
--    esSumaDe 4  2  ==  True
--    esSumaDe 27 2  ==  False
--    esSumaDe 27 3  ==  True
esSumaDe :: Int -> Int -> Bool
esSumaDe x 1 = isPrime x
esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

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

indiceGoldbach3 :: Int -> Int
indiceGoldbach3 x =
  head [n | n <- [1..], esSumaDe3 x n]

esSumaDe3 :: Int -> Int -> Bool
esSumaDe3 x n = a ! (x,n) where
  a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]
  f i 1 = isPrime i
  f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

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

indiceGoldbach4 :: Int -> Int
indiceGoldbach4 n = v ! n where
  v = array (2,n) [(i,f i) | i <- [2..n]]
  f i | isPrime i = 1
      | otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

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

--    λ> sum (map indiceGoldbach [2..80])
--    142
--    (2.66 secs, 1,194,330,496 bytes)
--    λ> sum (map indiceGoldbach2 [2..80])
--    142
--    (0.01 secs, 1,689,944 bytes)
--    λ> sum (map indiceGoldbach3 [2..80])
--    142
--    (0.03 secs, 27,319,296 bytes)
--    λ> sum (map indiceGoldbach4 [2..80])
--    142
--    (0.03 secs, 47,823,656 bytes)
--    
--    λ> sum (map indiceGoldbach2 [2..1000])
--    2030
--    (0.10 secs, 200,140,264 bytes)
--    λ> sum (map indiceGoldbach3 [2..1000])
--    2030
--    (3.10 secs, 4,687,467,664 bytes)

-- Gráfica
-- =======

graficaGoldbach :: Int -> IO ()
graficaGoldbach n =
  plotList [ Key Nothing
           , XRange (2,fromIntegral n)
           , PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png")
           ]
           [indiceGoldbach2 k | k <- [2..n]]

-- Comprobación de la conjetura de Goldbach
-- ========================================

-- La propiedad es
prop_Goldbach :: Int -> Property
prop_Goldbach x =
  x >= 2 ==> indiceGoldbach2 x < 4

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

100

101

102

103

104

105

106

107

import Data.Array

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

indiceGoldbach :: Int -> Int

indiceGoldbach n =

minimum (map length (particiones n))

particiones :: Int -> [[Int]]

particiones n = v ! n where

v = array (0,n) [(i,f i) | i <- [0..n]]

where f 0 = [[]]

f m = [x:y | x <- xs,

y <- v ! (m-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= m) primes)

-- 2ª definición

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

indiceGoldbach2 :: Int -> Int

indiceGoldbach2 x =

head [n | n <- [1..], esSumaDe x n]

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n

-- primos. Por ejemplo,

-- esSumaDe 2 1 == True

-- esSumaDe 4 1 == False

-- esSumaDe 4 2 == True

-- esSumaDe 27 2 == False

-- esSumaDe 27 3 == True

esSumaDe :: Int -> Int -> Bool

esSumaDe x 1 = isPrime x

esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

-- 3ª definición

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

indiceGoldbach3 :: Int -> Int

indiceGoldbach3 x =

head [n | n <- [1..], esSumaDe3 x n]

esSumaDe3 :: Int -> Int -> Bool

esSumaDe3 x n = a ! (x,n) where

a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]

f i 1 = isPrime i

f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

-- 4ª definición

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

indiceGoldbach4 :: Int -> Int

indiceGoldbach4 n = v ! n where

v = array (2,n) [(i,f i) | i <- [2..n]]

f i | isPrime i = 1

| otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

-- Comparación de eficiencia

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

-- λ> sum (map indiceGoldbach [2..80])

-- 142

-- (2.66 secs, 1,194,330,496 bytes)

-- λ> sum (map indiceGoldbach2 [2..80])

-- 142

-- (0.01 secs, 1,689,944 bytes)

-- λ> sum (map indiceGoldbach3 [2..80])

-- 142

-- (0.03 secs, 27,319,296 bytes)

-- λ> sum (map indiceGoldbach4 [2..80])

-- 142

-- (0.03 secs, 47,823,656 bytes)

-- λ> sum (map indiceGoldbach2 [2..1000])

-- 2030

-- (0.10 secs, 200,140,264 bytes)

-- λ> sum (map indiceGoldbach3 [2..1000])

-- 2030

-- (3.10 secs, 4,687,467,664 bytes)

-- Gráfica

-- =======

graficaGoldbach :: Int -> IO ()

graficaGoldbach n =

plotList [ Key Nothing

, XRange (2,fromIntegral n)

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

]

[indiceGoldbach2 k | k <- [2..n]]

-- Comprobación de la conjetura de Goldbach

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

-- La propiedad es

prop_Goldbach :: Int -> Property

prop_Goldbach x =

x >= 2 ==> indiceGoldbach2 x < 4

-- La comprobación es

-- λ> quickCheck prop_Goldbach

-- +++ OK, passed 100 tests.

La sucesión de Sylvester

PorJosé A. Alonso 19-marzo-201825-abril-2021

La sucesión de Sylvester es la sucesión que comienza en 2 y sus restantes términos se obtienen multiplicando los anteriores y sumándole 1.

Definir las funciones

   sylvester        :: Integer -> Integer
   graficaSylvester :: Integer -> Integer -> IO ()

1 2	sylvester :: Integer -> Integer graficaSylvester :: Integer -> Integer -> IO ()

tales que

(sylvester n) es el n-ésimo término de la sucesión de Sylvester. Por ejemplo,

     λ> [sylvester n | n <- [0..7]]
     [2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]
     λ> length (show (sylvester 25))
     6830085

λ> [sylvester n | n <- [0..7]]

[2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]

λ> length (show (sylvester 25))

6830085

(graficaSylvester d n) dibuja la gráfica de los d últimos dígitos de los n primeros términos de la sucesión de Sylvester. Por ejemplo,
- (graficaSylvester 3 30) dibuja
- (graficaSylvester 4 30) dibuja
- (graficaSylvester 5 30) dibuja

Soluciones

import Data.List               (genericIndex)
import Data.Array              ((!), array)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG))

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

sylvester1 :: Integer -> Integer
sylvester1 0 = 2
sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

-- 2ª solución (con programación dinámica)
-- =======================================

sylvester2 :: Integer -> Integer
sylvester2 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 2
  f m = 1 + product [v!k | k <- [0..m-1]]

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

sylvester3 :: Integer -> Integer
sylvester3 0 = 2
sylvester3 n = 1 + x^2 - x
  where x = sylvester3 (n-1)

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

sylvester4 :: Integer -> Integer
sylvester4 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 2
  f m = 1 + x^2 - x
    where x = v ! (m-1)

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

sylvester5 :: Integer -> Integer
sylvester5 0 = 2
sylvester5 n = 1 + (productosSylvester `genericIndex` (n-1))

sucSylvester5 :: [Integer]
sucSylvester5 = map sylvester5 [0..]

productosSylvester :: [Integer]
productosSylvester = scanl1 (*) sucSylvester5

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

--    λ> length (show (sylvester1 20))
--    213441
--    (3.40 secs, 519,249,840 bytes)
--    λ> length (show (sylvester2 20))
--    213441
--    (0.10 secs, 13,716,024 bytes)
--    λ> length (show (sylvester3 20))
--    213441
--    (0.16 secs, 13,646,472 bytes)
--    λ> length (show (sylvester4 20))
--    213441
--    (0.18 secs, 13,654,064 bytes)
--    λ> length (show (sylvester5 20))
--    213441
--    (0.12 secs, 13,497,192 bytes)

graficaSylvester :: Integer -> Integer -> IO ()
graficaSylvester d n =
  plotList [ Key Nothing
           , PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")
           ]
           [sylvester5 k `mod` (10^d) | k <- [0..n]]

import Data.List (genericIndex)

import Data.Array ((!), array)

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

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

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

sylvester1 :: Integer -> Integer

sylvester1 0 = 2

sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

-- 2ª solución (con programación dinámica)

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

sylvester2 :: Integer -> Integer

sylvester2 n = v ! n where

v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 2

f m = 1 + product [v!k | k <- [0..m-1]]

-- 3ª solución

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

sylvester3 :: Integer -> Integer

sylvester3 0 = 2

sylvester3 n = 1 + x^2 - x

where x = sylvester3 (n-1)

-- 4ª solución

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

sylvester4 :: Integer -> Integer

sylvester4 n = v ! n where

v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 2

f m = 1 + x^2 - x

where x = v ! (m-1)

-- 4ª solución

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

sylvester5 :: Integer -> Integer

sylvester5 0 = 2

sylvester5 n = 1 + (productosSylvester `genericIndex` (n-1))

sucSylvester5 :: [Integer]

sucSylvester5 = map sylvester5 [0..]

productosSylvester :: [Integer]

productosSylvester = scanl1 (*) sucSylvester5

-- Comparación de eficiencia

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

-- λ> length (show (sylvester1 20))

-- 213441

-- (3.40 secs, 519,249,840 bytes)

-- λ> length (show (sylvester2 20))

-- 213441

-- (0.10 secs, 13,716,024 bytes)

-- λ> length (show (sylvester3 20))

-- 213441

-- (0.16 secs, 13,646,472 bytes)

-- λ> length (show (sylvester4 20))

-- 213441

-- (0.18 secs, 13,654,064 bytes)

-- λ> length (show (sylvester5 20))

-- 213441

-- (0.12 secs, 13,497,192 bytes)

graficaSylvester :: Integer -> Integer -> IO ()

graficaSylvester d n =

plotList [ Key Nothing

, PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")

]

[sylvester5 k `mod` (10^d) | k <- [0..n]]

Camino de máxima suma en una matriz

PorJosé A. Alonso 16-marzo-201825-abril-2021

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El camino de máxima suma es el segundo (1, 7, 12, 8, 4, 9) que tiene una suma de 41.

Definir la función

   caminoMaxSuma :: Matrix Int -> [Int]

1	caminoMaxSuma :: Matrix Int -> [Int]

tal que (caminoMaxSuma m) es un camino de máxima suma en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [1,7,12,8,4,9]
   λ> sum (caminoMaxSuma (fromList 500 500 [1..]))
   187001249

λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])

[1,7,12,8,4,9]

λ> sum (caminoMaxSuma (fromList 500 500 [1..]))

187001249

Soluciones

import Data.Matrix

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

caminoMaxSuma1 :: Matrix Int -> [Int]
caminoMaxSuma1 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos1 m
        k  = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]

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

caminoMaxSuma2 :: Matrix Int -> [Int]
caminoMaxSuma2 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos2 m
        k  = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  

-- 3ª definición (con programación dinámica)
-- =========================================

caminoMaxSuma3 :: Matrix Int -> [Int]
caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))
  where nf = nrows m
        nc = ncols m
        q  = caminoMaxSumaAux m

caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])
caminoMaxSumaAux m = q 
  where
    nf = nrows m
    nc = ncols m
    q  = matrix nf nc f
      where
        f (1,1) = (m!(1,1),[m!(1,1)])
        f (1,j) = (k + m!(1,j), m!(1,j):xs)
          where (k,xs) = q!(1,j-1)
        f (i,1) = (k + m!(i,1), m!(i,1):xs)
          where (k,xs) = q!(i-1,1)        
        f (i,j) | k1 > k2   = (k1 + m!(i,j), m!(i,j):xs)
                | otherwise = (k2 + m!(i,j), m!(i,j):ys)
          where (k1,xs) = q!(i,j-1)
                (k2,ys) = q!(i-1,j)

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

--    λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))
--    21
--    (10.00 secs, 1,510,120,328 bytes)
--    λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))
--    21
--    (3.84 secs, 745,918,544 bytes)
--    λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))
--    21
--    (0.01 secs, 0 bytes)

import Data.Matrix

-- 1ª definición

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

caminoMaxSuma1 :: Matrix Int -> [Int]

caminoMaxSuma1 m =

head [c | c <- cs, sum c == k]

where cs = caminos1 m

k = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]

caminos1 m =

map reverse (caminos1Aux m (nf,nc))

where nf = nrows m

nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p

-- desde la posición (1,1) hasta la posición x. Por ejemplo,

caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]

caminos1Aux m (1,1) = [[m!(1,1)]]

caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]

caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]

caminos1Aux m (i,j) = [m!(i,j) : xs

| xs <- caminos1Aux m (i,j-1) ++

caminos1Aux m (i-1,j)]

-- 2ª definición

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

caminoMaxSuma2 :: Matrix Int -> [Int]

caminoMaxSuma2 m =

head [c | c <- cs, sum c == k]

where cs = caminos2 m

k = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]

caminos2 m =

map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]

matrizCaminos m = q

where

q = matrix (nrows m) (ncols m) f

f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]

f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]

f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]

-- 3ª definición (con programación dinámica)

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

caminoMaxSuma3 :: Matrix Int -> [Int]

caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))

where nf = nrows m

nc = ncols m

q = caminoMaxSumaAux m

caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])

caminoMaxSumaAux m = q

where

nf = nrows m

nc = ncols m

q = matrix nf nc f

where

f (1,1) = (m!(1,1),[m!(1,1)])

f (1,j) = (k + m!(1,j), m!(1,j):xs)

where (k,xs) = q!(1,j-1)

f (i,1) = (k + m!(i,1), m!(i,1):xs)

where (k,xs) = q!(i-1,1)

f (i,j) | k1 > k2 = (k1 + m!(i,j), m!(i,j):xs)

| otherwise = (k2 + m!(i,j), m!(i,j):ys)

where (k1,xs) = q!(i,j-1)

(k2,ys) = q!(i-1,j)

-- Comparación de eficiencia

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

-- λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))

-- 21

-- (10.00 secs, 1,510,120,328 bytes)

-- λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))

-- 21

-- (3.84 secs, 745,918,544 bytes)

-- λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))

-- 21

-- (0.01 secs, 0 bytes)

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Soluciones

Soluciones

Referencia

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