marzo 2019 – Exercitium

Triángulo de Euler

PorJosé A. Alonso 29-marzo-20195-abril-2019

El triángulo de Euler se construye a partir de las siguientes relaciones

   A(n,1) = A(n,n) = 1
   A(n,m) = (n-m)A(n-1,m-1) + (m+1)A(n-1,m).

1 2	A(n,1) = A(n,n) = 1 A(n,m) = (n-m)A(n-1,m-1) + (m+1)A(n-1,m).

Sus primeros términos son

   1 
   1 1                                                       
   1 4   1                                            
   1 11  11    1                                    
   1 26  66    26    1                             
   1 57  302   302   57     1                    
   1 120 1191  2416  1191   120   1            
   1 247 4293  15619 15619  4293  247   1   
   1 502 14608 88234 156190 88234 14608 502 1

1 1

1 4 1

1 11 11 1

1 26 66 26 1

1 57 302 302 57 1

1 120 1191 2416 1191 120 1

1 247 4293 15619 15619 4293 247 1

1 502 14608 88234 156190 88234 14608 502 1

Definir las siguientes funciones:

  numeroEuler        :: Integer -> Integer -> Integer
  filaTrianguloEuler :: Integer -> [Integer]
  trianguloEuler     :: [[Integer]]

numeroEuler :: Integer -> Integer -> Integer

filaTrianguloEuler :: Integer -> [Integer]

trianguloEuler :: [[Integer]]

tales que

(numeroEuler n k) es el número de Euler A(n,k). Por ejemplo,

     numeroEuler 8 3  == 15619
     numeroEuler 20 6 == 21598596303099900
     length (show (numeroEuler 1000 500)) == 2567

numeroEuler 8 3 == 15619

numeroEuler 20 6 == 21598596303099900

length (show (numeroEuler 1000 500)) == 2567

(filaTrianguloEuler n) es la n-ésima fila del triángulo de Euler. Por ejemplo,

     filaTrianguloEuler 7  ==  [1,120,1191,2416,1191,120,1]
     filaTrianguloEuler 8  ==  [1,247,4293,15619,15619,4293,247,1]
     length (show (maximum (filaTrianguloEuler 1000)))  ==  2567

filaTrianguloEuler 7 == [1,120,1191,2416,1191,120,1]

filaTrianguloEuler 8 == [1,247,4293,15619,15619,4293,247,1]

length (show (maximum (filaTrianguloEuler 1000))) == 2567

trianguloEuler es la lista con las filas del triángulo de Euler

     λ> take 6 trianguloEuler
     [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
     λ> length (show (maximum (trianguloEuler !! 999)))
     2567

λ> take 6 trianguloEuler

[[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]

λ> length (show (maximum (trianguloEuler !! 999)))

2567

Soluciones

import Data.List  (genericLength, genericIndex)
import Data.Array (Array, (!), array)

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

trianguloEuler :: [[Integer]]
trianguloEuler = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente a la xs en el triángulo de
-- Euler. Por ejemplo,
--    λ> siguiente [1]
--    [1,1]
--    λ> siguiente it
--    [1,4,1]
--    λ> siguiente it
--    [1,11,11,1]
siguiente :: [Integer] -> [Integer]
siguiente xs = zipWith (+) us vs
  where n = genericLength xs
        us = zipWith (*) (0:xs) [n+1,n..1]
        vs = zipWith (*) (xs++[0]) [1..n+1]

filaTrianguloEuler :: Integer -> [Integer]
filaTrianguloEuler n = trianguloEuler `genericIndex` (n-1)

numeroEuler :: Integer -> Integer -> Integer
numeroEuler n k = filaTrianguloEuler n `genericIndex` k

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

numeroEuler2 :: Integer -> Integer -> Integer
numeroEuler2 n 0 = 1
numeroEuler2 n m 
  | n == m    = 0
  | otherwise = (n-m) * numeroEuler2 (n-1) (m-1) + (m+1) * numeroEuler2 (n-1) m

filaTrianguloEuler2 :: Integer -> [Integer]
filaTrianguloEuler2 n = map (numeroEuler2 n) [0..n-1]

trianguloEuler2 :: [[Integer]]
trianguloEuler2 = map filaTrianguloEuler2 [1..]
                  
-- 3ª solución
-- ===========

numeroEuler3 :: Integer -> Integer -> Integer
numeroEuler3 n k = (matrizEuler n k) ! (n,k)

-- (matrizEuler n m) es la matriz de n+1 filas y m+1 columnsa formada
-- por los números de Euler. Por ejemplo,
--   λ> [[matrizEuler 6 6 ! (i,j) | j <- [0..i-1]] | i <- [1..6]]
--   [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
matrizEuler :: Integer -> Integer -> Array (Integer,Integer) Integer
matrizEuler n m = q
  where q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
        f i 0 = 1
        f i j
          | i == j    = 0
          | otherwise = (i-j) * q!(i-1,j-1) + (j+1)* q!(i-1,j)

filaTrianguloEuler3 :: Integer -> [Integer]
filaTrianguloEuler3 n = map (numeroEuler3 n) [0..n-1]

trianguloEuler3 :: [[Integer]]
trianguloEuler3 = map filaTrianguloEuler3 [1..]

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

-- La comparación es
--   λ> numeroEuler 22 11
--   301958232385734088196
--   (0.01 secs, 118,760 bytes)
--   λ> numeroEuler2 22 11
--   301958232385734088196
--   (3.96 secs, 524,955,384 bytes)
--   λ> numeroEuler3 22 11
--   301958232385734088196
--   (0.01 secs, 356,296 bytes)
--   
--   λ> length (show (numeroEuler 800 400))
--   1976
--   (0.01 secs, 383,080 bytes)
--   λ> length (show (numeroEuler3 800 400))
--   1976
--   (2.13 secs, 508,780,696 bytes)

import Data.List (genericLength, genericIndex)

import Data.Array (Array, (!), array)

-- 1ª solución

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

trianguloEuler :: [[Integer]]

trianguloEuler = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente a la xs en el triángulo de

-- Euler. Por ejemplo,

-- λ> siguiente [1]

-- [1,1]

-- λ> siguiente it

-- [1,4,1]

-- λ> siguiente it

-- [1,11,11,1]

siguiente :: [Integer] -> [Integer]

siguiente xs = zipWith (+) us vs

where n = genericLength xs

us = zipWith (*) (0:xs) [n+1,n..1]

vs = zipWith (*) (xs++[0]) [1..n+1]

filaTrianguloEuler :: Integer -> [Integer]

filaTrianguloEuler n = trianguloEuler `genericIndex` (n-1)

numeroEuler :: Integer -> Integer -> Integer

numeroEuler n k = filaTrianguloEuler n `genericIndex` k

-- 2ª solución

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

numeroEuler2 :: Integer -> Integer -> Integer

numeroEuler2 n 0 = 1

numeroEuler2 n m

| n == m = 0

| otherwise = (n-m) * numeroEuler2 (n-1) (m-1) + (m+1) * numeroEuler2 (n-1) m

filaTrianguloEuler2 :: Integer -> [Integer]

filaTrianguloEuler2 n = map (numeroEuler2 n) [0..n-1]

trianguloEuler2 :: [[Integer]]

trianguloEuler2 = map filaTrianguloEuler2 [1..]

-- 3ª solución

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

numeroEuler3 :: Integer -> Integer -> Integer

numeroEuler3 n k = (matrizEuler n k) ! (n,k)

-- (matrizEuler n m) es la matriz de n+1 filas y m+1 columnsa formada

-- por los números de Euler. Por ejemplo,

-- λ> [[matrizEuler 6 6 ! (i,j) | j <- [0..i-1]] | i <- [1..6]]

-- [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]

matrizEuler :: Integer -> Integer -> Array (Integer,Integer) Integer

matrizEuler n m = q

where q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]

f i 0 = 1

f i j

| i == j = 0

| otherwise = (i-j) * q!(i-1,j-1) + (j+1)* q!(i-1,j)

filaTrianguloEuler3 :: Integer -> [Integer]

filaTrianguloEuler3 n = map (numeroEuler3 n) [0..n-1]

trianguloEuler3 :: [[Integer]]

trianguloEuler3 = map filaTrianguloEuler3 [1..]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroEuler 22 11

-- 301958232385734088196

-- (0.01 secs, 118,760 bytes)

-- λ> numeroEuler2 22 11

-- 301958232385734088196

-- (3.96 secs, 524,955,384 bytes)

-- λ> numeroEuler3 22 11

-- 301958232385734088196

-- (0.01 secs, 356,296 bytes)

-- λ> length (show (numeroEuler 800 400))

-- 1976

-- (0.01 secs, 383,080 bytes)

-- λ> length (show (numeroEuler3 800 400))

-- 1976

-- (2.13 secs, 508,780,696 bytes)

Pensamiento

Señor San Jerónimo,
suelte usted la piedra
con que se machaca.
Me pegó con ella.

Antonio Machado

Subconjuntos divisibles

PorJosé A. Alonso 28-marzo-20194-abril-2019

Definir la función

  subconjuntosDivisibles :: [Int] -> [[Int]]

1	subconjuntosDivisibles :: [Int] -> [[Int]]

tal que (subconjuntosDivisibles xs) es la lista de todos los subconjuntos de xs en los que todos los elementos tienen un factor común mayor que 1. Por ejemplo,

  subconjuntosDivisibles []         ==  [[]]
  subconjuntosDivisibles [1]        ==  [[]]
  subconjuntosDivisibles [3]        ==  [[3],[]]
  subconjuntosDivisibles [1,3]      ==  [[3],[]]
  subconjuntosDivisibles [3,6]      ==  [[3,6],[3],[6],[]]
  subconjuntosDivisibles [1,3,6]    ==  [[3,6],[3],[6],[]]
  subconjuntosDivisibles [2,3,6]    ==  [[2,6],[2],[3,6],[3],[6],[]]
  subconjuntosDivisibles [2,3,6,8]  ==  [[2,6,8],[2,6],[2,8],[2],[3,6],[3],[6,8],[6],[8],[]]
  length (subconjuntosDivisibles [1..10])  ==  41
  length (subconjuntosDivisibles [1..20])  ==  1097
  length (subconjuntosDivisibles [1..30])  ==  33833
  length (subconjuntosDivisibles [1..40])  ==  1056986

subconjuntosDivisibles [] == [[]]

subconjuntosDivisibles [1] == [[]]

subconjuntosDivisibles [3] == [[3],[]]

subconjuntosDivisibles [1,3] == [[3],[]]

subconjuntosDivisibles [3,6] == [[3,6],[3],[6],[]]

subconjuntosDivisibles [1,3,6] == [[3,6],[3],[6],[]]

subconjuntosDivisibles [2,3,6] == [[2,6],[2],[3,6],[3],[6],[]]

subconjuntosDivisibles [2,3,6,8] == [[2,6,8],[2,6],[2,8],[2],[3,6],[3],[6,8],[6],[8],[]]

length (subconjuntosDivisibles [1..10]) == 41

length (subconjuntosDivisibles [1..20]) == 1097

length (subconjuntosDivisibles [1..30]) == 33833

length (subconjuntosDivisibles [1..40]) == 1056986

Soluciones

import Data.List (foldl1', subsequences)

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

subconjuntosDivisibles :: [Int] -> [[Int]]
subconjuntosDivisibles xs = filter esDivisible (subsequences xs)

-- (esDivisible xs) se verifica si todos los elementos de xs tienen un
-- factor común mayor que 1. Por ejemplo,
--    esDivisible [6,10,22]  ==  True
--    esDivisible [6,10,23]  ==  False
esDivisible :: [Int] -> Bool
esDivisible [] = True
esDivisible xs = mcd xs > 1

-- (mcd xs) es el máximo común divisor de xs. Por ejemplo,
--    mcd [6,10,22]  ==  2
--    mcd [6,10,23]  ==  1
mcd :: [Int] -> Int
mcd = foldl1' gcd

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

subconjuntosDivisibles2 :: [Int] -> [[Int]]
subconjuntosDivisibles2 []     = [[]]
subconjuntosDivisibles2 (x:xs) = [x:ys | ys <- yss, esDivisible (x:ys)] ++ yss
  where yss = subconjuntosDivisibles2 xs

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

subconjuntosDivisibles3 :: [Int] -> [[Int]]
subconjuntosDivisibles3 []     = [[]]
subconjuntosDivisibles3 (x:xs) = filter esDivisible (map (x:) yss) ++ yss
  where yss = subconjuntosDivisibles3 xs

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

-- La comparación es
--    λ> length (subconjuntosDivisibles [1..21])
--    1164
--    (3.83 secs, 5,750,416,768 bytes)
--    λ> length (subconjuntosDivisibles2 [1..21])
--    1164
--    (0.01 secs, 5,400,232 bytes)
--    λ> length (subconjuntosDivisibles3 [1..21])
--    1164
--    (0.01 secs, 5,264,928 bytes)
--    
--    λ> length (subconjuntosDivisibles2 [1..40])
--    1056986
--    (6.95 secs, 8,845,664,672 bytes)
--    λ> length (subconjuntosDivisibles3 [1..40])
--    1056986
--    (6.74 secs, 8,727,141,792 bytes)

import Data.List (foldl1', subsequences)

-- 1ª solución

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

subconjuntosDivisibles :: [Int] -> [[Int]]

subconjuntosDivisibles xs = filter esDivisible (subsequences xs)

-- (esDivisible xs) se verifica si todos los elementos de xs tienen un

-- factor común mayor que 1. Por ejemplo,

-- esDivisible [6,10,22] == True

-- esDivisible [6,10,23] == False

esDivisible :: [Int] -> Bool

esDivisible [] = True

esDivisible xs = mcd xs > 1

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

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

-- mcd [6,10,23] == 1

mcd :: [Int] -> Int

mcd = foldl1' gcd

-- 2ª solución

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

subconjuntosDivisibles2 :: [Int] -> [[Int]]

subconjuntosDivisibles2 [] = [[]]

subconjuntosDivisibles2 (x:xs) = [x:ys | ys <- yss, esDivisible (x:ys)] ++ yss

where yss = subconjuntosDivisibles2 xs

-- 3ª solución

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

subconjuntosDivisibles3 :: [Int] -> [[Int]]

subconjuntosDivisibles3 [] = [[]]

subconjuntosDivisibles3 (x:xs) = filter esDivisible (map (x:) yss) ++ yss

where yss = subconjuntosDivisibles3 xs

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (subconjuntosDivisibles [1..21])

-- 1164

-- (3.83 secs, 5,750,416,768 bytes)

-- λ> length (subconjuntosDivisibles2 [1..21])

-- 1164

-- (0.01 secs, 5,400,232 bytes)

-- λ> length (subconjuntosDivisibles3 [1..21])

-- 1164

-- (0.01 secs, 5,264,928 bytes)

-- λ> length (subconjuntosDivisibles2 [1..40])

-- 1056986

-- (6.95 secs, 8,845,664,672 bytes)

-- λ> length (subconjuntosDivisibles3 [1..40])

-- 1056986

-- (6.74 secs, 8,727,141,792 bytes)

Pensamiento

Abejas, cantores,
no a la miel, sino a las flores.

Antonio Machado

Matriz girada 180 grados

PorJosé A. Alonso 27-marzo-20193-abril-2019

Definir la función

   matrizGirada180 :: Matrix a -> Matrix a

1	matrizGirada180 :: Matrix a -> Matrix a

tal que (matrizGirada180 p) es la matriz obtenida girando 180 grados la matriz p. Por ejemplo,

   λ> fromList 4 3 [1..]
   (  1  2  3 )
   (  4  5  6 )
   (  7  8  9 )
   ( 10 11 12 )

   λ> matrizGirada180 (fromList 4 3 [1..])
   ( 12 11 10 )
   (  9  8  7 )
   (  6  5  4 )
   (  3  2  1 )

   λ> fromList 3 4 [1..]
   (  1  2  3  4 )
   (  5  6  7  8 )
   (  9 10 11 12 )

   λ> matrizGirada180 (fromList 3 4 [1..])
   ( 12 11 10  9 )
   (  8  7  6  5 )
   (  4  3  2  1 )

λ> fromList 4 3 [1..]

( 1 2 3 )

( 4 5 6 )

( 7 8 9 )

( 10 11 12 )

λ> matrizGirada180 (fromList 4 3 [1..])

( 12 11 10 )

( 9 8 7 )

( 6 5 4 )

( 3 2 1 )

λ> fromList 3 4 [1..]

( 1 2 3 4 )

( 5 6 7 8 )

( 9 10 11 12 )

λ> matrizGirada180 (fromList 3 4 [1..])

( 12 11 10 9 )

( 8 7 6 5 )

( 4 3 2 1 )

Soluciones

import Data.Matrix ( Matrix
                   , (!)
                   , fromList
                   , fromLists
                   , matrix
                   , ncols
                   , nrows
                   , toLists
                   )

-- 1ª solución
matrizGirada180 :: Matrix a -> Matrix a
matrizGirada180 p = matrix m n f
  where m       = nrows p
        n       = ncols p
        f (i,j) = p!(m-i+1,n-j+1)

-- 2ª solución
matrizGirada180b :: Matrix a -> Matrix a
matrizGirada180b p =
  fromLists (reverse (map reverse (toLists p)))

-- 3ª solución
matrizGirada180c :: Matrix a -> Matrix a
matrizGirada180c =
  fromLists . reverse . map reverse . toLists

import Data.Matrix ( Matrix

, (!)

, fromList

, fromLists

, matrix

, ncols

, nrows

, toLists

)

-- 1ª solución

matrizGirada180 :: Matrix a -> Matrix a

matrizGirada180 p = matrix m n f

where m = nrows p

n = ncols p

f (i,j) = p!(m-i+1,n-j+1)

-- 2ª solución

matrizGirada180b :: Matrix a -> Matrix a

matrizGirada180b p =

fromLists (reverse (map reverse (toLists p)))

-- 3ª solución

matrizGirada180c :: Matrix a -> Matrix a

matrizGirada180c =

fromLists . reverse . map reverse . toLists

Pensamiento

Bueno es recordar
las palabras viejas
que han de volver a sonar.

Antonio Machado

Árboles cuyas ramas cumplen una propiedad

PorJosé A. Alonso 26-marzo-20192-abril-2019

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

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

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

Por ejemplo, los árboles

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

-1 1 1

/ \ / \ /|\

2 3 -2 3 / | \

/ \ | -2 7 3

4 5 -4 / \

4 5

se representan por

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

ej1, ej2, ej3 :: Arbol Int

ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N (-2) [N (-4) []], N 3 []]

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

Definir la función

   todasDesdeAlguno :: (a -> Bool) -> Arbol a -> Bool

1	todasDesdeAlguno :: (a -> Bool) -> Arbol a -> Bool

tal que (todasDesdeAlguno p ar) se verifica si para toda rama existe un elemento a partir del cual todos los elementos de la rama verifican la propiedad p. Por ejemplo,

   todasDesdeAlguno (>0) ej1 == True
   todasDesdeAlguno (>0) ej2 == False
   todasDesdeAlguno (>0) ej3 == True

todasDesdeAlguno (>0) ej1 == True

todasDesdeAlguno (>0) ej2 == False

todasDesdeAlguno (>0) ej3 == True

Soluciones

import Data.List (tails)

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

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

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

todasDesdeAlguno :: (b -> Bool) -> Arbol b -> Bool
todasDesdeAlguno p a = all (desdeAlguno p) (ramas a)

-- (desdeAlguno p xs) se verifica si la propiedad xs tiene un elementemo
-- a partir del cual todos los siguientes cumplen la propiedad p. Por
-- ejemplo, 
--    desdeAlguno (>0) [-1,2,4]   ==  True
--    desdeAlguno (>0) [1,-2,-4]  ==  False
--    desdeAlguno (>0) [1,-2,4]   ==  True

-- 1ª definición de desdeAlguno
desdeAlguno1 :: (a -> Bool) -> [a] -> Bool
desdeAlguno1 p xs =
  not (null (takeWhile p (reverse xs)))

-- 2ª definición de desdeAlguno
desdeAlguno2 :: (a -> Bool) -> [a] -> Bool
desdeAlguno2 p xs = any (all p) (init (tails xs))

-- Comparación de eficiencia:
--    λ> desdeAlguno1 (>10^7) [1..1+10^7]
--    True
--    (4.36 secs, 960,101,896 bytes)
--    λ> desdeAlguno2 (>10^7) [1..1+10^7]
--    True
--    (5.62 secs, 3,600,101,424 bytes)

-- Usaremos la 1ª definición de desdeAlguno
desdeAlguno :: (a -> Bool) -> [a] -> Bool
desdeAlguno = desdeAlguno1

-- (ramas a) es la lista de las ramas de a. Por ejemplo,
--    ramas ej1  ==  [[-1,2,4],[-1,2,5],[-1,3]]
--    ramas ej2  ==  [[1,-2,-4],[1,3]]
--    ramas ej3  ==  [[1,-2,4],[1,-2,5],[1,7],[1,3]]
ramas :: Arbol a -> [[a]]
ramas (N x []) = [[x]]
ramas (N x as) = map (x:) (concatMap ramas as)

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

todasDesdeAlguno2 :: (b -> Bool) -> Arbol b -> Bool
todasDesdeAlguno2 p (N x []) = p x
todasDesdeAlguno2 p (N _ as) = all (todasDesdeAlguno2 p) as

import Data.List (tails)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

ej1 = N (-1) [N 2 [N 4 [], N 5 []], N 3 []]

ej2 = N 1 [N (-2) [N (-4) []], N 3 []]

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

-- 1ª solución

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

todasDesdeAlguno :: (b -> Bool) -> Arbol b -> Bool

todasDesdeAlguno p a = all (desdeAlguno p) (ramas a)

-- (desdeAlguno p xs) se verifica si la propiedad xs tiene un elementemo

-- a partir del cual todos los siguientes cumplen la propiedad p. Por

-- ejemplo,

-- desdeAlguno (>0) [-1,2,4] == True

-- desdeAlguno (>0) [1,-2,-4] == False

-- desdeAlguno (>0) [1,-2,4] == True

-- 1ª definición de desdeAlguno

desdeAlguno1 :: (a -> Bool) -> [a] -> Bool

desdeAlguno1 p xs =

not (null (takeWhile p (reverse xs)))

-- 2ª definición de desdeAlguno

desdeAlguno2 :: (a -> Bool) -> [a] -> Bool

desdeAlguno2 p xs = any (all p) (init (tails xs))

-- Comparación de eficiencia:

-- λ> desdeAlguno1 (>10^7) [1..1+10^7]

-- True

-- (4.36 secs, 960,101,896 bytes)

-- λ> desdeAlguno2 (>10^7) [1..1+10^7]

-- True

-- (5.62 secs, 3,600,101,424 bytes)

-- Usaremos la 1ª definición de desdeAlguno

desdeAlguno :: (a -> Bool) -> [a] -> Bool

desdeAlguno = desdeAlguno1

-- (ramas a) es la lista de las ramas de a. Por ejemplo,

-- ramas ej1 == [[-1,2,4],[-1,2,5],[-1,3]]

-- ramas ej2 == [[1,-2,-4],[1,3]]

-- ramas ej3 == [[1,-2,4],[1,-2,5],[1,7],[1,3]]

ramas :: Arbol a -> [[a]]

ramas (N x []) = [[x]]

ramas (N x as) = map (x:) (concatMap ramas as)

-- 2ª solución

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

todasDesdeAlguno2 :: (b -> Bool) -> Arbol b -> Bool

todasDesdeAlguno2 p (N x []) = p x

todasDesdeAlguno2 p (N _ as) = all (todasDesdeAlguno2 p) as

Pensamiento

Por dar al viento trabajo,
cosía con hilo doble
las hojas secas del árbol.

Antonio Machado

El problema del número perdido

PorJosé A. Alonso 25-marzo-201926-marzo-2022

Sea xs una lista de números consecutivos (creciente o decreciente), en la que puede faltar algún número. El problema del número perdido en xs consiste en lo siguiente:

si falta un único número z, devolver Just z
si no falta ninguno, devolver Nothing

Definir la función

   numeroPerdido :: [Int] -> Maybe Int

1	numeroPerdido :: [Int] -> Maybe Int

tal que (numeroPerdido xs) es el resultado del problema del número perdidio en xs. Por ejemplo,

   numeroPerdido [7,6,4,3]                     == Just 5
   numeroPerdido [1,2,4,5,6]                   == Just 3
   numeroPerdido [6,5..3]                      == Nothing
   numeroPerdido [1..6]                        == Nothing
   numeroPerdido ([5..10^6] ++ [10^6+2..10^7]) == Just 1000001

numeroPerdido [7,6,4,3] == Just 5

numeroPerdido [1,2,4,5,6] == Just 3

numeroPerdido [6,5..3] == Nothing

numeroPerdido [1..6] == Nothing

numeroPerdido ([5..10^6] ++ [10^6+2..10^7]) == Just 1000001

Soluciones

import Data.List (tails, sort)
import Data.Maybe (listToMaybe)

-- 1ª solución
numeroPerdido :: [Int] -> Maybe Int
numeroPerdido (x:y:xs)
  | abs (y - x) == 1 = numeroPerdido (y:xs)
  | otherwise        = Just (div (x+y) 2)
numeroPerdido _      = Nothing

-- 2ª solución
numeroPerdido2 :: [Int] -> Maybe Int
numeroPerdido2 xs = aux z (z:zs) 
  where (z:zs) = sort xs
        aux _ [] = Nothing
        aux y (x:xs) | y == x    = aux (y+1) xs
                     | otherwise = Just y

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

numeroPerdido3 :: [Int] -> Maybe Int
numeroPerdido3 xs =
  listToMaybe [(a+b) `div` 2 | (a:b:_) <- tails xs, abs(a-b) /= 1]

import Data.List (tails, sort)

import Data.Maybe (listToMaybe)

-- 1ª solución

numeroPerdido :: [Int] -> Maybe Int

numeroPerdido (x:y:xs)

| abs (y - x) == 1 = numeroPerdido (y:xs)

| otherwise = Just (div (x+y) 2)

numeroPerdido _ = Nothing

-- 2ª solución

numeroPerdido2 :: [Int] -> Maybe Int

numeroPerdido2 xs = aux z (z:zs)

where (z:zs) = sort xs

aux _ [] = Nothing

aux y (x:xs) | y == x = aux (y+1) xs

| otherwise = Just y

-- 3ª solución

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

numeroPerdido3 :: [Int] -> Maybe Int

numeroPerdido3 xs =

listToMaybe [(a+b) `div` 2 | (a:b:_) <- tails xs, abs(a-b) /= 1]

Pensamiento

¡Reventó de risa!
¡Un hombre tan serio!
… Nadie lo diría.

Antonio Machado

Matriz de mínimas distancias

PorJosé A. Alonso 22-marzo-201925-abril-2021

Definir las funciones

   minimasDistancias             :: Matrix Int -> Matrix Int
   sumaMinimaDistanciasIdentidad :: Int -> Int

1 2	minimasDistancias :: Matrix Int -> Matrix Int sumaMinimaDistanciasIdentidad :: Int -> Int

tales que

(mininasDistancias a) es la matriz de las mínimas distancias de cada elemento de a hasta alcanzar un 1 donde un paso es un movimiento hacia la izquierda, derecha, arriba o abajo. Por ejemplo,

     λ> minimasDistancias (fromLists [[0,1,1],[0,0,1]])
     ( 1 0 0 )
     ( 2 1 0 )
     λ> minimasDistancias (fromLists [[0,0,1],[1,0,0]])
     ( 1 1 0 )
     ( 0 1 1 )
     λ> minimasDistancias (identity 5)
     ( 0 1 2 3 4 )
     ( 1 0 1 2 3 )
     ( 2 1 0 1 2 )
     ( 3 2 1 0 1 )
     ( 4 3 2 1 0 )

λ> minimasDistancias (fromLists [[0,1,1],[0,0,1]])

( 1 0 0 )

( 2 1 0 )

λ> minimasDistancias (fromLists [[0,0,1],[1,0,0]])

( 1 1 0 )

( 0 1 1 )

λ> minimasDistancias (identity 5)

( 0 1 2 3 4 )

( 1 0 1 2 3 )

( 2 1 0 1 2 )

( 3 2 1 0 1 )

( 4 3 2 1 0 )

(sumaMinimaDistanciasIdentidad n) es la suma de los elementos de la matriz de las mínimas distancias correspondiente a la matriz identidad de orden n. Por ejemplo,

     sumaMinimaDistanciasIdentidad 5       ==  40
     sumaMinimaDistanciasIdentidad (10^2)  ==  333300
     sumaMinimaDistanciasIdentidad (10^4)  ==  333333330000
     sumaMinimaDistanciasIdentidad (10^6)  ==  333333333333000000

sumaMinimaDistanciasIdentidad 5 == 40

sumaMinimaDistanciasIdentidad (10^2) == 333300

sumaMinimaDistanciasIdentidad (10^4) == 333333330000

sumaMinimaDistanciasIdentidad (10^6) == 333333333333000000

Soluciones

import Data.Matrix
import Data.Maybe (isJust, fromJust)
import Test.QuickCheck

-- Definición de minimasDistancias
-- ===============================

minimasDistancias :: Matrix Int -> Matrix Int
minimasDistancias a = fmap fromJust (aux (matrizInicial a))
  where aux b | Nothing `elem` c = aux c
              | otherwise        = c
          where c = propagacion b

-- (matrizInicial a) es la matriz que tiene (Just 0) en los elementos de
-- a iguales a 1 y Nothing en los restantes. Por ejemplo,
--    λ> matrizInicial (fromLists [[0,0,1],[1,0,0]])
--    ( Nothing Nothing  Just 0 )
--    (  Just 0 Nothing Nothing )
matrizInicial :: Matrix Int -> Matrix (Maybe Int)
matrizInicial a = matrix m n f
  where m = nrows a
        n = ncols a
        f (i,j) | a ! (i,j) == 1 = Just 0
                | otherwise      = Nothing

-- (propagacion a) es la matriz obtenida cambiando los elementos Nothing
-- de a por el sigiente del mínomo de los valores de sus vecinos. Por
-- ejemplo,
--    λ> propagacion (fromLists [[0,1,1],[0,0,1]])
--    (  Just 1  Just 0  Just 0 )
--    ( Nothing  Just 1  Just 0 )
--    
--    λ> propagacion it
--    ( Just 1 Just 0 Just 0 )
--    ( Just 2 Just 1 Just 0 )
propagacion :: Matrix (Maybe Int) -> Matrix (Maybe Int)
propagacion a = matrix m n f
  where
    m = nrows a
    n = ncols a
    f (i,j) | isJust x  = x
            | otherwise = siguiente (minimo (valoresVecinos a (i,j)))
      where x = a ! (i,j)

-- (valoresVecinos a p) es la lista de los valores de los vecinos la
-- posición p en la matriz a. Por ejemplo,             
--    λ> a = fromList 3 4 [1..]
--    λ> a
--    (  1  2  3  4 )
--    (  5  6  7  8 )
--    (  9 10 11 12 )
--    
--    λ> valoresVecinos a (1,1)
--    [5,2]
--    λ> valoresVecinos a (2,3)
--    [3,11,6,8]
--    λ> valoresVecinos a (2,4)
--    [4,12,7]
valoresVecinos :: Matrix a -> (Int,Int) -> [a]
valoresVecinos a (i,j) = [a ! (k,l) | (k,l) <- vecinos m n (i,j)]
  where m = nrows a
        n = ncols a

-- (vecinos m n p) es la lista de las posiciones vecinas de la posición
-- p en la matriz a; es decir, los que se encuentran a su izquierda,
-- derecha, arriba o abajo. por ejemplo,
--    vecinos 3 4 (1,1)  ==  [(2,1),(1,2)]
--    vecinos 3 4 (2,3)  ==  [(1,3),(3,3),(2,2),(2,4)]
--    vecinos 3 4 (2,4)  ==  [(1,4),(3,4),(2,3)]
vecinos :: Int -> Int -> (Int,Int) -> [(Int,Int)]
vecinos m n (i,j) = [(i - 1,j)     | i > 1] ++
                    [(i + 1,j)     | i < m] ++
                    [(i,    j - 1) | j > 1] ++
                    [(i,    j + 1) | j < n]

-- (minimo xs) es el mínimo de la lista de valores opcionales xs
-- (considerando Nothing como el mayor elemento). Por ejemplo,
--    minimo [Just 3, Nothing, Just 2]  ==  Just 2
minimo :: [Maybe Int] -> Maybe Int
minimo = foldr1 minimo2

-- (minimo2 x y) es el mínimo de los valores opcionales x e y
-- (considerando Nothing como el mayor elemento). Por ejemplo,
--    minimo2 (Just 3) (Just 2)  ==  Just 2
--    minimo2 (Just 1) (Just 2)  ==  Just 1
--    minimo2 (Just 1) Nothing   ==  Just 1
--    minimo2 Nothing (Just 2)   ==  Just 2
--    minimo2 Nothing Nothing    ==  Nothing
minimo2 :: Maybe Int -> Maybe Int -> Maybe Int
minimo2 (Just x) (Just y) = Just (min x y)
minimo2 Nothing  (Just y) = Just y
minimo2 (Just x) Nothing  = Just x
minimo2 Nothing  Nothing  = Nothing

-- (siguiente x) es el siguiente elemento del opcional x (considerando
-- Nothing como el infinito). Por ejemplo, 
--    siguiente (Just 3)  ==  Just 4
--    siguiente Nothing  ==  Nothing
siguiente :: Maybe Int -> Maybe Int
siguiente (Just x) = Just (1 + x)
siguiente Nothing  = Nothing

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

sumaMinimaDistanciasIdentidad :: Int -> Int
sumaMinimaDistanciasIdentidad n =
  sum (minimasDistancias (identity n))

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

sumaMinimaDistanciasIdentidad2 :: Int -> Int
sumaMinimaDistanciasIdentidad2 n =
  n*(n^2-1) `div` 3

-- Equivalencia de las definiciones de sumaMinimaDistanciasIdentidad
-- =================================================================

-- La propiedad es
prop_MinimaDistanciasIdentidad :: Positive Int -> Bool
prop_MinimaDistanciasIdentidad (Positive n) =
  sumaMinimaDistanciasIdentidad n == sumaMinimaDistanciasIdentidad2 n

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=50}) prop_MinimaDistanciasIdentidad
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> sumaMinimaDistanciasIdentidad 50
--    41650
--    (0.24 secs, 149,395,744 bytes)
--    λ> sumaMinimaDistanciasIdentidad 100
--    333300
--    (1.98 secs, 1,294,676,272 bytes)
--    λ> sumaMinimaDistanciasIdentidad 200
--    2666600
--    (17.96 secs, 11,094,515,016 bytes)
--    
--    λ> sumaMinimaDistanciasIdentidad2 50
--    41650
--    (0.00 secs, 126,944 bytes)
--    λ> sumaMinimaDistanciasIdentidad2 100
--    333300
--    (0.00 secs, 126,872 bytes)
--    λ> sumaMinimaDistanciasIdentidad2 200
--    2666600
--    (0.00 secs, 131,240 bytes)
--
-- Resumidamente, el tiempo es
--
--    +-----+---------+--------+
--    |   n | 1ª def. | 2ª def |
--    +-----+---------+--------+
--    |  50 |  0.24   | 0.00   |
--    | 100 |  1.98   | 0.00   |
--    | 200 | 17.96   | 0.00   | 
--    +-----+---------+--------+

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

import Data.Matrix

import Data.Maybe (isJust, fromJust)

import Test.QuickCheck

-- Definición de minimasDistancias

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

minimasDistancias :: Matrix Int -> Matrix Int

minimasDistancias a = fmap fromJust (aux (matrizInicial a))

where aux b | Nothing `elem` c = aux c

| otherwise = c

where c = propagacion b

-- (matrizInicial a) es la matriz que tiene (Just 0) en los elementos de

-- a iguales a 1 y Nothing en los restantes. Por ejemplo,

-- λ> matrizInicial (fromLists [[0,0,1],[1,0,0]])

-- ( Nothing Nothing Just 0 )

-- ( Just 0 Nothing Nothing )

matrizInicial :: Matrix Int -> Matrix (Maybe Int)

matrizInicial a = matrix m n f

where m = nrows a

n = ncols a

f (i,j) | a ! (i,j) == 1 = Just 0

| otherwise = Nothing

-- (propagacion a) es la matriz obtenida cambiando los elementos Nothing

-- de a por el sigiente del mínomo de los valores de sus vecinos. Por

-- ejemplo,

-- λ> propagacion (fromLists [[0,1,1],[0,0,1]])

-- ( Just 1 Just 0 Just 0 )

-- ( Nothing Just 1 Just 0 )

-- λ> propagacion it

-- ( Just 1 Just 0 Just 0 )

-- ( Just 2 Just 1 Just 0 )

propagacion :: Matrix (Maybe Int) -> Matrix (Maybe Int)

propagacion a = matrix m n f

where

m = nrows a

n = ncols a

f (i,j) | isJust x = x

| otherwise = siguiente (minimo (valoresVecinos a (i,j)))

where x = a ! (i,j)

-- (valoresVecinos a p) es la lista de los valores de los vecinos la

-- posición p en la matriz a. Por ejemplo,

-- λ> a = fromList 3 4 [1..]

-- λ> a

-- ( 1 2 3 4 )

-- ( 5 6 7 8 )

-- ( 9 10 11 12 )

-- λ> valoresVecinos a (1,1)

-- [5,2]

-- λ> valoresVecinos a (2,3)

-- [3,11,6,8]

-- λ> valoresVecinos a (2,4)

-- [4,12,7]

valoresVecinos :: Matrix a -> (Int,Int) -> [a]

valoresVecinos a (i,j) = [a ! (k,l) | (k,l) <- vecinos m n (i,j)]

where m = nrows a

n = ncols a

-- (vecinos m n p) es la lista de las posiciones vecinas de la posición

-- p en la matriz a; es decir, los que se encuentran a su izquierda,

-- derecha, arriba o abajo. por ejemplo,

-- vecinos 3 4 (1,1) == [(2,1),(1,2)]

-- vecinos 3 4 (2,3) == [(1,3),(3,3),(2,2),(2,4)]

-- vecinos 3 4 (2,4) == [(1,4),(3,4),(2,3)]

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

vecinos m n (i,j) = [(i - 1,j) | i > 1] ++

[(i + 1,j) | i < m] ++

[(i, j - 1) | j > 1] ++

[(i, j + 1) | j < n]

-- (minimo xs) es el mínimo de la lista de valores opcionales xs

-- (considerando Nothing como el mayor elemento). Por ejemplo,

-- minimo [Just 3, Nothing, Just 2] == Just 2

minimo :: [Maybe Int] -> Maybe Int

minimo = foldr1 minimo2

-- (minimo2 x y) es el mínimo de los valores opcionales x e y

-- (considerando Nothing como el mayor elemento). Por ejemplo,

-- minimo2 (Just 3) (Just 2) == Just 2

-- minimo2 (Just 1) (Just 2) == Just 1

-- minimo2 (Just 1) Nothing == Just 1

-- minimo2 Nothing (Just 2) == Just 2

-- minimo2 Nothing Nothing == Nothing

minimo2 :: Maybe Int -> Maybe Int -> Maybe Int

minimo2 (Just x) (Just y) = Just (min x y)

minimo2 Nothing (Just y) = Just y

minimo2 (Just x) Nothing = Just x

minimo2 Nothing Nothing = Nothing

-- (siguiente x) es el siguiente elemento del opcional x (considerando

-- Nothing como el infinito). Por ejemplo,

-- siguiente (Just 3) == Just 4

-- siguiente Nothing == Nothing

siguiente :: Maybe Int -> Maybe Int

siguiente (Just x) = Just (1 + x)

siguiente Nothing = Nothing

-- 1ª definición de sumaMinimaDistanciasIdentidad

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

sumaMinimaDistanciasIdentidad :: Int -> Int

sumaMinimaDistanciasIdentidad n =

sum (minimasDistancias (identity n))

-- 2ª definición de sumaMinimaDistanciasIdentidad

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

sumaMinimaDistanciasIdentidad2 :: Int -> Int

sumaMinimaDistanciasIdentidad2 n =

n*(n^2-1) `div` 3

-- Equivalencia de las definiciones de sumaMinimaDistanciasIdentidad

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

-- La propiedad es

prop_MinimaDistanciasIdentidad :: Positive Int -> Bool

prop_MinimaDistanciasIdentidad (Positive n) =

sumaMinimaDistanciasIdentidad n == sumaMinimaDistanciasIdentidad2 n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=50}) prop_MinimaDistanciasIdentidad

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaMinimaDistanciasIdentidad 50

-- 41650

-- (0.24 secs, 149,395,744 bytes)

-- λ> sumaMinimaDistanciasIdentidad 100

-- 333300

-- (1.98 secs, 1,294,676,272 bytes)

-- λ> sumaMinimaDistanciasIdentidad 200

-- 2666600

-- (17.96 secs, 11,094,515,016 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 50

-- 41650

-- (0.00 secs, 126,944 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 100

-- 333300

-- (0.00 secs, 126,872 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 200

-- 2666600

-- (0.00 secs, 131,240 bytes)

-- Resumidamente, el tiempo es

-- +-----+---------+--------+

-- | n | 1ª def. | 2ª def |

-- +-----+---------+--------+

-- | 50 | 0.24 | 0.00 |

-- | 100 | 1.98 | 0.00 |

-- | 200 | 17.96 | 0.00 |

-- +-----+---------+--------+

Pensamiento

La primavera ha venido.
Nadie sabe como ha sido.

Antonio Machado

La sucesión ECG

PorJosé A. Alonso 21-marzo-201925-abril-2021

La sucesión ECG estás definida por a(1) = 1, a(2) = 2 y, para n >= 3, a(n) es el menor natural que aún no está en la sucesión tal que a(n) tiene algún divisor común con a(n-1).

Los primeros términos de la sucesión son 1, 2, 4, 6, 3, 9, 12, 8, 10, 5, 15, …

Al dibujar su gráfica, se parece a la de los electrocardiogramas (abreviadamente, ECG). Por ello, la sucesión se conoce como la sucesión ECG.

Definir las funciones

   sucECG :: [Integer]
   graficaSucECG :: Int -> IO ()

1 2	sucECG :: [Integer] graficaSucECG :: Int -> IO ()

tales que

sucECG es la lista de los términos de la sucesión ECG. Por ejemplo,

     λ> take 20 sucECG
     [1,2,4,6,3,9,12,8,10,5,15,18,14,7,21,24,16,20,22,11]
     λ> sucECG !! 6000
     6237

λ> take 20 sucECG

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

λ> sucECG !! 6000

6237

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

Soluciones

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

sucECG :: [Integer]
sucECG = 1 : ecg 2 [2..]
  where ecg x zs = f zs
          where f (y:ys) | gcd x y > 1 = y : ecg y (delete y zs)
                         | otherwise   = f ys

graficaSucECG :: Int -> IO ()
graficaSucECG n =
  plotList [ Key Nothing
           , PNG "La_sucesion_ECG.png" 
           ]
           (take n sucECG)

import Data.List (delete)

import Graphics.Gnuplot.Simple

sucECG :: [Integer]

sucECG = 1 : ecg 2 [2..]

where ecg x zs = f zs

where f (y:ys) | gcd x y > 1 = y : ecg y (delete y zs)

| otherwise = f ys

graficaSucECG :: Int -> IO ()

graficaSucECG n =

plotList [ Key Nothing

, PNG "La_sucesion_ECG.png"

]

(take n sucECG)

Pensamiento

Algunos desesperados
sólo se curan con soga;
otros, con siete palabras:
la fe se ha puesto de moda.

Antonio Machado

Siguiente mayor

PorJosé A. Alonso 20-marzo-201926-marzo-2022

Definir la función

   siguienteMayor :: Ord a => [a] -> [Maybe a]

1	siguienteMayor :: Ord a => [a] -> [Maybe a]

tal que (siguienteMayos xs) es la lista obtenida sustiyendo cada elemento de xs por el primer elemento de xs a la derechha de x que sea mayor que x, si existe y Nothing en caso contrario. Por ejemplo,

   λ> siguienteMayor [4,5,2,3,9]
   [Just 5,Just 9,Just 3,Just 9,Nothing]
   λ> siguienteMayor [9,5,2,3,4]
   [Nothing,Nothing,Just 3,Just 4,Nothing]
   λ> siguienteMayor [9,5,2,2,4]
   [Nothing,Nothing,Just 4,Just 4,Nothing]
   λ> siguienteMayor "betis"
   [Just 'e',Just 't',Nothing,Just 's',Nothing]
   λ> siguienteMayor "sevilla"
   [Just 'v',Just 'v',Nothing,Just 'l',Nothing,Nothing,Nothing]

λ> siguienteMayor [4,5,2,3,9]

[Just 5,Just 9,Just 3,Just 9,Nothing]

λ> siguienteMayor [9,5,2,3,4]

[Nothing,Nothing,Just 3,Just 4,Nothing]

λ> siguienteMayor [9,5,2,2,4]

[Nothing,Nothing,Just 4,Just 4,Nothing]

λ> siguienteMayor "betis"

[Just 'e',Just 't',Nothing,Just 's',Nothing]

λ> siguienteMayor "sevilla"

[Just 'v',Just 'v',Nothing,Just 'l',Nothing,Nothing,Nothing]

Soluciones

import Data.Maybe (listToMaybe)

-- 1ª solución
siguienteMayor :: Ord a => [a] -> [Maybe a]
siguienteMayor [] = []
siguienteMayor (x:xs)
  | null ys   = Nothing : siguienteMayor xs
  | otherwise = Just (head ys) : siguienteMayor xs
  where ys = [y | y <- xs, y > x]

-- 2ª solución
siguienteMayor2 :: Ord a => [a] -> [Maybe a]
siguienteMayor2 []     = []
siguienteMayor2 (x:xs) = listToMaybe [y | y <- xs, y > x] : siguienteMayor2 xs

-- 3ª solución
siguienteMayor3 :: Ord a => [a] -> [Maybe a]
siguienteMayor3 []     = []
siguienteMayor3 (x:xs) = listToMaybe (dropWhile (<=x) xs) : siguienteMayor3 xs

import Data.Maybe (listToMaybe)

-- 1ª solución

siguienteMayor :: Ord a => [a] -> [Maybe a]

siguienteMayor [] = []

siguienteMayor (x:xs)

| null ys = Nothing : siguienteMayor xs

| otherwise = Just (head ys) : siguienteMayor xs

where ys = [y | y <- xs, y > x]

-- 2ª solución

siguienteMayor2 :: Ord a => [a] -> [Maybe a]

siguienteMayor2 [] = []

siguienteMayor2 (x:xs) = listToMaybe [y | y <- xs, y > x] : siguienteMayor2 xs

-- 3ª solución

siguienteMayor3 :: Ord a => [a] -> [Maybe a]

siguienteMayor3 [] = []

siguienteMayor3 (x:xs) = listToMaybe (dropWhile (<=x) xs) : siguienteMayor3 xs

Pensamiento

Si vivir es bueno
es mejor soñar,
y mejor que todo,
madre, despertar.

Antonio Machado

Caminos minimales en un árbol numérico

PorJosé A. Alonso 19-marzo-201930-marzo-2019

En la librería Data.Tree se definen los tipos de árboles y bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Los mayores divisores de un número x son los divisores u tales que u > 1 y existe un v tal que 1 < v < u y u.v = x. Por ejemplo, los mayores divisores de 24 son 12, 8 y 6.

El árbol de los predecesores y mayores divisores de un número x es el árbol cuya raíz es x y los sucesores de cada nodo y > 1 es el conjunto formado por y-1 junto con los mayores divisores de y. Los nodos con valor 1 no tienen sucesores. Por ejemplo, el árbol de los predecesores y mayores divisores del número 6 es

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

   mayoresDivisores :: Int -> [Int]
   arbol            :: Int -> Tree Int
   caminos          :: Int -> [[Int]]
   caminosMinimales :: Int -> [[Int]]

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que
+ (mayoresDivisores x) es la lista de los mayores divisores de x. Por ejemplo,

     mayoresDivisores 24  ==  [12,8,6]
     mayoresDivisores 16  ==  [8,4]
     mayoresDivisores 10  ==  [5]
     mayoresDivisores 17  ==  []

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

(arbol x) es el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> putStrLn (drawTree (fmap show (arbol 6)))
     6
     |
     +- 5
     |  |
     |  `- 4
     |     |
     |     +- 3
     |     |  |
     |     |  `- 2
     |     |     |
     |     |     `- 1
     |     |
     |     `- 2
     |        |
     |        `- 1
     |
     `- 3
        |
        `- 2
           |
           `- 1

λ> putStrLn (drawTree (fmap show (arbol 6)))

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

(caminos x) es la lista de los caminos en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminos 6
     [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

1 2	λ> caminos 6 [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]

(caminosMinimales x) es la lista de los caminos en de menor longitud en el árbol de los predecesores y mayores divisores del número x. Por ejemplo,

     λ> caminosMinimales 6
     [[6,3,2,1]]
     λ> caminosMinimales 17
     [[17,16,4,2,1]]
     λ> caminosMinimales 50
     [[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

[[17,16,4,2,1]]

λ> caminosMinimales 50

[[50,25,5,4,2,1],[50,10,9,3,2,1],[50,10,5,4,2,1]]

Soluciones

import Data.Tree
import Test.QuickCheck

mayoresDivisores :: Int -> [Int]
mayoresDivisores x =
  [max u v | u <- [2..floor (sqrt (fromIntegral x))]
           , x `mod` u == 0
           , let v = x `div` u]  

arbol :: Int -> Tree Int
arbol 1 = Node 1 []
arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]
caminos = caminosArbol . arbol

--    λ> caminosArbol (arbol 6)
--    [[6,5,4,3,2,1],[6,5,4,2,1],[6,3,2,1]]
caminosArbol :: Tree a -> [[a]]
caminosArbol (Node x []) = [[x]]
caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]
caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]
caminosMinimales x = [ys | ys <- yss, length ys == m]
  where yss = caminos x
        m   = minimum (map length yss)

import Data.Tree

import Test.QuickCheck

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

[max u v | u <- [2..floor (sqrt (fromIntegral x))]

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

arbol x = Node x (arbol (x-1) : [arbol y | y <- mayoresDivisores x])

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

caminosArbol :: Tree a -> [[a]]

caminosArbol (Node x []) = [[x]]

caminosArbol (Node x as) = [x:ys | ys <- caminosBosque as]

caminosBosque :: Forest a -> [[a]]

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

caminosMinimales x = [ys | ys <- yss, length ys == m]

where yss = caminos x

m = minimum (map length yss)

Pensamiento

Tras el vivir y el soñar,
está lo que más importa:
despertar.

Antonio Machado

Permutación de elementos consecutivos

PorJosé A. Alonso 18-marzo-201925-marzo-2019

Definir la función

   permutaConsecutivos :: [a] -> [a]

1	permutaConsecutivos :: [a] -> [a]

tal que (permutaConsecutivos xs) es la lista obtenida permutando los elementos consecutivos de xs. Por ejemplo,

   permutaConsecutivos [1..8]         ==  [2,1,4,3,6,5,8,7]
   permutaConsecutivos [1..9]         ==  [2,1,4,3,6,5,8,7,9]
   permutaConsecutivos "simplemente"  ==  "ispmelemtne"

permutaConsecutivos [1..8] == [2,1,4,3,6,5,8,7]

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

permutaConsecutivos "simplemente" == "ispmelemtne"

Soluciones

import Data.Array

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

permutaConsecutivos :: [a] -> [a]
permutaConsecutivos (x:y:zs) = y : x : permutaConsecutivos zs
permutaConsecutivos xs       = xs

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

permutaConsecutivos2 :: [a] -> [a]
permutaConsecutivos2 xs 
  | even n    = elems (array (1,n) [(i,f i) | i <- [1..n]])
  | otherwise = elems (array (1,n) ((n,v!n) : [(i,f i) | i <- [1..n-1]]))
  where
    n = length xs
    v = listArray (1,n) xs
    f i | even i =    v ! (i - 1)
        | otherwise = v ! (i + 1)
    
-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (permutaConsecutivos [1..(3*10^6)])
--    3000000
--    (2.21 secs, 504,102,648 bytes)
--    λ> length (permutaConsecutivos2 [1..(3*10^6)])
--    3000000
--    (6.18 secs, 1,248,127,688 bytes)

import Data.Array

-- 1ª solución

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

permutaConsecutivos :: [a] -> [a]

permutaConsecutivos (x:y:zs) = y : x : permutaConsecutivos zs

permutaConsecutivos xs = xs

-- 2ª solución

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

permutaConsecutivos2 :: [a] -> [a]

permutaConsecutivos2 xs

| even n = elems (array (1,n) [(i,f i) | i <- [1..n]])

| otherwise = elems (array (1,n) ((n,v!n) : [(i,f i) | i <- [1..n-1]]))

where

n = length xs

v = listArray (1,n) xs

f i | even i = v ! (i - 1)

| otherwise = v ! (i + 1)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (permutaConsecutivos [1..(3*10^6)])

-- 3000000

-- (2.21 secs, 504,102,648 bytes)

-- λ> length (permutaConsecutivos2 [1..(3*10^6)])

-- 3000000

-- (6.18 secs, 1,248,127,688 bytes)

Pensamiento

Entre el vivir y el soñar
hay una tercera cosa.
Adivínala.

Antonio Machado

Cambio con el menor número de monedas

PorJosé A. Alonso 15-marzo-201926-marzo-2022

El problema del cambio con el menor número de monedas consiste en, dada una lista ms de tipos de monedas (con infinitas monedas de cada tipo) y una cantidad objetivo x, calcular el menor número de monedas de ms cuya suma es x. Por ejemplo, con monedas de 1, 3 y 4 céntimos se puede obtener 6 céntimos de 4 formas

   1, 1, 1, 1, 1, 1
   1, 1, 1, 3
   1, 1, 4
   3, 3

1, 1, 1, 1, 1, 1

1, 1, 1, 3

1, 1, 4

3, 3

El menor número de monedas que se necesita es 2. En cambio, con monedas de 2, 5 y 10 es imposible obtener 3.

Definir

   monedas :: [Int] -> Int -> Maybe Int

1	monedas :: [Int] -> Int -> Maybe Int

tal que (monedas ms x) es el menor número de monedas de ms cuya suma es x, si es posible obtener dicha suma y es Nothing en caso contrario. Por ejemplo,

   monedas [1,3,4]  6                    ==  Just 2
   monedas [2,5,10] 3                    ==  Nothing
   monedas [1,2,5,10,20,50,100,200] 520  ==  Just 4

monedas [1,3,4] 6 == Just 2

monedas [2,5,10] 3 == Nothing

monedas [1,2,5,10,20,50,100,200] 520 == Just 4

Soluciones

import Data.Array ((!), array)

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

monedas :: [Int] -> Int -> Maybe Int
monedas ms x
  | null cs   = Nothing
  | otherwise = Just (minimum (map length cs))
  where cs = cambios ms x

-- (cambios ms x) es la lista de las foemas de obtener x sumando monedas
-- de ms. Por ejemplo,
--   λ> cambios [1,5,10] 12
--   [[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,5],[1,1,5,5],[1,1,10]]
--   λ> cambios [2,5,10] 3
--   []
--   λ> cambios [1,3,4] 6
--   [[1,1,1,1,1,1],[1,1,1,3],[1,1,4],[3,3]]
cambios :: [Int] -> Int -> [[Int]]
cambios _      0 = [[]]
cambios []     _ = []
cambios (k:ks) m
  | m < k     = []
  | otherwise = [k:zs | zs <- cambios (k:ks) (m - k)] ++
                cambios ks m

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

monedas2 :: [Int] -> Int -> Maybe Int
monedas2 ms n
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = aux n
    aux 0 = 0
    aux k = siguiente (minimo [aux (k - x) | x <- ms,  k >= x])

infinito :: Int
infinito = 10^30

minimo :: [Int] -> Int
minimo [] = infinito
minimo xs = minimum xs

siguiente :: Int -> Int
siguiente x | x == infinito = infinito
            | otherwise     = 1 + x

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

monedas3 :: [Int] -> Int -> Maybe Int
monedas3 ms n  
  | sol == infinito = Nothing
  | otherwise       = Just sol
  where
    sol = v ! n
    v   = array (0,n) [(i,f i) | i <- [0..n]]
    f 0 = 0
    f k = siguiente (minimo [v ! (k - x) | x <- ms, k >= x])

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

--    λ> monedas [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.02 secs, 871,144 bytes)
--    λ> monedas2 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (15.44 secs, 1,866,519,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 27
--    Just 3
--    (0.01 secs, 157,232 bytes)
--    
--    λ> monedas [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (14.20 secs, 1,845,293,080 bytes)
--    λ> monedas3 [1,2,5,10,20,50,100,200] 188
--    Just 7
--    (0.01 secs, 623,376 bytes)

import Data.Array ((!), array)

-- 1ª solución

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

monedas :: [Int] -> Int -> Maybe Int

monedas ms x

| null cs = Nothing

| otherwise = Just (minimum (map length cs))

where cs = cambios ms x

-- (cambios ms x) es la lista de las foemas de obtener x sumando monedas

-- de ms. Por ejemplo,

-- λ> cambios [1,5,10] 12

-- [[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,5],[1,1,5,5],[1,1,10]]

-- λ> cambios [2,5,10] 3

-- []

-- λ> cambios [1,3,4] 6

-- [[1,1,1,1,1,1],[1,1,1,3],[1,1,4],[3,3]]

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

cambios _ 0 = [[]]

cambios [] _ = []

cambios (k:ks) m

| m < k = []

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

cambios ks m

-- 2ª solución

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

monedas2 :: [Int] -> Int -> Maybe Int

monedas2 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = aux n

aux 0 = 0

aux k = siguiente (minimo [aux (k - x) | x <- ms, k >= x])

infinito :: Int

infinito = 10^30

minimo :: [Int] -> Int

minimo [] = infinito

minimo xs = minimum xs

siguiente :: Int -> Int

siguiente x | x == infinito = infinito

| otherwise = 1 + x

-- 3ª solución

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

monedas3 :: [Int] -> Int -> Maybe Int

monedas3 ms n

| sol == infinito = Nothing

| otherwise = Just sol

where

sol = v ! n

v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 0

f k = siguiente (minimo [v ! (k - x) | x <- ms, k >= x])

-- Comparación de eficiencia

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

-- λ> monedas [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (0.02 secs, 871,144 bytes)

-- λ> monedas2 [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (15.44 secs, 1,866,519,080 bytes)

-- λ> monedas3 [1,2,5,10,20,50,100,200] 27

-- Just 3

-- (0.01 secs, 157,232 bytes)

-- λ> monedas [1,2,5,10,20,50,100,200] 188

-- Just 7

-- (14.20 secs, 1,845,293,080 bytes)

-- λ> monedas3 [1,2,5,10,20,50,100,200] 188

-- Just 7

-- (0.01 secs, 623,376 bytes)

Pensamiento

Demos tiempo al tiempo:
para que el vaso rebose
hay que llenarlo primero.

Antonio Machado

Máxima longitud de sublistas crecientes

PorJosé A. Alonso 14-marzo-201925-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]]
   λ> longitudMayorSublistaCreciente2 xs
   61
   λ> longitudMayorSublistaCreciente3 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]]

λ> longitudMayorSublistaCreciente2 xs

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

Pensamiento

No es el yo fundamental
eso que busca el poeta,
sino el tú esencial.

Antonio Machado

Diagonales invertidas

PorJosé A. Alonso 13-marzo-201925-abril-2021

Definir la función

   diagonalesInvertidas :: Matrix a -> Matrix a

1	diagonalesInvertidas :: Matrix a -> Matrix a

tal que (diagonalesInvertidas q) es la matriz obtenida invirtiendo el
orden de los elementos de la diagonal principal y de la diagonal
secundaria de q. Por ejemplo,

   λ> fromList 5 5 [1..]
   ┌                ┐
   │  1  2  3  4  5 │
   │  6  7  8  9 10 │
   │ 11 12 13 14 15 │
   │ 16 17 18 19 20 │
   │ 21 22 23 24 25 │
   └                ┘
   λ> diagonalesInvertidas (fromList 5 5 [1..])
   ┌                ┐
   │ 25  2  3  4 21 │
   │  6 19  8 17 10 │
   │ 11 12 13 14 15 │
   │ 16  9 18  7 20 │
   │  5 22 23 24  1 │
   └                ┘
   λ> fromList 3 3 ['a','b'..]
   ┌             ┐
   │ 'a' 'b' 'c' │
   │ 'd' 'e' 'f' │
   │ 'g' 'h' 'i' │
   └             ┘
   λ> diagonalesInvertidas (fromList 3 3 ['a','b'..])
   ┌             ┐
   │ 'i' 'b' 'g' │
   │ 'd' 'e' 'f' │
   │ 'c' 'h' 'a' │
   └             ┘

λ> fromList 5 5 [1..]

┌ ┐

│ 1 2 3 4 5 │

│ 6 7 8 9 10 │

│ 11 12 13 14 15 │

│ 16 17 18 19 20 │

│ 21 22 23 24 25 │

└ ┘

λ> diagonalesInvertidas (fromList 5 5 [1..])

┌ ┐

│ 25 2 3 4 21 │

│ 6 19 8 17 10 │

│ 11 12 13 14 15 │

│ 16 9 18 7 20 │

│ 5 22 23 24 1 │

└ ┘

λ> fromList 3 3 ['a','b'..]

┌ ┐

│ 'a' 'b' 'c' │

│ 'd' 'e' 'f' │

│ 'g' 'h' 'i' │

└ ┘

λ> diagonalesInvertidas (fromList 3 3 ['a','b'..])

┌ ┐

│ 'i' 'b' 'g' │

│ 'd' 'e' 'f' │

│ 'c' 'h' 'a' │

└ ┘

Soluciones

import Data.Matrix

diagonalesInvertidas :: Matrix a -> Matrix a
diagonalesInvertidas q = matrix n n f
  where n = nrows q
        f (i,j) | i == j     = q ! (n + 1 - i, n + 1 - i)
                | i+j == n+1 = q ! (j,i)
                | otherwise  = q ! (i,j)

import Data.Matrix

diagonalesInvertidas :: Matrix a -> Matrix a

diagonalesInvertidas q = matrix n n f

where n = nrows q

f (i,j) | i == j = q ! (n + 1 - i, n + 1 - i)

| i+j == n+1 = q ! (j,i)

| otherwise = q ! (i,j)

Pensamiento

Despertad, cantores:
acaben los ecos,
empiecen las voces.

Antonio Machado

Números cíclopes

PorJosé A. Alonso 12-marzo-201926-marzo-2022

Un número cíclope es un número natural cuya representación binaria sólo tiene un cero en el centro. Por ejemplo,

     0      es ciclope porque su representación binaria es 0       
     1   no es ciclope porque su representación binaria es 1       
     5      es ciclope porque su representación binaria es 101     
     9   no es ciclope porque su representación binaria es 1001    
    10   no es ciclope porque su representación binaria es 1010    
    27      es ciclope porque su representación binaria es 11011   
    85   no es ciclope porque su representación binaria es 1010101 
   101   no es ciclope porque su representación binaria es 1100101 
   111   no es ciclope porque su representación binaria es 1101111 
   119      es ciclope porque su representación binaria es 1110111

0 es ciclope porque su representación binaria es 0

1 no es ciclope porque su representación binaria es 1

5 es ciclope porque su representación binaria es 101

9 no es ciclope porque su representación binaria es 1001

10 no es ciclope porque su representación binaria es 1010

27 es ciclope porque su representación binaria es 11011

85 no es ciclope porque su representación binaria es 1010101

101 no es ciclope porque su representación binaria es 1100101

111 no es ciclope porque su representación binaria es 1101111

119 es ciclope porque su representación binaria es 1110111

Definir las funciones

   esCiclope       :: Integer -> Bool
   ciclopes        :: [Integer]
   graficaCiclopes :: Int -> IO ()

esCiclope :: Integer -> Bool

ciclopes :: [Integer]

graficaCiclopes :: Int -> IO ()

tales que

(esCiclope n) se verifica si el número natual n es cíclope. Por ejemplo,

      esCiclope 0    ==  True
      esCiclope 1    ==  False
      esCiclope 5    ==  True
      esCiclope 9    ==  False
      esCiclope 10   ==  False
      esCiclope 27   ==  True
      esCiclope 85   ==  False
      esCiclope 101  ==  False
      esCiclope 111  ==  False
      esCiclope 119  ==  True

esCiclope 0 == True

esCiclope 1 == False

esCiclope 5 == True

esCiclope 9 == False

esCiclope 10 == False

esCiclope 27 == True

esCiclope 85 == False

esCiclope 101 == False

esCiclope 111 == False

esCiclope 119 == True

ciclopes es la lista de los número cíclopes. Por ejemplo,

     λ> take 12 ciclopes
     [0,5,27,119,495,2015,8127,32639,130815,523775,2096127,8386559]
     λ> length (show (ciclopes !! (10^5)))
     60207

λ> take 12 ciclopes

[0,5,27,119,495,2015,8127,32639,130815,523775,2096127,8386559]

λ> length (show (ciclopes !! (10^5)))

60207

(graficaCiclopes n) dibuja la gráfica del último dígito de los n primeros números cíclopes. Por ejemplo, (graficaCiclopes n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

--    esCiclope 5  ==  True
--    esCiclope 6  ==  False
esCiclope :: Integer -> Bool
esCiclope n =
  esCiclopeBinario (decimalAbinario n)

--    decimalAbinario 4  ==  [0,0,1]
--    decimalAbinario 5  ==  [1,0,1]
--    decimalAbinario 6  ==  [0,1,1]
decimalAbinario :: Integer -> [Integer]
decimalAbinario 0 = [0]
decimalAbinario 1 = [1]
decimalAbinario n = r : decimalAbinario q
  where (q,r) = quotRem n 2

--    esCiclopeBinario [1,1,0,1,1]  ==  True
--    esCiclopeBinario [1,1,0,1]  ==  False
--    esCiclopeBinario [1,1,2,1,1]  ==  False
--    esCiclopeBinario [2,2,0,2,2]  ==  False
esCiclopeBinario :: [Integer] -> Bool
esCiclopeBinario xs =
  odd n && xs == ys ++ 0 : ys
  where n  = length xs
        m  = n `div` 2
        ys = replicate m 1

--    take 8 ciclopes  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes :: [Integer]
ciclopes = filter esCiclope [0..]

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

--    take 8 ciclopes2  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes2 :: [Integer]
ciclopes2 =
  [binarioAdecimal (replicate n 1 ++ 0 : replicate n 1) | n <- [0..]]

--    binarioAdecimal [0,1,1]  ==  6
binarioAdecimal :: [Integer] -> Integer
binarioAdecimal [x]    = x
binarioAdecimal (x:xs) = x + 2 * binarioAdecimal xs

esCiclope2 :: Integer -> Bool
esCiclope2 n =
  n `pertenece` ciclopes2

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

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

--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes3 :: [Integer]
ciclopes3 =
  [sum [2^k | k <- [0..n-1]] + sum [2^k | k <- [n+1..n+n]] | n <- [0..]]

esCiclope3 :: Integer -> Bool
esCiclope3 n =
  n `pertenece` ciclopes3

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

--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes4 :: [Integer]
ciclopes4 =
  [2^(2*n+1) - 1 - 2^n | n <- [0..]]

esCiclope4 :: Integer -> Bool
esCiclope4 n =
  n `pertenece` ciclopes4


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

--    take 8 ciclopes5  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes5 :: [Integer]
ciclopes5 =
  [2*4^n - 1 - 2^n | n <- [0..]]

esCiclope5 :: Integer -> Bool
esCiclope5 n =
  n `pertenece` ciclopes5

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

--    take 8 ciclopes6  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes6 :: [Integer]
ciclopes6 =
  [2*x*x - 1 - x | x <- iterate (*2) 1]
  
esCiclope6 :: Integer -> Bool
esCiclope6 n =
  n `pertenece` ciclopes6



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

--    λ> ciclopes !! 9
--    523775
--    (6.68 secs, 4,696,734,960 bytes)
--    λ> ciclopes2 !! 9
--    523775
--    (0.00 secs, 134,664 bytes)
--    λ> ciclopes3 !! 9
--    523775
--    (0.00 secs, 150,920 bytes)
--    λ> ciclopes4 !! 9
--    523775
--    (0.01 secs, 131,936 bytes)
--    λ> ciclopes5 !! 9
--    523775
--    (0.00 secs, 132,064 bytes)
--
--    λ> length (show (ciclopes2 !! (3*10^4)))
--    18063
--    (0.65 secs, 486,437,480 bytes)
--    λ> length (show (ciclopes3 !! (3*10^4)))
--    18063
--    (2.94 secs, 1,188,645,584 bytes)
--    λ> length (show (ciclopes4 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,769,592 bytes)
--    λ> length (show (ciclopes5 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,773,552 bytes)
--
--    λ> length (show (ciclopes2 !! (10^5)))
--    60207
--    (6.42 secs, 5,148,671,368 bytes)
--    λ> length (show (ciclopes4 !! (10^5)))
--    60207
--    (0.07 secs, 22,291,480 bytes)
--    λ> length (show (ciclopes5 !! (10^5)))
--    60207
--    (0.04 secs, 22,316,216 bytes)
--    
--    λ> length (show (ciclopes4 !! (5*10^6)))
--    3010301
--    (2.34 secs, 1,116,327,832 bytes)
--    λ> length (show (ciclopes5 !! (5*10^6)))
--    3010301
--    (2.39 secs, 1,099,177,056 bytes)

-- Definición de graficaCiclopes
-- =============================

graficaCiclopes :: Int -> IO ()
graficaCiclopes n =
  plotList [ Key Nothing
           -- , PNG "Numeros_ciclopes.png"
           ]
           [x `mod` 10 | x <- take n ciclopes5]

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

import Graphics.Gnuplot.Simple

-- 1ª solución

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

-- esCiclope 5 == True

-- esCiclope 6 == False

esCiclope :: Integer -> Bool

esCiclope n =

esCiclopeBinario (decimalAbinario n)

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

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

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

decimalAbinario :: Integer -> [Integer]

decimalAbinario 0 = [0]

decimalAbinario 1 = [1]

decimalAbinario n = r : decimalAbinario q

where (q,r) = quotRem n 2

-- esCiclopeBinario [1,1,0,1,1] == True

-- esCiclopeBinario [1,1,0,1] == False

-- esCiclopeBinario [1,1,2,1,1] == False

-- esCiclopeBinario [2,2,0,2,2] == False

esCiclopeBinario :: [Integer] -> Bool

esCiclopeBinario xs =

odd n && xs == ys ++ 0 : ys

where n = length xs

m = n `div` 2

ys = replicate m 1

-- take 8 ciclopes == [0,5,27,119,495,2015,8127,32639]

ciclopes :: [Integer]

ciclopes = filter esCiclope [0..]

-- 2ª solución

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

-- take 8 ciclopes2 == [0,5,27,119,495,2015,8127,32639]

ciclopes2 :: [Integer]

ciclopes2 =

[binarioAdecimal (replicate n 1 ++ 0 : replicate n 1) | n <- [0..]]

-- binarioAdecimal [0,1,1] == 6

binarioAdecimal :: [Integer] -> Integer

binarioAdecimal [x] = x

binarioAdecimal (x:xs) = x + 2 * binarioAdecimal xs

esCiclope2 :: Integer -> Bool

esCiclope2 n =

n `pertenece` ciclopes2

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

pertenece x ys =

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

-- 3ª solución

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

-- take 8 ciclopes3 == [0,5,27,119,495,2015,8127,32639]

ciclopes3 :: [Integer]

ciclopes3 =

[sum [2^k | k <- [0..n-1]] + sum [2^k | k <- [n+1..n+n]] | n <- [0..]]

esCiclope3 :: Integer -> Bool

esCiclope3 n =

n `pertenece` ciclopes3

-- 4ª solución

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

-- take 8 ciclopes3 == [0,5,27,119,495,2015,8127,32639]

ciclopes4 :: [Integer]

ciclopes4 =

[2^(2*n+1) - 1 - 2^n | n <- [0..]]

esCiclope4 :: Integer -> Bool

esCiclope4 n =

n `pertenece` ciclopes4

-- 5ª solución

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

-- take 8 ciclopes5 == [0,5,27,119,495,2015,8127,32639]

ciclopes5 :: [Integer]

ciclopes5 =

[2*4^n - 1 - 2^n | n <- [0..]]

esCiclope5 :: Integer -> Bool

esCiclope5 n =

n `pertenece` ciclopes5

-- 6ª solución

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

-- take 8 ciclopes6 == [0,5,27,119,495,2015,8127,32639]

ciclopes6 :: [Integer]

ciclopes6 =

[2*x*x - 1 - x | x <- iterate (*2) 1]

esCiclope6 :: Integer -> Bool

esCiclope6 n =

n `pertenece` ciclopes6

-- Comparación de eficiencia

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

-- λ> ciclopes !! 9

-- 523775

-- (6.68 secs, 4,696,734,960 bytes)

-- λ> ciclopes2 !! 9

-- 523775

-- (0.00 secs, 134,664 bytes)

-- λ> ciclopes3 !! 9

-- 523775

-- (0.00 secs, 150,920 bytes)

-- λ> ciclopes4 !! 9

-- 523775

-- (0.01 secs, 131,936 bytes)

-- λ> ciclopes5 !! 9

-- 523775

-- (0.00 secs, 132,064 bytes)

-- λ> length (show (ciclopes2 !! (3*10^4)))

-- 18063

-- (0.65 secs, 486,437,480 bytes)

-- λ> length (show (ciclopes3 !! (3*10^4)))

-- 18063

-- (2.94 secs, 1,188,645,584 bytes)

-- λ> length (show (ciclopes4 !! (3*10^4)))

-- 18063

-- (0.02 secs, 6,769,592 bytes)

-- λ> length (show (ciclopes5 !! (3*10^4)))

-- 18063

-- (0.02 secs, 6,773,552 bytes)

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

-- 60207

-- (6.42 secs, 5,148,671,368 bytes)

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

-- 60207

-- (0.07 secs, 22,291,480 bytes)

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

-- 60207

-- (0.04 secs, 22,316,216 bytes)

-- λ> length (show (ciclopes4 !! (5*10^6)))

-- 3010301

-- (2.34 secs, 1,116,327,832 bytes)

-- λ> length (show (ciclopes5 !! (5*10^6)))

-- 3010301

-- (2.39 secs, 1,099,177,056 bytes)

-- Definición de graficaCiclopes

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

graficaCiclopes :: Int -> IO ()

graficaCiclopes n =

plotList [ Key Nothing

-- , PNG "Numeros_ciclopes.png"

]

[x `mod` 10 | x <- take n ciclopes5]

Pensamiento

¿Sabes cuando el agua suena,
si es agua de cumbre o valle,
de plaza, jardín o huerta?
Cantores, dejad
palmas y jaleo
para los demás.

Antonio Machado

Combinaciones divisibles

PorJosé A. Alonso 11-marzo-201925-abril-2021

Definir la función

   tieneCombinacionDivisible :: [Int] -> Int -> Bool

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

tal que (tieneCombinacionDivisible xs m) se verifica si existe alguna forma de combinar todos los elementos de la lista (con las operaciones suma o resta) de forma que el resultado sea divisible por m. Por ejemplo,

   tieneCombinacionDivisible [1,3,4,6] 4  ==  True
   tieneCombinacionDivisible [1,3,9]   2  ==  False

1 2	tieneCombinacionDivisible [1,3,4,6] 4 == True tieneCombinacionDivisible [1,3,9] 2 == False

En el primer ejemplo, 1 – 2 + 3 + 4 + 6 = 12 es una combinación divisible por 4. En el segundo ejemplo, las combinaciones de [1,3,9] son

   1 + 3 + 9 =  13
  -1 + 3 + 9 =  11
   1 - 3 + 9 =   7
  -1 - 3 + 9 =   5
   1 + 3 - 9 =  -5
  -1 + 3 - 9 =  -7
   1 - 3 - 9 = -11
  -1 - 3 - 9 = -13

1 + 3 + 9 = 13

-1 + 3 + 9 = 11

1 - 3 + 9 = 7

-1 - 3 + 9 = 5

1 + 3 - 9 = -5

-1 + 3 - 9 = -7

1 - 3 - 9 = -11

-1 - 3 - 9 = -13

y ninguna de las 4 es divisible por 2.

Soluciones

import Test.QuickCheck

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

tieneCombinacionDivisible :: [Int] -> Int -> Bool
tieneCombinacionDivisible xs m =
  any esDivisible (valoresCombinaciones xs)
  where esDivisible x = x `mod` m == 0

-- (valoresCombinaciones xs) es la lista de los valores de todas las
-- combinaciones de todos los elementos de la lista con las operaciones
-- suma o resta. Por ejemplo,
--    λ> valoresCombinaciones [1,3,4,6]
--    [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]
--    λ> valoresCombinaciones [1,3,-4,6]
--    [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]
valoresCombinaciones :: [Int] -> [Int]
valoresCombinaciones []     = []
valoresCombinaciones [x]    = [x,-x]
valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]
  where ys = valoresCombinaciones xs

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

tieneCombinacionDivisible2 :: [Int] -> Int -> Bool
tieneCombinacionDivisible2 xs m =
  tieneCombinacionCongruente xs m 0

-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna
-- forma de combinar todos los elementos de la lista xs (con las
-- operaciones suma o resta) de forma que el resultado sea congruente
-- con a módulo m. Por ejemplo,
--    tieneCombinacionCongruente [1,3,4,6] 4 0  ==  True
--    tieneCombinacionCongruente [1,3,4,6] 4 1  ==  False
--    tieneCombinacionCongruente [1,3,9] 2 0    ==  False
--    tieneCombinacionCongruente [1,3,9] 2 1    ==  True
tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool
tieneCombinacionCongruente []  _  _ = False
tieneCombinacionCongruente [x] m  a = (x - a) `mod` m == 0
tieneCombinacionCongruente (x:xs) m a =
  tieneCombinacionCongruente xs m (a-x) ||
  tieneCombinacionCongruente xs m (a+x)

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

-- La propiedad es
prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool
prop_tieneCombinacionDivisible xs (Positive m) =
  tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=25}) prop_tieneCombinacionDivisible
--    +++ OK, passed 100 tests.

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

--    λ> (n,xs,m) = (200,[-n..n],sum [1..n]) 
--    (0.00 secs, 0 bytes)
--    λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]
--    True
--    (4.74 secs, 6,536,494,976 bytes)
--    λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]
--    True
--    (2.97 secs, 3,381,932,664 bytes)

import Test.QuickCheck

-- 1ª solución

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

tieneCombinacionDivisible :: [Int] -> Int -> Bool

tieneCombinacionDivisible xs m =

any esDivisible (valoresCombinaciones xs)

where esDivisible x = x `mod` m == 0

-- (valoresCombinaciones xs) es la lista de los valores de todas las

-- combinaciones de todos los elementos de la lista con las operaciones

-- suma o resta. Por ejemplo,

-- λ> valoresCombinaciones [1,3,4,6]

-- [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14]

-- λ> valoresCombinaciones [1,3,-4,6]

-- [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6]

valoresCombinaciones :: [Int] -> [Int]

valoresCombinaciones [] = []

valoresCombinaciones [x] = [x,-x]

valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys]

where ys = valoresCombinaciones xs

-- 2ª solución

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

tieneCombinacionDivisible2 :: [Int] -> Int -> Bool

tieneCombinacionDivisible2 xs m =

tieneCombinacionCongruente xs m 0

-- (tieneCombinacionCongruente xs m a) se verifica si existe alguna

-- forma de combinar todos los elementos de la lista xs (con las

-- operaciones suma o resta) de forma que el resultado sea congruente

-- con a módulo m. Por ejemplo,

-- tieneCombinacionCongruente [1,3,4,6] 4 0 == True

-- tieneCombinacionCongruente [1,3,4,6] 4 1 == False

-- tieneCombinacionCongruente [1,3,9] 2 0 == False

-- tieneCombinacionCongruente [1,3,9] 2 1 == True

tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool

tieneCombinacionCongruente [] _ _ = False

tieneCombinacionCongruente [x] m a = (x - a) `mod` m == 0

tieneCombinacionCongruente (x:xs) m a =

tieneCombinacionCongruente xs m (a-x) ||

tieneCombinacionCongruente xs m (a+x)

-- Equivalencia

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

-- La propiedad es

prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool

prop_tieneCombinacionDivisible xs (Positive m) =

tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=25}) prop_tieneCombinacionDivisible

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> (n,xs,m) = (200,[-n..n],sum [1..n])

-- (0.00 secs, 0 bytes)

-- λ> and [tieneCombinacionDivisible xs a | a <- [1..m]]

-- True

-- (4.74 secs, 6,536,494,976 bytes)

-- λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]]

-- True

-- (2.97 secs, 3,381,932,664 bytes)

Pensamiento

El que espera desespera,
dice la voz popular.
¡Qué verdad tan verdadera!
La verdad es lo que es,
y sigue siendo verdad
aunque se piense al revés.

Antonio Machado

Camino de máxima suma en una matriz

PorJosé A. Alonso 8-marzo-201925-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 800 800 [1..]))
   766721999

λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])

[1,7,12,8,4,9]

λ> sum (caminoMaxSuma (fromList 800 800 [1..]))

766721999

Soluciones

import Data.Matrix
import Test.QuickCheck

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

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

-- El generador es
instance Arbitrary a => Arbitrary (Matrix a) where
  arbitrary =  do
    m <- choose (1,7)
    n <- choose (1,7)
    xs <- Test.QuickCheck.vector (n*m)
    return (fromList m n xs)


-- Por ejemplo,
--    λ> sample' (arbitrary :: Gen (Matrix Int))
--    [( 0 )
--     ( 0 )
--     ( 0 )
--     ( 0 )
--    ,(  1  2 )
--     ( -1  1 )
--     ( -1 -2 )
--     (  1 -1 )
--     (  1  0 )
--     (  2  0 )
--     (  2 -2 )
--    ,( -4  4 -2 )
--     ( -2  0 -2 )
--     (  0 -1 -2 )
--     ( -4 -1  2 )
--    ,( -2  7 -3  1 -5 -3  5 )
--     (  0  2  7 -1 -5  7 -6 )
--     (  1  7 -8  1  6 -7  5 )
--     ( -4  7 -2 -7 -5  5 -8 )
--    ...

-- La propiedad es
prop_caminoMaxSuma :: Matrix Int -> Bool
prop_caminoMaxSuma m =
  x1 == x2 && x2 == x3
  where x1 = sum (caminoMaxSuma1 m)
        x2 = sum (caminoMaxSuma2 m)
        x3 = sum (caminoMaxSuma1 m)

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


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

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

import Data.Matrix

import Test.QuickCheck

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

-- Equivalencia de las definiciones

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

-- El generador es

instance Arbitrary a => Arbitrary (Matrix a) where

arbitrary = do

m <- choose (1,7)

n <- choose (1,7)

xs <- Test.QuickCheck.vector (n*m)

return (fromList m n xs)

-- Por ejemplo,

-- λ> sample' (arbitrary :: Gen (Matrix Int))

-- [( 0 )

-- ( 0 )

-- ,( 1 2 )

-- ( -1 1 )

-- ( -1 -2 )

-- ( 1 -1 )

-- ( 1 0 )

-- ( 2 0 )

-- ( 2 -2 )

-- ,( -4 4 -2 )

-- ( -2 0 -2 )

-- ( 0 -1 -2 )

-- ( -4 -1 2 )

-- ,( -2 7 -3 1 -5 -3 5 )

-- ( 0 2 7 -1 -5 7 -6 )

-- ( 1 7 -8 1 6 -7 5 )

-- ( -4 7 -2 -7 -5 5 -8 )

-- ...

-- La propiedad es

prop_caminoMaxSuma :: Matrix Int -> Bool

prop_caminoMaxSuma m =

x1 == x2 && x2 == x3

where x1 = sum (caminoMaxSuma1 m)

x2 = sum (caminoMaxSuma2 m)

x3 = sum (caminoMaxSuma1 m)

-- La comprobación es

-- λ> quickCheck prop_caminoMaxSuma

-- +++ OK, passed 100 tests.

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

Pensamiento

Caminante, no hay camino,
sino estelas en la mar.

Antonio Machado

Suma de segmentos iniciales

PorJosé A. Alonso 7-marzo-201925-abril-2021

Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.

Definir la función

   sumaSegmentosIniciales :: [Integer] -> Integer

1	sumaSegmentosIniciales :: [Integer] -> Integer

tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,

   sumaSegmentosIniciales [3,1,2,5]     ==  24
   sumaSegmentosIniciales3 [1..3*10^6]  ==  4500004500001000000

1 2	sumaSegmentosIniciales [3,1,2,5] == 24 sumaSegmentosIniciales3 [1..3*10^6] == 4500004500001000000

Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que

   sumaSegmentosIniciales (genericReplicate n 1)

1	sumaSegmentosIniciales (genericReplicate n 1)

es igual a

   n * (n + 1) `div` 2

1	n * (n + 1) `div` 2

Soluciones

import Data.List (genericLength, genericReplicate)
import Test.QuickCheck

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

sumaSegmentosIniciales :: [Integer] -> Integer
sumaSegmentosIniciales xs =
  sum [sum (take k xs) | k <- [1.. length xs]]

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

sumaSegmentosIniciales2 :: [Integer] -> Integer
sumaSegmentosIniciales2 xs =
  sum (zipWith (*) [n,n-1..1] xs)
  where n = genericLength xs

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

sumaSegmentosIniciales3 :: [Integer] -> Integer
sumaSegmentosIniciales3 xs =
  sum (scanl1 (+) xs)

-- Comprobación de la equivalencia
-- ===============================

-- La propiedad es
prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool
prop_sumaSegmentosInicialesEquiv xs =
  all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2
                                                  , sumaSegmentosIniciales3]]

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

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

--   λ> sumaSegmentosIniciales [1..10^4]
--   166716670000
--   (2.42 secs, 7,377,926,824 bytes)
--   λ> sumaSegmentosIniciales2 [1..10^4]
--   166716670000
--   (0.01 secs, 4,855,176 bytes)
--   
--   λ> sumaSegmentosIniciales2 [1..3*10^6]
--   4500004500001000000
--   (2.68 secs, 1,424,404,168 bytes)
--   λ> sumaSegmentosIniciales3 [1..3*10^6]
--   4500004500001000000
--   (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_sumaSegmentosIniciales :: Positive Integer -> Bool
prop_sumaSegmentosIniciales (Positive n) =
  sumaSegmentosIniciales3 (genericReplicate n 1) ==
  n * (n + 1) `div` 2

-- La compronación es
--   λ> quickCheck prop_sumaSegmentosIniciales
--   +++ OK, passed 100 tests.

import Data.List (genericLength, genericReplicate)

import Test.QuickCheck

-- 1ª solución

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

sumaSegmentosIniciales :: [Integer] -> Integer

sumaSegmentosIniciales xs =

sum [sum (take k xs) | k <- [1.. length xs]]

-- 2ª solución

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

sumaSegmentosIniciales2 :: [Integer] -> Integer

sumaSegmentosIniciales2 xs =

sum (zipWith (*) [n,n-1..1] xs)

where n = genericLength xs

-- 3ª solución

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

sumaSegmentosIniciales3 :: [Integer] -> Integer

sumaSegmentosIniciales3 xs =

sum (scanl1 (+) xs)

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool

prop_sumaSegmentosInicialesEquiv xs =

all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2

, sumaSegmentosIniciales3]]

-- La comprobación es

-- λ> quickCheck prop_sumaSegmentosInicialesEquiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> sumaSegmentosIniciales [1..10^4]

-- 166716670000

-- (2.42 secs, 7,377,926,824 bytes)

-- λ> sumaSegmentosIniciales2 [1..10^4]

-- 166716670000

-- (0.01 secs, 4,855,176 bytes)

-- λ> sumaSegmentosIniciales2 [1..3*10^6]

-- 4500004500001000000

-- (2.68 secs, 1,424,404,168 bytes)

-- λ> sumaSegmentosIniciales3 [1..3*10^6]

-- 4500004500001000000

-- (1.54 secs, 943,500,384 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_sumaSegmentosIniciales :: Positive Integer -> Bool

prop_sumaSegmentosIniciales (Positive n) =

sumaSegmentosIniciales3 (genericReplicate n 1) ==

n * (n + 1) `div` 2

-- La compronación es

-- λ> quickCheck prop_sumaSegmentosIniciales

-- +++ OK, passed 100 tests.

Pensamiento

Al andar se hace camino,
y al volver la vista atrás
se ve la senda que nunca
se ha de volver a pisar.

Antonio Machado

Números como suma de sus dígitos

PorJosé A. Alonso 6-marzo-201925-abril-2021

El número 23 se puede escribir de 4 formas como suma de sus dígitos

   2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3
   2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3
   2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3
   2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 2 + 3

2 + 2 + 2 + 2 + 2 + 2 + 2 + 3 + 3 + 3

2 + 2 + 2 + 2 + 3 + 3 + 3 + 3 + 3

2 + 3 + 3 + 3 + 3 + 3 + 3 + 3

La de menor número de sumando es la última, que tiene 8 sumandos.

Definir las funciones

   minimoSumandosDigitos        :: Integer -> Integer
   graficaMinimoSumandosDigitos :: Integer -> IO ()

1 2	minimoSumandosDigitos :: Integer -> Integer graficaMinimoSumandosDigitos :: Integer -> IO ()

tales que

(minimoSumandosDigitos n) es el menor número de dígitos de n cuya suma es n. Por ejemplo,

     minimoSumandosDigitos 23    ==  8
     minimoSumandosDigitos 232   ==  78
     minimoSumandosDigitos 2323  ==  775
     map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

minimoSumandosDigitos 23 == 8

minimoSumandosDigitos 232 == 78

minimoSumandosDigitos 2323 == 775

map minimoSumandosDigitos [10..20] == [10,11,6,5,5,3,6,5,4,3,10]

(graficaMinimoSumandosDigitos n) dibuja la gráfica de (minimoSumandosDigitos k) par los k primeros números naturales. Por ejemplo, (graficaMinimoSumandosDigitos 300) dibuja

Soluciones

import Data.List (nub, genericLength, sort)
import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer
minimoSumandosDigitos n =
  minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,
--    digitos 2032  ==  [2,3]
digitos :: Integer -> [Integer]
digitos n =
  nub [read [c] | c <- show n, c /= '0']

-- (minimoSumandos xs n) es el menor número de elementos de la lista de
-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por
-- ejemplo, 
--    minimoSumandos [7,2,4] 11  ==  2
minimoSumandos :: [Integer] -> Integer -> Integer
minimoSumandos xs n =
  minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros
-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,  
--    sumas [7,2,4] 11  ==  [[7,2,2],[7,4]]
sumas :: [Integer] -> Integer -> [[Integer]]
sumas [] 0 = [[]]
sumas [] _ = []
sumas (x:xs) n
  | x <= n    = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n
  | otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()
graficaMinimoSumandosDigitos n =
  plotList [ Key Nothing
           , PNG "Numero_como_suma_de_sus_digitos.png"
           ]
           [minimoSumandosDigitos k | k <- [0..n-1]]

import Data.List (nub, genericLength, sort)

import Graphics.Gnuplot.Simple

minimoSumandosDigitos :: Integer -> Integer

minimoSumandosDigitos n =

minimoSumandos (digitos n) n

-- (digitos n) es el conjunto de los dígitos no nulos de n. Por ejemplo,

-- digitos 2032 == [2,3]

digitos :: Integer -> [Integer]

digitos n =

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

-- (minimoSumandos xs n) es el menor número de elementos de la lista de

-- enteros positivos xs (con posibles repeticiones) cuya suma es n. Por

-- ejemplo,

-- minimoSumandos [7,2,4] 11 == 2

minimoSumandos :: [Integer] -> Integer -> Integer

minimoSumandos xs n =

minimum (mapo genericLength (sumas xs n))

-- (sumas xs n) es la lista de elementos de la lista de enteros

-- positivos xs (con posibles repeticiones) cuya suma es n. Por ejemplo,

-- sumas [7,2,4] 11 == [[7,2,2],[7,4]]

sumas :: [Integer] -> Integer -> [[Integer]]

sumas [] 0 = [[]]

sumas [] _ = []

sumas (x:xs) n

| x <= n = map (x:) (sumas (x:xs) (n-x)) ++ sumas xs n

| otherwise = sumas xs n

graficaMinimoSumandosDigitos :: Integer -> IO ()

graficaMinimoSumandosDigitos n =

plotList [ Key Nothing

, PNG "Numero_como_suma_de_sus_digitos.png"

]

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

Pensamiento

Caminante, son tus huellas
el camino, y nada más;
caminante no hay camino,
se hace camino al andar.

Antonio Machado

Las torres de Hanói

PorJosé A. Alonso 5-marzo-201912-marzo-2019

Las torres de Hanoi es un rompecabeza que consta de tres postes que llamaremos A, B y C. Hay N discos de distintos tamaños en el poste A, de forma que no hay un disco situado sobre otro de menor tamaño. Los postes B y C están vacíos. Sólo puede moverse un disco a la vez y todos los discos deben de estar ensartados en algún poste. Ningún disco puede situarse sobre otro de menor tamaño. El problema consiste en colocar los N discos en el poste C.

Los postes se pueden representar mediante el siguiente tipo de datos

   data Poste = A | B | C
     deriving Show

1 2	data Poste = A \| B \| C deriving Show

Definir las funciones

   movimientos :: Integer -> [(Integer,Poste,Poste)]
   hanoi       :: Integer -> IO ()

1 2	movimientos :: Integer -> [(Integer,Poste,Poste)] hanoi :: Integer -> IO ()

tales que

(movimientos n) es la lista de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

     λ> movimientos 1
     [(1,A,C)]
     λ> movimientos 2
     [(1,A,B),(2,A,C),(1,B,C)]
     λ> movimientos 3
     [(1,A,C),(2,A,B),(1,C,B),(3,A,C),(1,B,A),(2,B,C),(1,A,C)]

λ> movimientos 1

[(1,A,C)]

λ> movimientos 2

[(1,A,B),(2,A,C),(1,B,C)]

λ> movimientos 3

[(1,A,C),(2,A,B),(1,C,B),(3,A,C),(1,B,A),(2,B,C),(1,A,C)]

(hanoi n) escribe los mensajes de los movimientos para resolver el problema de las torres de hanoi con n discos. Por ejemplo,

     λ> hanoi 3
     Mueve el disco 1 de A a C
     Mueve el disco 2 de A a B
     Mueve el disco 1 de C a B
     Mueve el disco 3 de A a C
     Mueve el disco 1 de B a A
     Mueve el disco 2 de B a C
     Mueve el disco 1 de A a C

λ> hanoi 3

Mueve el disco 1 de A a C

Mueve el disco 2 de A a B

Mueve el disco 1 de C a B

Mueve el disco 3 de A a C

Mueve el disco 1 de B a A

Mueve el disco 2 de B a C

Mueve el disco 1 de A a C

Soluciones

data Poste = A | B | C
  deriving (Eq, Show)

movimientos :: Integer -> [(Integer,Poste,Poste)]
movimientos n = aux n A B C
  where  
    aux n a b c
      | n == 1    = [(1,a,c)]
      | otherwise = aux (n-1) a c b ++ (n,a,c) : aux (n-1) b a c

hanoi :: Integer -> IO ()
hanoi n = 
  putStrLn (unlines (map mensaje (movimientos n)))

-- (mensaje (n.x.y)) es la cadena indicando que el disco n se ha movido
-- desde el poste x al poste y. Por ejemplo, 
--    λ> mensaje (1,A,B)
--    "Mueve el disco 1 de A a B"
mensaje :: (Integer,Poste,Poste) -> String
mensaje (n,x,y) =
  "Mueve el disco " ++ show n ++ " de " ++ show x ++ " a " ++ show y

data Poste = A | B | C

deriving (Eq, Show)

movimientos :: Integer -> [(Integer,Poste,Poste)]

movimientos n = aux n A B C

where

aux n a b c

| n == 1 = [(1,a,c)]

| otherwise = aux (n-1) a c b ++ (n,a,c) : aux (n-1) b a c

hanoi :: Integer -> IO ()

hanoi n =

putStrLn (unlines (map mensaje (movimientos n)))

-- (mensaje (n.x.y)) es la cadena indicando que el disco n se ha movido

-- desde el poste x al poste y. Por ejemplo,

-- λ> mensaje (1,A,B)

-- "Mueve el disco 1 de A a B"

mensaje :: (Integer,Poste,Poste) -> String

mensaje (n,x,y) =

"Mueve el disco " ++ show n ++ " de " ++ show x ++ " a " ++ show y

Pensamiento

En preguntar lo que sabes
el tiempo no has de perder …
Y a preguntas sin respuesta
¿quién te podrá responder?

Antonio Machado

Hojas con caminos no decrecientes

PorJosé A. Alonso 4-marzo-201925-abril-2021

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

   data Arbol = N Int [Arbol]
     deriving Show

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 6 /|\ /|\ |

/ \ / \ 4 2 6 4 5 6 2

4 5 5 7

se representan por

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

ej1, ej2, ej3 :: Arbol

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

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

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

Definir la función

   hojasEnNoDecreciente :: Arbol -> [Int]

1	hojasEnNoDecreciente :: Arbol -> [Int]

tal que (hojasEnNoDecreciente a) es el conjunto de las hojas de a que se encuentran en alguna rama no decreciente. Por ejemplo,

   hojasEnNoDecreciente ej1  ==  [4,5,7]
   hojasEnNoDecreciente ej2  ==  [4,6,8]
   hojasEnNoDecreciente ej3  ==  []

hojasEnNoDecreciente ej1 == [4,5,7]

hojasEnNoDecreciente ej2 == [4,6,8]

hojasEnNoDecreciente ej3 == []

Soluciones

import Data.List (sort, nub)

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

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

hojasEnNoDecreciente :: Arbol -> [Int]
hojasEnNoDecreciente a =
  sort (nub (map last (ramasNoDecrecientes a)))

--    ramasNoDecrecientes ej1  ==  [[1,2,4],[1,2,5],[1,6,7]]
--    ramasNoDecrecientes ej2  ==  [[1,8],[1,3,4],[1,3,6]]
--    ramasNoDecrecientes ej3  ==  []
ramasNoDecrecientes :: Arbol -> [[Int]]
ramasNoDecrecientes a =
  filter esNoDecreciente (ramas a)

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    λ> ramas ej1
--    [[1,2,4],[1,2,5],[1,6,5],[1,6,7]]
--    λ> ramas ej2
--    [[1,8],[1,3,4],[1,3,2],[1,3,6]]
--    λ> ramas ej3
--    [[1,8,4],[1,8,5],[1,8,6],[1,3,2]]
ramas :: Arbol -> [[Int]]
ramas (N x []) = [[x]]
ramas (N x as) = map (x:) (concatMap ramas as)

-- (esNoDecreciente xs) se verifica si la lista xs es no
-- decreciente. Por ejemplo, 
--    esNoDecreciente [1,3,3,5]  ==  True
--    esNoDecreciente [1,3,5,3]  ==  False
esNoDecreciente :: [Int] -> Bool
esNoDecreciente xs =
  and (zipWith (<=) xs (tail xs))

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

--    hojasEnNoDecreciente ej1  ==  [4,5,7]
--    hojasEnNoDecreciente ej2  ==  [4,6,8]
--    hojasEnNoDecreciente ej3  ==  []
hojasEnNoDecreciente2 :: Arbol -> [Int]
hojasEnNoDecreciente2 = sort . nub . aux
  where
    aux (N x []) = [x]
    aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y]

import Data.List (sort, nub)

data Arbol = N Int [Arbol]

deriving Show

ej1, ej2, ej3 :: Arbol

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

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

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

-- 1ª solución

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

hojasEnNoDecreciente :: Arbol -> [Int]

hojasEnNoDecreciente a =

sort (nub (map last (ramasNoDecrecientes a)))

-- ramasNoDecrecientes ej1 == [[1,2,4],[1,2,5],[1,6,7]]

-- ramasNoDecrecientes ej2 == [[1,8],[1,3,4],[1,3,6]]

-- ramasNoDecrecientes ej3 == []

ramasNoDecrecientes :: Arbol -> [[Int]]

ramasNoDecrecientes a =

filter esNoDecreciente (ramas a)

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

-- λ> ramas ej1

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

-- λ> ramas ej2

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

-- λ> ramas ej3

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

ramas :: Arbol -> [[Int]]

ramas (N x []) = [[x]]

ramas (N x as) = map (x:) (concatMap ramas as)

-- (esNoDecreciente xs) se verifica si la lista xs es no

-- decreciente. Por ejemplo,

-- esNoDecreciente [1,3,3,5] == True

-- esNoDecreciente [1,3,5,3] == False

esNoDecreciente :: [Int] -> Bool

esNoDecreciente xs =

and (zipWith (<=) xs (tail xs))

-- 2ª solución

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

-- hojasEnNoDecreciente ej1 == [4,5,7]

-- hojasEnNoDecreciente ej2 == [4,6,8]

-- hojasEnNoDecreciente ej3 == []

hojasEnNoDecreciente2 :: Arbol -> [Int]

hojasEnNoDecreciente2 = sort . nub . aux

where

aux (N x []) = [x]

aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y]

Pensamiento

Para dialogar,
preguntad, primero;
después … escuchad.

Antonio Machado

Número de descomposiciones en sumas de cuatro cuadrados

PorJosé A. Alonso 1-marzo-201926-marzo-2022

Definir la función

   nDescomposiciones       :: Int -> Int
   graficaDescomposiciones :: Int -> IO ()

1 2	nDescomposiciones :: Int -> Int graficaDescomposiciones :: Int -> IO ()

tales que

(nDescomposiciones x) es el número de listas de los cuadrados de cuatro números enteros positivos cuya suma es x. Por ejemplo.

     nDescomposiciones 4      ==  1
     nDescomposiciones 5      ==  0
     nDescomposiciones 7      ==  4
     nDescomposiciones 10     ==  6
     nDescomposiciones 15     ==  12
     nDescomposiciones 50000  ==  5682

nDescomposiciones 4 == 1

nDescomposiciones 5 == 0

nDescomposiciones 7 == 4

nDescomposiciones 10 == 6

nDescomposiciones 15 == 12

nDescomposiciones 50000 == 5682

(graficaDescomposiciones n) dibuja la gráfica del número de descomposiciones de los n primeros números naturales. Por ejemplo, (graficaDescomposiciones 500) dibuja

Soluciones

import Data.Array
import Graphics.Gnuplot.Simple
import Test.QuickCheck

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

nDescomposiciones :: Int -> Int
nDescomposiciones = length . descomposiciones

-- (descomposiciones x) es la lista de las listas de los cuadrados de
-- cuatro números enteros positivos cuya suma es x. Por  ejemplo. 
--    λ> descomposiciones 4
--    [[1,1,1,1]]
--    λ> descomposiciones 5
--    []
--    λ> descomposiciones 7
--    [[1,1,1,4],[1,1,4,1],[1,4,1,1],[4,1,1,1]]
--    λ> descomposiciones 10
--    [[1,1,4,4],[1,4,1,4],[1,4,4,1],[4,1,1,4],[4,1,4,1],[4,4,1,1]]
--    λ> descomposiciones 15
--    [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],
--     [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]
descomposiciones :: Int -> [[Int]]
descomposiciones x = aux x 4
  where 
    aux 0 1 = []
    aux 1 1 = [[1]]
    aux 2 1 = []
    aux 3 1 = []
    aux y 1 | esCuadrado y = [[y]]
            | otherwise    = []
    aux y n = [x^2 : zs | x <- [1..raizEntera y]
                        , zs <- aux (y - x^2) (n-1)]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Int -> Bool
esCuadrado x = (raizEntera x)^2 == x

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual
-- que n. Por ejemplo,
--    raizEntera 15  ==  3
--    raizEntera 16  ==  4
--    raizEntera 17  ==  4
raizEntera :: Int -> Int
raizEntera = floor . sqrt . fromIntegral 

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

nDescomposiciones2 :: Int -> Int
nDescomposiciones2 = length . descomposiciones2

descomposiciones2 :: Int -> [[Int]]
descomposiciones2 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = []
    f 1 1 = [[1]]
    f 2 1 = []
    f 3 1 = []
    f i 1 | esCuadrado i = [[i]]
          | otherwise    = []
    f i j = [x^2 : zs | x <- [1..raizEntera i]
                      , zs <- a ! (i - x^2,j-1)]

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

nDescomposiciones3 :: Int -> Int
nDescomposiciones3 x = aux x 4
  where
    aux 0 1 = 0
    aux 1 1 = 1
    aux 2 1 = 0
    aux 3 1 = 0
    aux y 1 | esCuadrado y = 1
            | otherwise    = 0
    aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]

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

nDescomposiciones4 :: Int -> Int
nDescomposiciones4 x = a ! (x,4)
  where
    a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]
    f 0 1 = 0
    f 1 1 = 1
    f 2 1 = 0
    f 3 1 = 0
    f i 1 | esCuadrado i = 1
          | otherwise    = 0
    f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_nDescomposiciones :: Positive Int -> Bool
prop_nDescomposiciones (Positive x) =
  all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2
                                           , nDescomposiciones3
                                           , nDescomposiciones4]]

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

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

--    λ> nDescomposiciones 20000
--    1068
--    (3.69 secs, 3,307,250,128 bytes)
--    λ> nDescomposiciones2 20000
--    1068
--    (0.72 secs, 678,419,328 bytes)
--    λ> nDescomposiciones3 20000
--    1068
--    (3.94 secs, 3,485,725,552 bytes)
--    λ> nDescomposiciones4 20000
--    1068
--    (0.74 secs, 716,022,456 bytes)
--    
--    λ> nDescomposiciones2 50000
--    5682
--    (2.64 secs, 2,444,206,000 bytes)
--    λ> nDescomposiciones4 50000
--    5682
--    (2.77 secs, 2,582,443,448 bytes)

-- Definición de graficaDescomposiciones
-- =====================================

graficaDescomposiciones :: Int -> IO ()
graficaDescomposiciones n =
  plotList [ Key Nothing
           , PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")
           ]
           (map nDescomposiciones3 [0..n])

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

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª solución

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

nDescomposiciones :: Int -> Int

nDescomposiciones = length . descomposiciones

-- (descomposiciones x) es la lista de las listas de los cuadrados de

-- cuatro números enteros positivos cuya suma es x. Por ejemplo.

-- λ> descomposiciones 4

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

-- λ> descomposiciones 5

-- []

-- λ> descomposiciones 7

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

-- λ> descomposiciones 10

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

-- λ> descomposiciones 15

-- [[1,1,4,9],[1,1,9,4],[1,4,1,9],[1,4,9,1],[1,9,1,4],[1,9,4,1],

-- [4,1,1,9],[4,1,9,1],[4,9,1,1],[9,1,1,4],[9,1,4,1],[9,4,1,1]]

descomposiciones :: Int -> [[Int]]

descomposiciones x = aux x 4

where

aux 0 1 = []

aux 1 1 = [[1]]

aux 2 1 = []

aux 3 1 = []

aux y 1 | esCuadrado y = [[y]]

| otherwise = []

aux y n = [x^2 : zs | x <- [1..raizEntera y]

, zs <- aux (y - x^2) (n-1)]

-- (esCuadrado x) se verifica si x es un número al cuadrado. Por

-- ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 26 == False

esCuadrado :: Int -> Bool

esCuadrado x = (raizEntera x)^2 == x

-- (raizEntera n) es el mayor entero cuya raíz cuadrada es menor o igual

-- que n. Por ejemplo,

-- raizEntera 15 == 3

-- raizEntera 16 == 4

-- raizEntera 17 == 4

raizEntera :: Int -> Int

raizEntera = floor . sqrt . fromIntegral

-- 2ª solución

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

nDescomposiciones2 :: Int -> Int

nDescomposiciones2 = length . descomposiciones2

descomposiciones2 :: Int -> [[Int]]

descomposiciones2 x = a ! (x,4)

where

a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]

f 0 1 = []

f 1 1 = [[1]]

f 2 1 = []

f 3 1 = []

f i 1 | esCuadrado i = [[i]]

| otherwise = []

f i j = [x^2 : zs | x <- [1..raizEntera i]

, zs <- a ! (i - x^2,j-1)]

-- 3ª solución

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

nDescomposiciones3 :: Int -> Int

nDescomposiciones3 x = aux x 4

where

aux 0 1 = 0

aux 1 1 = 1

aux 2 1 = 0

aux 3 1 = 0

aux y 1 | esCuadrado y = 1

| otherwise = 0

aux y n = sum [aux (y - x^2) (n-1) | x <- [1..raizEntera y]]

-- 4ª solución

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

nDescomposiciones4 :: Int -> Int

nDescomposiciones4 x = a ! (x,4)

where

a = array ((0,1),(x,4)) [((i,j), f i j) | i <- [0..x], j <- [1..4]]

f 0 1 = 0

f 1 1 = 1

f 2 1 = 0

f 3 1 = 0

f i 1 | esCuadrado i = 1

| otherwise = 0

f i j = sum [a ! (i- x^2,j-1) | x <- [1..raizEntera i]]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_nDescomposiciones :: Positive Int -> Bool

prop_nDescomposiciones (Positive x) =

all (== nDescomposiciones x) [f x | f <- [ nDescomposiciones2

, nDescomposiciones3

, nDescomposiciones4]]

-- La comprobación es

-- λ> quickCheck prop_nDescomposiciones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> nDescomposiciones 20000

-- 1068

-- (3.69 secs, 3,307,250,128 bytes)

-- λ> nDescomposiciones2 20000

-- 1068

-- (0.72 secs, 678,419,328 bytes)

-- λ> nDescomposiciones3 20000

-- 1068

-- (3.94 secs, 3,485,725,552 bytes)

-- λ> nDescomposiciones4 20000

-- 1068

-- (0.74 secs, 716,022,456 bytes)

-- λ> nDescomposiciones2 50000

-- 5682

-- (2.64 secs, 2,444,206,000 bytes)

-- λ> nDescomposiciones4 50000

-- 5682

-- (2.77 secs, 2,582,443,448 bytes)

-- Definición de graficaDescomposiciones

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

graficaDescomposiciones :: Int -> IO ()

graficaDescomposiciones n =

plotList [ Key Nothing

, PNG ("Numero_de_descomposiciones_en_sumas_de_cuadrados.png")

]

(map nDescomposiciones3 [0..n])

Pensamiento

Ya habrá cigüeñas al sol,
mirando la tarde roja,
entre Moncayo y Urbión.

Antonio Machado

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico