reverse – Página 2

Árbol de divisores

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

Se dice que a es un divisor propio maximal de un número b si a es un divisor de b distinto de b y no existe ningún número c tal que a < c < b, a es un divisor de c y c es un divisor de b. Por ejemplo, 15 es un divisor propio maximal de 30, pero 5 no lo es.

El árbol de los divisores de un número x es el árbol que tiene como raíz el número x y cada nodo tiene como hijos sus divisores propios maximales. Por ejemplo, el árbol de divisores de 30 es

          30
          /|\
         / | \
        /  |  \
       /   |   \
      /    |    \
     6    10    15
    / \   / \   / \
   2   3 2   5 3   5

/|\

/ | \

6 10 15

/ \ / \ / \

2 3 2 5 3 5

Usando el tipo de dato

   data Arbol = N Integer [Arbol]
     deriving (Eq, Show)

1 2	data Arbol = N Integer [Arbol] deriving (Eq, Show)

el árbol anterior se representa por

   N 30
     [N 6
        [N 2 [N 1 []],
         N 3 [N 1 []]],
      N 10
        [N 2 [N 1 []],
         N 5 [N 1 []]],
      N 15
        [N 3 [N 1 []],
         N 5 [N 1 []]]]

N 30

[N 6

[N 2 [N 1 []],

N 3 [N 1 []]],

N 10

[N 2 [N 1 []],

N 5 [N 1 []]],

N 15

[N 3 [N 1 []],

N 5 [N 1 []]]]

Definir las funciones

   arbolDivisores             :: Integer -> Arbol
   nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

1 2	arbolDivisores :: Integer -> Arbol nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

tales que

(arbolDivisores x) es el árbol de los divisores del número x. Por ejemplo,

     λ> arbolDivisores 30
     N 30 [N 6  [N 2 [N 1 []],N 3 [N 1 []]],
           N 10 [N 2 [N 1 []],N 5 [N 1 []]],
           N 15 [N 3 [N 1 []],N 5 [N 1 []]]]

λ> arbolDivisores 30

N 30 [N 6 [N 2 [N 1 []],N 3 [N 1 []]],

N 10 [N 2 [N 1 []],N 5 [N 1 []]],

N 15 [N 3 [N 1 []],N 5 [N 1 []]]]

(nOcurrenciasArbolDivisores x y) es el número de veces que aparece el número x en el árbol de los divisores del número y. Por ejemplo,

     nOcurrenciasArbolDivisores  3 30  ==  2
     nOcurrenciasArbolDivisores  6 30  ==  1
     nOcurrenciasArbolDivisores 30 30  ==  1
     nOcurrenciasArbolDivisores  1 30  ==  6
     nOcurrenciasArbolDivisores  9 30  ==  0
     nOcurrenciasArbolDivisores  2 (product [1..10])  ==  360360
     nOcurrenciasArbolDivisores  3 (product [1..10])  ==  180180
     nOcurrenciasArbolDivisores  5 (product [1..10])  ==  90090
     nOcurrenciasArbolDivisores  7 (product [1..10])  ==  45045
     nOcurrenciasArbolDivisores  6 (product [1..10])  ==  102960
     nOcurrenciasArbolDivisores 10 (product [1..10])  ==  51480
     nOcurrenciasArbolDivisores 14 (product [1..10])  ==  25740

nOcurrenciasArbolDivisores 3 30 == 2

nOcurrenciasArbolDivisores 6 30 == 1

nOcurrenciasArbolDivisores 30 30 == 1

nOcurrenciasArbolDivisores 1 30 == 6

nOcurrenciasArbolDivisores 9 30 == 0

nOcurrenciasArbolDivisores 2 (product [1..10]) == 360360

nOcurrenciasArbolDivisores 3 (product [1..10]) == 180180

nOcurrenciasArbolDivisores 5 (product [1..10]) == 90090

nOcurrenciasArbolDivisores 7 (product [1..10]) == 45045

nOcurrenciasArbolDivisores 6 (product [1..10]) == 102960

nOcurrenciasArbolDivisores 10 (product [1..10]) == 51480

nOcurrenciasArbolDivisores 14 (product [1..10]) == 25740

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group, nub)

data Arbol = N Integer [Arbol]
  deriving (Eq, Show)

-- Definición de arbolDivisores
-- ============================

arbolDivisores :: Integer -> Arbol
arbolDivisores x =
  N x (map arbolDivisores (divisoresPropiosMaximales x))

-- (divisoresPropiosMaximales x) es la lista de los divisores propios
-- maximales de x. Por ejemplo,
--    divisoresPropiosMaximales 30   ==  [6,10,15]
--    divisoresPropiosMaximales 420  ==  [60,84,140,210]
--    divisoresPropiosMaximales 7    ==  [1]
divisoresPropiosMaximales :: Integer -> [Integer]
divisoresPropiosMaximales x =
  reverse [x `div` y | y <- nub (primeFactors x)]

-- Definición de nOcurrenciasArbolDivisores
-- ========================================
  
nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer
nOcurrenciasArbolDivisores x y =
  nOcurrencias x (arbolDivisores y)

-- (nOcurrencias x a) es el número de veces que aprece x en el árbol
-- a. Por ejemplo,
--    nOcurrencias 3 (arbolDivisores 30)  ==  2
nOcurrencias :: Integer -> Arbol -> Integer
nOcurrencias x (N y [])
  | x == y    = 1
  | otherwise = 0
nOcurrencias x (N y zs)
  | x == y    = 1 + sum [nOcurrencias x z | z <- zs]
  | otherwise = sum [nOcurrencias x z | z <- zs]

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group, nub)

data Arbol = N Integer [Arbol]

deriving (Eq, Show)

-- Definición de arbolDivisores

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

arbolDivisores :: Integer -> Arbol

arbolDivisores x =

N x (map arbolDivisores (divisoresPropiosMaximales x))

-- (divisoresPropiosMaximales x) es la lista de los divisores propios

-- maximales de x. Por ejemplo,

-- divisoresPropiosMaximales 30 == [6,10,15]

-- divisoresPropiosMaximales 420 == [60,84,140,210]

-- divisoresPropiosMaximales 7 == [1]

divisoresPropiosMaximales :: Integer -> [Integer]

divisoresPropiosMaximales x =

reverse [x `div` y | y <- nub (primeFactors x)]

-- Definición de nOcurrenciasArbolDivisores

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

nOcurrenciasArbolDivisores :: Integer -> Integer -> Integer

nOcurrenciasArbolDivisores x y =

nOcurrencias x (arbolDivisores y)

-- (nOcurrencias x a) es el número de veces que aprece x en el árbol

-- a. Por ejemplo,

-- nOcurrencias 3 (arbolDivisores 30) == 2

nOcurrencias :: Integer -> Arbol -> Integer

nOcurrencias x (N y [])

| x == y = 1

| otherwise = 0

nOcurrencias x (N y zs)

| x == y = 1 + sum [nOcurrencias x z | z <- zs]

| otherwise = sum [nOcurrencias x z | z <- zs]

Pensamiento

«¿Dónde está la utilidad
de nuestras utilidades?
Volvamos a la verdad:
vanidad de vanidades.»

Antonio Machado

Divisores propios maximales

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

Definir las funciones

   divisoresPropiosMaximales  :: Integer -> [Integer]
   nDivisoresPropiosMaximales :: Integer -> Integer

1 2	divisoresPropiosMaximales :: Integer -> [Integer] nDivisoresPropiosMaximales :: Integer -> Integer

tales que

(divisoresPropiosMaximales x) es la lista de los divisores propios maximales de x. Por ejemplo,

     divisoresPropiosMaximales 30   ==  [6,10,15]
     divisoresPropiosMaximales 420  ==  [60,84,140,210]
     divisoresPropiosMaximales 7    ==  [1]
     length (divisoresPropiosMaximales (product [1..3*10^4])) == 3245

divisoresPropiosMaximales 30 == [6,10,15]

divisoresPropiosMaximales 420 == [60,84,140,210]

divisoresPropiosMaximales 7 == [1]

length (divisoresPropiosMaximales (product [1..3*10^4])) == 3245

(nDivisoresPropiosMaximales x) es el número de divisores propios maximales de x. Por ejemplo,

     nDivisoresPropiosMaximales 30   ==  3
     nDivisoresPropiosMaximales 420  ==  4
     nDivisoresPropiosMaximales 7    ==  1
     nDivisoresPropiosMaximales (product [1..3*10^4])  ==  3245

nDivisoresPropiosMaximales 30 == 3

nDivisoresPropiosMaximales 420 == 4

nDivisoresPropiosMaximales 7 == 1

nDivisoresPropiosMaximales (product [1..3*10^4]) == 3245

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group, nub)
import Test.QuickCheck

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

divisoresPropiosMaximales :: Integer -> [Integer]
divisoresPropiosMaximales x =
  [y | y <- divisoresPropios x
     , null [z | z <- divisoresPropios x
               , y < z 
               , z `mod` y == 0]]

-- (divisoresPropios x) es la lista de los divisores propios de x; es
-- decir, de los divisores de x distintos de x. Por ejemplo,
--    divisoresPropios 30  ==  [1,2,3,5,6,10,15]
divisoresPropios :: Integer -> [Integer]
divisoresPropios x =
  [y | y <- [1..x-1]
     , x `mod` y == 0]

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

divisoresPropiosMaximales2 :: Integer -> [Integer]
divisoresPropiosMaximales2 x =
  reverse [x `div` y | y <- nub (primeFactors x)]

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

-- La propiedad es
prop_divisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool
prop_divisoresPropiosMaximales_equiv (Positive x) =
  divisoresPropiosMaximales x == divisoresPropiosMaximales2 x

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

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

--    λ> length (divisoresPropiosMaximales (product [1..10]))
--    4
--    (13.33 secs, 7,037,241,776 bytes)
--    λ> length (divisoresPropiosMaximales2 (product [1..10]))
--    4
--    (0.00 secs, 135,848 bytes)

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

nDivisoresPropiosMaximales :: Integer -> Integer
nDivisoresPropiosMaximales =
  genericLength . divisoresPropiosMaximales
  
-- 2ª definición de nDivisoresPropiosMaximales
-- ===========================================

nDivisoresPropiosMaximales2 :: Integer -> Integer
nDivisoresPropiosMaximales2 =
  genericLength . divisoresPropiosMaximales2
  
-- 3ª definición de nDivisoresPropiosMaximales
-- ===========================================

nDivisoresPropiosMaximales3 :: Integer -> Integer
nDivisoresPropiosMaximales3 =
  genericLength . group . primeFactors

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

-- La propiedad es
prop_nDivisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool
prop_nDivisoresPropiosMaximales_equiv (Positive x) =
  nDivisoresPropiosMaximales  x == nDivisoresPropiosMaximales3 x &&
  nDivisoresPropiosMaximales2 x == nDivisoresPropiosMaximales3 x 

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

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

--    λ> nDivisoresPropiosMaximales2 (product [1..10])
--    4
--    (13.33 secs, 7,037,242,536 bytes)
--    λ> nDivisoresPropiosMaximales2 (product [1..10])
--    4
--    (0.00 secs, 135,640 bytes)
--    λ> nDivisoresPropiosMaximales3 (product [1..10])
--    4
--    (0.00 secs, 135,232 bytes)
--    
--    λ> nDivisoresPropiosMaximales2 (product [1..3*10^4])
--    3245
--    (3.12 secs, 4,636,274,040 bytes)
--    λ> nDivisoresPropiosMaximales3 (product [1..3*10^4])
--    3245
--    (3.06 secs, 4,649,295,056 bytes)

100

101

102

103

104

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group, nub)

import Test.QuickCheck

-- 1ª definición de divisoresPropiosMaximales

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

divisoresPropiosMaximales :: Integer -> [Integer]

divisoresPropiosMaximales x =

[y | y <- divisoresPropios x

, null [z | z <- divisoresPropios x

, y < z

, z `mod` y == 0]]

-- (divisoresPropios x) es la lista de los divisores propios de x; es

-- decir, de los divisores de x distintos de x. Por ejemplo,

-- divisoresPropios 30 == [1,2,3,5,6,10,15]

divisoresPropios :: Integer -> [Integer]

divisoresPropios x =

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

, x `mod` y == 0]

-- 2ª definición de divisoresPropiosMaximales

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

divisoresPropiosMaximales2 :: Integer -> [Integer]

divisoresPropiosMaximales2 x =

reverse [x `div` y | y <- nub (primeFactors x)]

-- Equivalencia de las definiciones de divisoresPropiosMaximales

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

-- La propiedad es

prop_divisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool

prop_divisoresPropiosMaximales_equiv (Positive x) =

divisoresPropiosMaximales x == divisoresPropiosMaximales2 x

-- La comprobación es

-- λ> quickCheck prop_divisoresPropiosMaximales_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de divisoresPropiosMaximales

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

-- λ> length (divisoresPropiosMaximales (product [1..10]))

-- 4

-- (13.33 secs, 7,037,241,776 bytes)

-- λ> length (divisoresPropiosMaximales2 (product [1..10]))

-- 4

-- (0.00 secs, 135,848 bytes)

-- 1ª definición de nDivisoresPropiosMaximales

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

nDivisoresPropiosMaximales :: Integer -> Integer

nDivisoresPropiosMaximales =

genericLength . divisoresPropiosMaximales

-- 2ª definición de nDivisoresPropiosMaximales

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

nDivisoresPropiosMaximales2 :: Integer -> Integer

nDivisoresPropiosMaximales2 =

genericLength . divisoresPropiosMaximales2

-- 3ª definición de nDivisoresPropiosMaximales

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

nDivisoresPropiosMaximales3 :: Integer -> Integer

nDivisoresPropiosMaximales3 =

genericLength . group . primeFactors

-- Equivalencia de las definiciones de nDivisoresPropiosMaximales

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

-- La propiedad es

prop_nDivisoresPropiosMaximales_equiv :: (Positive Integer) -> Bool

prop_nDivisoresPropiosMaximales_equiv (Positive x) =

nDivisoresPropiosMaximales x == nDivisoresPropiosMaximales3 x &&

nDivisoresPropiosMaximales2 x == nDivisoresPropiosMaximales3 x

-- La comprobación es

-- λ> quickCheck prop_nDivisoresPropiosMaximales_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de nDivisoresPropiosMaximales

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

-- λ> nDivisoresPropiosMaximales2 (product [1..10])

-- 4

-- (13.33 secs, 7,037,242,536 bytes)

-- λ> nDivisoresPropiosMaximales2 (product [1..10])

-- 4

-- (0.00 secs, 135,640 bytes)

-- λ> nDivisoresPropiosMaximales3 (product [1..10])

-- 4

-- (0.00 secs, 135,232 bytes)

-- λ> nDivisoresPropiosMaximales2 (product [1..3*10^4])

-- 3245

-- (3.12 secs, 4,636,274,040 bytes)

-- λ> nDivisoresPropiosMaximales3 (product [1..3*10^4])

-- 3245

-- (3.06 secs, 4,649,295,056 bytes)

Pensamiento

«Moneda que está en la mano
quizá se deba guardar;
la monedita del alma
se pierde si no se da.»

Antonio Machado

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

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

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

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

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

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

Los árboles binarios se puede representar mediante el siguiente tipo

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

data Arbol = H

| N Integer Arbol Arbol

deriving (Show, Eq)

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

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

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

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

Definir la función

   elementoEnPosicion :: Posicion -> Integer

1	elementoEnPosicion :: Posicion -> Integer

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

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

elementoEnPosicion [D,I] == 6

elementoEnPosicion [D,D] == 7

elementoEnPosicion [I,I,D] == 9

elementoEnPosicion [] == 1

Soluciones

import Test.QuickCheck

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

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

type Posicion = [Movimiento]

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

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

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

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

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

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

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

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

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

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

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

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

import Test.QuickCheck

data Arbol = H

| N Integer Arbol Arbol

deriving (Eq, Show)

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

type Posicion = [Movimiento]

-- 1ª solución

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

elementoEnPosicion :: Posicion -> Integer

elementoEnPosicion ms =

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

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

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

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

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

-- nodos. Por ejemplo,

-- λ> arbolBinarioCompleto 4

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

-- λ> pPrint (arbolBinarioCompleto 9)

-- N 1

-- (N 2

-- (N 4

-- (N 8 H H)

-- (N 9 H H))

-- (N 5 H H))

-- (N 3

-- (N 6 H H)

-- (N 7 H H))

arbolBinarioCompleto :: Integer -> Arbol

arbolBinarioCompleto n = aux 1

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

| otherwise = H

-- 2ª solución

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

elementoEnPosicion2 :: Posicion -> Integer

elementoEnPosicion2 = aux . reverse

where aux [] = 1

aux (I:ms) = 2 * aux ms

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

-- Equivalencia

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

-- La propiedad es

prop_elementoEnPosicion_equiv :: Positive Integer -> Bool

prop_elementoEnPosicion_equiv (Positive n) =

elementoEnPosicion ps == n &&

elementoEnPosicion2 ps == n

where ps = posicionDeElemento n

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

-- árbol binario completo. Por ejemplo,

-- posicionDeElemento 6 == [D,I]

-- posicionDeElemento 7 == [D,D]

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

-- posicionDeElemento 1 == []

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

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

where f 0 = I

f 1 = D

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

-- de n. Por ejemplo,

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

binario :: Integer -> [Integer]

binario n

| n < 2 = [n]

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

-- La comprobación es

-- λ> quickCheck prop_elementoEnPosicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

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

-- 90310

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

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

-- 90310

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

Pensamiento

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

Antonio Machado

Posiciones en árboles binarios completos

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

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

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

/ \

2 3

/ \ / \

4 5 6 7

/ \

8 9

Los árboles binarios se puede representar mediante el siguiente tipo

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

data Arbol = H

| N Integer Arbol Arbol

deriving (Show, Eq)

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

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

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

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

Definir la función

   posicionDeElemento :: Integer -> Posicion

1	posicionDeElemento :: Integer -> Posicion

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

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

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

posicionDeElemento 6 == [D,I]

posicionDeElemento 7 == [D,D]

posicionDeElemento 9 == [I,I,D]

posicionDeElemento 1 == []

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

Soluciones

import Test.QuickCheck

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

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

type Posicion = [Movimiento]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

import Test.QuickCheck

data Arbol = H

| N Integer Arbol Arbol

deriving (Eq, Show)

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

type Posicion = [Movimiento]

-- 1ª solución

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

posicionDeElemento :: Integer -> Posicion

posicionDeElemento n =

head (posiciones n (arbolBinarioCompleto n))

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

-- nodos. Por ejemplo,

-- λ> arbolBinarioCompleto 4

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

-- λ> pPrint (arbolBinarioCompleto 9)

-- N 1

-- (N 2

-- (N 4

-- (N 8 H H)

-- (N 9 H H))

-- (N 5 H H))

-- (N 3

-- (N 6 H H)

-- (N 7 H H))

arbolBinarioCompleto :: Integer -> Arbol

arbolBinarioCompleto n = aux 1

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

| otherwise = H

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

-- en el árbol a. Por ejemplo,

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

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

posiciones n a = aux n a [[]]

where aux _ H _ = []

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

| otherwise = ps

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

map (D:) (aux n d cs)

-- 2ª solución

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

posicionDeElemento2 :: Integer -> Posicion

posicionDeElemento2 1 = []

posicionDeElemento2 n

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

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

-- 3ª solución

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

posicionDeElemento3 :: Integer -> Posicion

posicionDeElemento3 = reverse . aux

where aux 1 = []

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

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

-- 4ª solución

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

posicionDeElemento4 :: Integer -> Posicion

posicionDeElemento4 n =

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

where f 0 = I

f 1 = D

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

-- de n. Por ejemplo,

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

binario :: Integer -> [Integer]

binario n

| n < 2 = [n]

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

-- Equivalencia

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

-- La propiedad es

prop_posicionDeElemento_equiv :: Positive Integer -> Bool

prop_posicionDeElemento_equiv (Positive n) =

posicionDeElemento n == posicionDeElemento2 n &&

posicionDeElemento n == posicionDeElemento3 n &&

posicionDeElemento n == posicionDeElemento4 n

-- La comprobación es

-- λ> quickCheck prop_posicionDeElemento_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> posicionDeElemento (10^7)

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

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

-- λ> posicionDeElemento2 (10^7)

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

-- (0.01 secs, 189,560 bytes)

-- λ> posicionDeElemento3 (10^7)

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

-- (0.01 secs, 180,728 bytes)

-- λ> posicionDeElemento4 (10^7)

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

-- (0.01 secs, 184,224 bytes)

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

-- 13287

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

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

-- 13287

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

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

-- 13287

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

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

-- 166096

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

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

-- 166096

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

Pensamiento

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

Antonio Machado

Números colinas

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

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

Definir la función

   esColina :: Integer -> Bool

1	esColina :: Integer -> Bool

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

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

esColina 12377731 == True

esColina 1237731 == True

esColina 123731 == True

esColina 122731 == False

esColina 12377730 == False

esColina 10377731 == False

esColina 12377701 == False

esColina 33333333 == True

Soluciones

import Data.Char (digitToInt)

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

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

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

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

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

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

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

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

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

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

import Data.Char (digitToInt)

-- 1ª definición

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

esColina :: Integer -> Bool

esColina n =

head ds == last ds &&

esCreciente xs &&

esDecreciente ys

where ds = digitos n

m = maximum ds

xs = takeWhile (<m) ds

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

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

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

digitos :: Integer -> [Int]

digitos n = map digitToInt (show n)

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

-- creciente. Por ejemplo,

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

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

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

esCreciente :: [Int] -> Bool

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

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

-- decreciente. Por ejemplo,

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

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

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

esDecreciente :: [Int] -> Bool

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

-- 2ª definición

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

esColina2 :: Integer -> Bool

esColina2 n =

head ds == last ds &&

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

where ds = digitos n

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

-- Equivalencia

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

-- La propiedad de equivalencia es

prop_esColina :: Integer -> Property

prop_esColina n =

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

-- La comprobación es

-- λ> quickCheck prop_esColina

-- +++ OK, passed 100 tests.

Referencia

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

Pensamiento

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

Antonio Machado

Número de parejas

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

Definir la función

   nParejas :: Ord a => [a] -> Int

1	nParejas :: Ord a => [a] -> Int

tal que (nParejas xs) es el número de parejas de elementos iguales en xs. Por ejemplo,

   nParejas [1,2,2,1,1,3,5,1,2]        ==  3
   nParejas [1,2,1,2,1,3,2]            ==  2
   nParejas [1..2*10^6]                ==  0
   nParejas2 ([1..10^6] ++ [1..10^6])  ==  1000000

nParejas [1,2,2,1,1,3,5,1,2] == 3

nParejas [1,2,1,2,1,3,2] == 2

nParejas [1..2*10^6] == 0

nParejas2 ([1..10^6] ++ [1..10^6]) == 1000000

En el primer ejemplos las parejas son (1,1), (1,1) y (2,2). En el segundo ejemplo, las parejas son (1,1) y (2,2).

Comprobar con QuickCheck que para toda lista de enteros xs, el número de parejas de xs es igual que el número de parejas de la inversa de xs.

Soluciones

import Test.QuickCheck
import Data.List ((\\), group, sort)

-- 1ª solución
nParejas :: Ord a => [a] -> Int
nParejas []     = 0
nParejas (x:xs) | x `elem` xs = 1 + nParejas (xs \\ [x])
                | otherwise   = nParejas xs

-- 2ª solución
nParejas2 :: Ord a => [a] -> Int
nParejas2 xs =
  sum [length ys `div` 2 | ys <- group (sort xs)]

-- 3ª solución
nParejas3 :: Ord a => [a] -> Int
nParejas3 = sum . map (`div` 2). map length . group . sort

-- 4ª solución
nParejas4 :: Ord a => [a] -> Int
nParejas4 = sum . map ((`div` 2) . length) . group . sort

-- Equivalencia
prop_equiv :: [Int] -> Bool
prop_equiv xs =
  nParejas xs == nParejas2 xs &&
  nParejas xs == nParejas3 xs &&
  nParejas xs == nParejas4 xs 

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

-- Comparación de eficiencia
--    λ> nParejas [1..20000]
--    0
--    (2.54 secs, 4,442,808 bytes)
--    λ> nParejas2 [1..20000]
--    0
--    (0.03 secs, 12,942,232 bytes)
--    λ> nParejas3 [1..20000]
--    0
--    (0.02 secs, 13,099,904 bytes)
--    λ> nParejas4 [1..20000]
--    0
--    (0.01 secs, 11,951,992 bytes)

-- Propiedad:
prop_nParejas :: [Int] -> Bool
prop_nParejas xs =
  nParejas xs == nParejas (reverse xs)

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

import Test.QuickCheck

import Data.List ((\\), group, sort)

-- 1ª solución

nParejas :: Ord a => [a] -> Int

nParejas [] = 0

nParejas (x:xs) | x `elem` xs = 1 + nParejas (xs \\ [x])

| otherwise = nParejas xs

-- 2ª solución

nParejas2 :: Ord a => [a] -> Int

nParejas2 xs =

sum [length ys `div` 2 | ys <- group (sort xs)]

-- 3ª solución

nParejas3 :: Ord a => [a] -> Int

nParejas3 = sum . map (`div` 2). map length . group . sort

-- 4ª solución

nParejas4 :: Ord a => [a] -> Int

nParejas4 = sum . map ((`div` 2) . length) . group . sort

-- Equivalencia

prop_equiv :: [Int] -> Bool

prop_equiv xs =

nParejas xs == nParejas2 xs &&

nParejas xs == nParejas3 xs &&

nParejas xs == nParejas4 xs

-- Comprobación:

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- λ> nParejas [1..20000]

-- 0

-- (2.54 secs, 4,442,808 bytes)

-- λ> nParejas2 [1..20000]

-- 0

-- (0.03 secs, 12,942,232 bytes)

-- λ> nParejas3 [1..20000]

-- 0

-- (0.02 secs, 13,099,904 bytes)

-- λ> nParejas4 [1..20000]

-- 0

-- (0.01 secs, 11,951,992 bytes)

-- Propiedad:

prop_nParejas :: [Int] -> Bool

prop_nParejas xs =

nParejas xs == nParejas (reverse xs)

-- Comprobación:

-- λ> quickCheck prop_nParejas

-- +++ OK, passed 100 tests.

Pensamiento

Toda la imaginería
que no ha brotado del río,
barata bisutería.

Antonio Machado

Capicúas productos de dos números de dos dígitos

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

El número 9009 es capicúa y es producto de dos números de dos dígitos, pues 9009 = 91×99.

Definir la lista

   capicuasP2N2D :: [Int]

1	capicuasP2N2D :: [Int]

cuyos elementos son los números capicúas que son producto de 2 números de dos dígitos. Por ejemplo,

   take 5  capicuasP2N2D  ==  [121,242,252,272,323]
   length  capicuasP2N2D  ==  74
   drop 70 capicuasP2N2D  ==  [8008,8118,8448,9009]

take 5 capicuasP2N2D == [121,242,252,272,323]

length capicuasP2N2D == 74

drop 70 capicuasP2N2D == [8008,8118,8448,9009]

Soluciones

import Data.List

capicuasP2N2D :: [Int]
capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números que son productos de 2 números de
-- dos dígitos.   
productos :: [Int]
productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

-- (esCapicua x) se verifica si x es capicúa.
esCapicua :: Int -> Bool
esCapicua x = xs == reverse xs
  where xs = show x

import Data.List

capicuasP2N2D :: [Int]

capicuasP2N2D = [x | x <- productos, esCapicua x]

-- productos es la lista de números que son productos de 2 números de

-- dos dígitos.

productos :: [Int]

productos = sort (nub [x*y | x <- [10..99], y <- [x..99]])

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

esCapicua :: Int -> Bool

esCapicua x = xs == reverse xs

where xs = show x

Pensamiento

Ayudadme a comprender lo que os digo, y os lo explicaré más despacio.

Antonio Machado

Último dígito no nulo del factorial

PorJosé A. Alonso 13-noviembre-201825-abril-2021

El factorial de 7 es

   7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

1	7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

por tanto, el último dígito no nulo del factorial de 7 es 4.

Definir la función

   ultimoNoNuloFactorial :: Integer -> Integer

1	ultimoNoNuloFactorial :: Integer -> Integer

tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del factorial de n. Por ejemplo,

   ultimoNoNuloFactorial  7  == 4
   ultimoNoNuloFactorial 10  == 8
   ultimoNoNuloFactorial 12  == 6
   ultimoNoNuloFactorial 97  == 2
   ultimoNoNuloFactorial  0  == 1

ultimoNoNuloFactorial 7 == 4

ultimoNoNuloFactorial 10 == 8

ultimoNoNuloFactorial 12 == 6

ultimoNoNuloFactorial 97 == 2

ultimoNoNuloFactorial 0 == 1

Comprobar con QuickCheck que si n es mayor que 4, entonces el último dígito no nulo del factorial de n es par.

Soluciones

import Test.QuickCheck

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

ultimoNoNuloFactorial :: Integer -> Integer
ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo :: Integer -> Integer
ultimoNoNulo n
  | m /= 0    = m
  | otherwise = ultimoNoNulo (n `div` 10)
  where m = n `rem` 10
        
-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 7  ==  5040
factorial :: Integer -> Integer
factorial n = product [1..n]

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

ultimoNoNuloFactorial2 :: Integer -> Integer
ultimoNoNuloFactorial2 n = ultimoNoNulo2 (factorial n)

-- (ultimoNoNulo2 n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo2 :: Integer -> Integer
ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

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

-- La propiedad es
prop_ultimoNoNuloFactorial :: Integer -> Property
prop_ultimoNoNuloFactorial n = 
  n > 4 ==> even (ultimoNoNuloFactorial n)
                  
-- La comprobación es
--    ghci> quickCheck prop_ultimoNoNuloFactorial
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª definición

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

ultimoNoNuloFactorial :: Integer -> Integer

ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo :: Integer -> Integer

ultimoNoNulo n

| m /= 0 = m

| otherwise = ultimoNoNulo (n `div` 10)

where m = n `rem` 10

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

-- factorial 7 == 5040

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 2ª definición

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

ultimoNoNuloFactorial2 :: Integer -> Integer

ultimoNoNuloFactorial2 n = ultimoNoNulo2 (factorial n)

-- (ultimoNoNulo2 n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo2 :: Integer -> Integer

ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- Comprobación

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

-- La propiedad es

prop_ultimoNoNuloFactorial :: Integer -> Property

prop_ultimoNoNuloFactorial n =

n > 4 ==> even (ultimoNoNuloFactorial n)

-- La comprobación es

-- ghci> quickCheck prop_ultimoNoNuloFactorial

-- +++ OK, passed 100 tests.

Pensamiento

Incierto es, lo porvenir. ¿Quién sabe lo que va a pasar? Pero incierto es también lo pretérito. ¿Quién sabe lo que ha pasado? De suerte que ni el porvenir está escrito en ninguna parte, ni el pasado tampoco.

Antonio Machado

Número medio

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

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

Definir las siguientes funciones

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

numeroMedio :: Integer -> Bool

densidadesNumeroMedio :: [Double]

graficaDensidadNumeroMedio :: Int -> IO ()

tales que

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

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

λ> numeroMedio 370

True

λ> numeroMedio 371

False

λ> numeroMedio 485596707818930041152263374

True

λ> filter numeroMedio [100..600]

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

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

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

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

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

λ> mapM_ print (take 30 densidades)

1.0

0.9

0.9090909090909091

0.8333333333333334

0.7692307692307693

0.7142857142857143

0.6666666666666666

0.625

0.5882352941176471

0.5555555555555556

0.5263157894736842

0.5

0.47619047619047616

0.5

0.4782608695652174

0.4583333333333333

0.44

0.4230769230769231

0.4074074074074074

0.39285714285714285

0.3793103448275862

0.36666666666666664

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

y (graficaDensidadNumeroMedio 1000) dibuja

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de numeroMedio

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

numeroMedio :: Integer -> Bool

numeroMedio n =

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

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

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

digitos :: Integer -> [Integer]

digitos n =

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

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

-- ejemplo,

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

-- 1ª definición de digitosAnumero

digitosAnumero1 :: [Integer] -> Integer

digitosAnumero1 = aux . reverse

where aux [] = 0

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

-- 1ª definición de digitosAnumero

digitosAnumero2 :: [Integer] -> Integer

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

-- Comparación de eficiencia de definiciones de digitosAnumero

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

-- 100000

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

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

-- 100000

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

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

digitosAnumero :: [Integer] -> Integer

digitosAnumero = digitosAnumero2

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

-- valor es entero). Por ejemplo,

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

media :: [Integer] -> Integer

media xs = sum xs `div` genericLength xs

-- 2ª definición de numeroMedio

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

numeroMedio2 :: Integer -> Bool

numeroMedio2 n =

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

where xs = digitos n

k = genericLength xs

s = sum xs

-- Equivalencia de las definiciones de numeroMedio

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

-- La propiedad es

prop_numeroMedio :: Positive Integer -> Bool

prop_numeroMedio (Positive n) =

numeroMedio n == numeroMedio2 n

-- La comprobación es

-- λ> quickCheck prop_numeroMedio

-- +++ OK, passed 100 tests.

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

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

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

-- [11111]

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

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

-- [11111]

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

-- Definición de densidadesNumeroMedio

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

densidadesNumeroMedio :: [Double]

densidadesNumeroMedio =

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

-- Definición de graficaDensidadNumeroMedio

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

graficaDensidadNumeroMedio :: Int -> IO ()

graficaDensidadNumeroMedio n =

plotList [ Title ("graficaDensidadNumeroMedio")

, Key Nothing

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

, XRange (1, fromIntegral n)]

(take n densidadesNumeroMedio)

[/expand]

Recorrido en ZigZag

PorJosé A. Alonso 7-junio-20187-julio-2018

El recorrido en ZigZag de una matriz consiste en pasar de la primera fila hasta la última, de izquierda a derecha en las filas impares y de derecha a izquierda en las filas pares, como se indica en la figura.

         /             \
         | 1 -> 2 -> 3 |
         |           | |
         |           v |
         | 4 <- 5 <- 6 |   =>  Recorrido ZigZag: [1,2,3,6,5,4,7,8,9]
         | |           |
         | v           |
         | 7 -> 8 -> 9 |
         \             /

/ \

| 1 -> 2 -> 3 |

| | |

| v |

| 4 <- 5 <- 6 | => Recorrido ZigZag: [1,2,3,6,5,4,7,8,9]

| | |

| v |

| 7 -> 8 -> 9 |

\ /

Definir la función

   recorridoZigZag :: Matrix a -> [a]

1	recorridoZigZag :: Matrix a -> [a]

tal que (recorridoZigZag m) es la lista con los elementos de la matriz m cuando se recorre esta en ZigZag. Por ejemplo,

   λ> recorridoZigZag (fromLists [[1,2,3],[4,5,6],[7,8,9]])
   [1,2,3,6,5,4,7,8,9]
   λ> recorridoZigZag (fromLists [[1,2],[3,4],[5,6],[7,8]])
   [1,2,4,3,5,6,8,7]
   λ> recorridoZigZag (fromLists [[1,2,3,4],[5,6,7,8],[9,10,11,12]])
   [1,2,3,4,8,7,6,5,9,10,11,12]
   λ> recorridoZigZag (fromList 5 4 "Cada paso es la meta")
   "Cadasap o es al meta"
   λ> recorridoZigZag (fromList 4 5 "Cada paso es la meta")
   "Cada  osapes laatem "
   λ> recorridoZigZag (fromList 10 2 "Cada paso es la meta")
   "Caad psao se l ameat"
   λ> recorridoZigZag (fromList 2 10 "Cada paso es la meta")
   "Cada paso atem al se"

λ> recorridoZigZag (fromLists [[1,2,3],[4,5,6],[7,8,9]])

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

λ> recorridoZigZag (fromLists [[1,2],[3,4],[5,6],[7,8]])

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

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

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

λ> recorridoZigZag (fromList 5 4 "Cada paso es la meta")

"Cadasap o es al meta"

λ> recorridoZigZag (fromList 4 5 "Cada paso es la meta")

"Cada osapes laatem "

λ> recorridoZigZag (fromList 10 2 "Cada paso es la meta")

"Caad psao se l ameat"

λ> recorridoZigZag (fromList 2 10 "Cada paso es la meta")

"Cada paso atem al se"

Soluciones

import Data.Matrix (Matrix, toLists, fromLists, fromList)

recorridoZigZag :: Matrix a -> [a]
recorridoZigZag m =
  concat [f xs | (f,xs) <- zip (cycle [id,reverse]) (toLists m)]

import Data.Matrix (Matrix, toLists, fromLists, fromList)

recorridoZigZag :: Matrix a -> [a]

recorridoZigZag m =

concat [f xs | (f,xs) <- zip (cycle [id,reverse]) (toLists m)]

Problema de las 3 jarras

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

En el problema de las tres jarras (A,B,C) se dispone de tres jarras de capacidades A, B y C litros con A > B > C y A par. Inicialmente la jarra mayor está llena y las otras dos vacías. Queremos, trasvasando adecuadamente el líquido entre las jarras, repartir por igual el contenido inicial entre las dos jarras mayores. Por ejemplo, para el problema (8,5,3) el contenido inicial es (8,0,0) y el final es (4,4,0).

Definir las funciones

   solucionesTresJarras :: Problema -> [[Estado]]
   tresJarras :: Problema -> Maybe [Estado]

1 2	solucionesTresJarras :: Problema -> [[Estado]] tresJarras :: Problema -> Maybe [Estado]

tales que

(solucionesTresJarras p) es la lista de soluciones del problema de las tres jarras p. Por ejemplo,

     λ> mapM_ print (solucionesTresJarras (4,2,1))
     [(4,0,0),(2,2,0)]
     [(4,0,0),(3,0,1),(1,2,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(1,2,1),(2,2,0)]
     λ> mapM_ print (solucionesTresJarras (8,6,2))
     [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     λ> length (solucionesTresJarras (8,5,3))
     16
     λ> head (solucionesTresJarras (8,5,3))
     [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> length (solucionesTresJarras (8,6,5))
     0

λ> mapM_ print (solucionesTresJarras (4,2,1))

[(4,0,0),(2,2,0)]

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

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

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

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

λ> mapM_ print (solucionesTresJarras (8,6,2))

[(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

λ> length (solucionesTresJarras (8,5,3))

λ> head (solucionesTresJarras (8,5,3))

[(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> length (solucionesTresJarras (8,6,5))

(tresJarras p) es una solución del problema de las tres jarras p con el mínimo mínimo número de trasvase, si p tiene solución y Nothing, en caso contrario. Por ejemplo,

     λ> tresJarras (4,2,1)
     Just [(4,0,0),(2,2,0)]
     λ> tresJarras (8,6,2)
     Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     λ> tresJarras (8,5,3)
     Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> tresJarras (8,6,5)
     Nothing

λ> tresJarras (4,2,1)

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

λ> tresJarras (8,6,2)

Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

λ> tresJarras (8,5,3)

Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> tresJarras (8,6,5)

Nothing

Soluciones

import Data.Maybe (listToMaybe)

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

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

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

solucionesTresJarras :: Problema -> [[Estado]]
solucionesTresJarras p = busca [[inicial p]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = reverse (e:es) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo, 
--    inicial (8,5,3)  ==  (8,0,0)
inicial :: Problema -> Estado
inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- tres jarras p. Por ejemplo,
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (a,_,_) (x,y,z) =
  x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el
-- problema de las tres jarras p. Por ejemplo, 
--    sucesores (8,5,3) (8,0,0)  ==  [(3,5,0),(5,0,3)]
--    sucesores (8,5,3) (3,5,0)  ==  [(0,5,3),(8,0,0),(3,2,3)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,c) (x,y,z) =
     [(x-ab,y+ab,z)    | let ab = min x (b-y), ab > 0]
  ++ [(x-ac,y   ,z+ac) | let ac = min x (c-z), ac > 0]
  ++ [(x+ba,y-ba,z)    | let ba = min y (a-x), ba > 0]
  ++ [(x   ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]
  ++ [(x+ca,y   ,z-ca) | let ca = min z (a-x), ca > 0]
  ++ [(x   ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]
  
tresJarras :: Problema -> Maybe [Estado]
tresJarras p = listToMaybe (solucionesTresJarras p)

import Data.Maybe (listToMaybe)

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

-- como sigue.

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

-- primera jarra, el segundo el de la segunda y el tercero el de la

-- tercera.

type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la

-- jarra de A litros, el segundo el de la de B litros y el tercero el de

-- la de C litros.

type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]

solucionesTresJarras p = busca [[inicial p]]

where

busca [] = []

busca ((e:es):ns)

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

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

, e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo,

-- inicial (8,5,3) == (8,0,0)

inicial :: Problema -> Estado

inicial (a,_,_) = (a,0,0)

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

-- tres jarras p. Por ejemplo,

-- esFinal (8,5,3) (4,4,0) == True

-- esFinal (8,5,3) (4,0,4) == False

esFinal :: Problema -> Estado -> Bool

esFinal (a,_,_) (x,y,z) =

x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el

-- problema de las tres jarras p. Por ejemplo,

-- sucesores (8,5,3) (8,0,0) == [(3,5,0),(5,0,3)]

-- sucesores (8,5,3) (3,5,0) == [(0,5,3),(8,0,0),(3,2,3)]

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

sucesores (a,b,c) (x,y,z) =

[(x-ab,y+ab,z) | let ab = min x (b-y), ab > 0]

++ [(x-ac,y ,z+ac) | let ac = min x (c-z), ac > 0]

++ [(x+ba,y-ba,z) | let ba = min y (a-x), ba > 0]

++ [(x ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]

++ [(x+ca,y ,z-ca) | let ca = min z (a-x), ca > 0]

++ [(x ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]

tresJarras :: Problema -> Maybe [Estado]

tresJarras p = listToMaybe (solucionesTresJarras p)

Problema de las jarras

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

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

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

Definir la función

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

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

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

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

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

La interpretación de la solución anterior es

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

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

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

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

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

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

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

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

Otros ejemplos:

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

λ> jarras (3,5,4)

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

λ> jarras (15,10,5)

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

λ> jarras (15,10,4)

Nothing

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

Just 199

Soluciones

import Data.Maybe (listToMaybe, isJust)

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

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

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

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

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

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

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

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

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

import Data.Maybe (listToMaybe, isJust)

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

-- como sigue.

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

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

-- de litros que hay que obtener.

type Problema = (Int,Int,Int)

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

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

type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]

jarras p | null ns = Nothing

| otherwise = Just (head ns)

where ns = soluciones p

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

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

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

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

-- 6

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

-- []

soluciones :: Problema -> [[Estado]]

soluciones p = busca [[inicial]]

where

busca [] = []

busca ((e:es):ns)

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

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

, e1 `notElem` es])

-- inicial es el estado inicial

inicial :: Estado

inicial = (0,0)

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

-- jarras p. Por ejemplo,

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

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

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

esFinal :: Problema -> Estado -> Bool

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

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

-- ejemplo,

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

jarras2 :: Problema -> Maybe [Estado]

jarras2 p = listToMaybe (soluciones p)

Número de triangulaciones de un polígono

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

Una triangulación de un polígono es una división del área en un conjunto de triángulos, de forma que la unión de todos ellos es igual al polígono original, y cualquier par de triángulos es disjunto o comparte únicamente un vértice o un lado. En el caso de polígonos convexos, la cantidad de triangulaciones posibles depende únicamente del número de vértices del polígono.

Si llamamos T(n) al número de triangulaciones de un polígono de n vértices, se verifica la siguiente relación de recurrencia:

    T(2) = 1
    T(n) = T(2)*T(n-1) + T(3)*T(n-2) + ... + T(n-1)*T(2)

1 2	T(2) = 1 T(n) = T(2)T(n-1) + T(3)T(n-2) + ... + T(n-1)*T(2)

Definir la función

   numeroTriangulaciones :: Integer -> Integer

1	numeroTriangulaciones :: Integer -> Integer

tal que (numeroTriangulaciones n) es el número de triangulaciones de un polígono convexo de n vértices. Por ejemplo,

   numeroTriangulaciones 3  == 1
   numeroTriangulaciones 5  == 5
   numeroTriangulaciones 6  == 14
   numeroTriangulaciones 7  == 42
   numeroTriangulaciones 50 == 131327898242169365477991900
   length (show (numeroTriangulaciones   800)) ==  476
   length (show (numeroTriangulaciones  1000)) ==  597
   length (show (numeroTriangulaciones 10000)) == 6014

numeroTriangulaciones 3 == 1

numeroTriangulaciones 5 == 5

numeroTriangulaciones 6 == 14

numeroTriangulaciones 7 == 42

numeroTriangulaciones 50 == 131327898242169365477991900

length (show (numeroTriangulaciones 800)) == 476

length (show (numeroTriangulaciones 1000)) == 597

length (show (numeroTriangulaciones 10000)) == 6014

Soluciones

import Data.Array (Array, (!), array)
import Data.List  (genericIndex)
import qualified Data.Vector as V

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

numeroTriangulaciones :: Integer -> Integer
numeroTriangulaciones 2 = 1
numeroTriangulaciones n = sum (zipWith (*) ts (reverse ts))
  where ts = [numeroTriangulaciones k | k <- [2..n-1]]

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

--    λ> map numeroTriangulaciones2 [2..15]
--    [1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]
numeroTriangulaciones2 :: Integer -> Integer
numeroTriangulaciones2 n = 
  head (sucNumeroTriangulacionesInversas `genericIndex` (n-2))

--    λ> mapM_ print (take 10 sucNumeroTriangulacionesInversas)
--    [1]
--    [1,1]
--    [2,1,1]
--    [5,2,1,1]
--    [14,5,2,1,1]
--    [42,14,5,2,1,1]
--    [132,42,14,5,2,1,1]
--    [429,132,42,14,5,2,1,1]
--    [1430,429,132,42,14,5,2,1,1]
--    [4862,1430,429,132,42,14,5,2,1,1]
sucNumeroTriangulacionesInversas :: [[Integer]]        
sucNumeroTriangulacionesInversas = iterate f [1]
  where f ts = sum (zipWith (*) ts (reverse ts)) : ts

-- 3ª solución (con programación dinámica)
-- =======================================

numeroTriangulaciones3 :: Integer -> Integer
numeroTriangulaciones3 n = vectorTriang n ! n

--    λ> vectorTriang 9
--    array (2,9) [(2,1),(3,1),(4,2),(5,5),(6,14),(7,42),(8,132),(9,429)]
vectorTriang :: Integer -> Array Integer Integer
vectorTriang n = v
  where v = array (2,n) [(i, f i) | i <-[2..n]]
        f 2 = 1
        f i = sum [v!j*v!(i-j+1) | j <-[2..i-1]]

-- 4ª solución (con los números de Catalan)
-- ========================================

-- Al calcular por primeros números de triangulaciones se obtiene
--    λ> map numeroTriangulaciones [2..12]
--    [1,1,2,5,14,42,132,429,1430,4862,16796]
-- Se observa que se corresponden con los números de Catalan
-- http://bit.ly/2FOc1S1
-- 
-- El n-ésimo número de Catalan es
--    (2n)! / (n! * (n+1)!)
-- El número de triangulaciones de un polígono de n lados es el
-- (n-2)-ésimo número de Catalan.

numeroTriangulaciones4 :: Integer -> Integer
numeroTriangulaciones4 n = numeroCatalan (n-2) 

numeroCatalan :: Integer -> Integer
numeroCatalan n =
  factorial (2*n) `div` (factorial (n+1) * factorial n)

factorial :: Integer -> Integer
factorial n = product [1..n]

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

numeroTriangulaciones5 :: Integer -> Integer
numeroTriangulaciones5 n = v V.! (m-2)
   where v = V.constructN m
           (\w -> if   V.null w then 1
                  else V.sum (V.zipWith (*) w (V.reverse w)))
         m = fromIntegral n


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

numeroTriangulaciones6 :: Integer -> Integer
numeroTriangulaciones6 n = nCr (2*n-4, n-2) `div` (n-1)
  where nCr (n,m)   = factorial n `div` (factorial (n-m) * factorial m)
        factorial n = product [1..n]

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

--    λ> numeroTriangulaciones 22
--    6564120420
--    (3.97 secs, 668,070,936 bytes)
--    λ> numeroTriangulaciones2 22
--    6564120420
--    (0.01 secs, 180,064 bytes)
--    λ> numeroTriangulaciones3 22
--    6564120420
--    (0.01 secs, 285,792 bytes)
--    
--    λ> length (show (numeroTriangulaciones2 800))
--    476
--    (0.59 secs, 125,026,824 bytes)
--    λ> length (show (numeroTriangulaciones3 800))
--    476
--    (1.95 secs, 334,652,936 bytes)
--    λ> length (show (numeroTriangulaciones4 800))
--    476
--    (0.01 secs, 2,960,088 bytes)
--    λ> length (show (numeroTriangulaciones5 800))
--    476
--    (0.65 secs, 200,415,640 bytes)
--    λ> length (show (numeroTriangulaciones6 800))
--    476
--    (0.01 secs, 2,960,224 bytes)
--    
--    λ> length (show (numeroTriangulaciones4 (10^4)))
--    6014
--    (1.80 secs, 542,364,320 bytes)
--    λ> length (show (numeroTriangulaciones6 (10^4)))
--    6014
--    (1.87 secs, 542,351,136 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

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

import Data.List (genericIndex)

import qualified Data.Vector as V

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

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

numeroTriangulaciones :: Integer -> Integer

numeroTriangulaciones 2 = 1

numeroTriangulaciones n = sum (zipWith (*) ts (reverse ts))

where ts = [numeroTriangulaciones k | k <- [2..n-1]]

-- 2ª solución

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

-- λ> map numeroTriangulaciones2 [2..15]

-- [1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]

numeroTriangulaciones2 :: Integer -> Integer

numeroTriangulaciones2 n =

head (sucNumeroTriangulacionesInversas `genericIndex` (n-2))

-- λ> mapM_ print (take 10 sucNumeroTriangulacionesInversas)

-- [1]

-- [1,1]

-- [2,1,1]

-- [5,2,1,1]

-- [14,5,2,1,1]

-- [42,14,5,2,1,1]

-- [132,42,14,5,2,1,1]

-- [429,132,42,14,5,2,1,1]

-- [1430,429,132,42,14,5,2,1,1]

-- [4862,1430,429,132,42,14,5,2,1,1]

sucNumeroTriangulacionesInversas :: [[Integer]]

sucNumeroTriangulacionesInversas = iterate f [1]

where f ts = sum (zipWith (*) ts (reverse ts)) : ts

-- 3ª solución (con programación dinámica)

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

numeroTriangulaciones3 :: Integer -> Integer

numeroTriangulaciones3 n = vectorTriang n ! n

-- λ> vectorTriang 9

-- array (2,9) [(2,1),(3,1),(4,2),(5,5),(6,14),(7,42),(8,132),(9,429)]

vectorTriang :: Integer -> Array Integer Integer

vectorTriang n = v

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

f 2 = 1

f i = sum [v!j*v!(i-j+1) | j <-[2..i-1]]

-- 4ª solución (con los números de Catalan)

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

-- Al calcular por primeros números de triangulaciones se obtiene

-- λ> map numeroTriangulaciones [2..12]

-- [1,1,2,5,14,42,132,429,1430,4862,16796]

-- Se observa que se corresponden con los números de Catalan

-- http://bit.ly/2FOc1S1

-- El n-ésimo número de Catalan es

-- (2n)! / (n! * (n+1)!)

-- El número de triangulaciones de un polígono de n lados es el

-- (n-2)-ésimo número de Catalan.

numeroTriangulaciones4 :: Integer -> Integer

numeroTriangulaciones4 n = numeroCatalan (n-2)

numeroCatalan :: Integer -> Integer

numeroCatalan n =

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

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 5ª solución

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

numeroTriangulaciones5 :: Integer -> Integer

numeroTriangulaciones5 n = v V.! (m-2)

where v = V.constructN m

(\w -> if V.null w then 1

else V.sum (V.zipWith (*) w (V.reverse w)))

m = fromIntegral n

-- 6ª solución

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

numeroTriangulaciones6 :: Integer -> Integer

numeroTriangulaciones6 n = nCr (2*n-4, n-2) `div` (n-1)

where nCr (n,m) = factorial n `div` (factorial (n-m) * factorial m)

factorial n = product [1..n]

-- Comparación de eficiencia

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

-- λ> numeroTriangulaciones 22

-- 6564120420

-- (3.97 secs, 668,070,936 bytes)

-- λ> numeroTriangulaciones2 22

-- 6564120420

-- (0.01 secs, 180,064 bytes)

-- λ> numeroTriangulaciones3 22

-- 6564120420

-- (0.01 secs, 285,792 bytes)

-- λ> length (show (numeroTriangulaciones2 800))

-- 476

-- (0.59 secs, 125,026,824 bytes)

-- λ> length (show (numeroTriangulaciones3 800))

-- 476

-- (1.95 secs, 334,652,936 bytes)

-- λ> length (show (numeroTriangulaciones4 800))

-- 476

-- (0.01 secs, 2,960,088 bytes)

-- λ> length (show (numeroTriangulaciones5 800))

-- 476

-- (0.65 secs, 200,415,640 bytes)

-- λ> length (show (numeroTriangulaciones6 800))

-- 476

-- (0.01 secs, 2,960,224 bytes)

-- λ> length (show (numeroTriangulaciones4 (10^4)))

-- 6014

-- (1.80 secs, 542,364,320 bytes)

-- λ> length (show (numeroTriangulaciones6 (10^4)))

-- 6014

-- (1.87 secs, 542,351,136 bytes)

Subconjuntos con suma dada

PorJosé A. Alonso 25-abril-20182-mayo-2018

Sea S un conjunto finito de números enteros positivos y n un número natural. El problema consiste en calcular los subconjuntos de S cuya suma es n.

Definir la función

   subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

1	subconjuntosSuma:: [Int] -> Int -> [[Int]] tal que

tal que (subconjuntosSuma xs n) es la lista de los subconjuntos de xs cuya suma es n. Por ejemplo,

   λ> subconjuntosSuma [3,34,4,12,5,2] 9
   [[4,5],[3,4,2]]
   λ> subconjuntosSuma [3,34,4,12,5,2] 13
   []
   λ> length (subconjuntosSuma [1..100] (sum [1..100]))
   1

λ> subconjuntosSuma [3,34,4,12,5,2] 9

[[4,5],[3,4,2]]

λ> subconjuntosSuma [3,34,4,12,5,2] 13

[]

λ> length (subconjuntosSuma [1..100] (sum [1..100]))

Soluciones

import Data.Array
import qualified Data.Matrix as M
import Data.Maybe
import Data.List
import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]
subconjuntosSuma1 xs n =
  [ys | ys <- subsequences xs, sum ys == n]

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

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]
subconjuntosSuma2 _  0 = [[]]
subconjuntosSuma2 [] _ = []
subconjuntosSuma2 (x:xs) n
  | n < x     = subconjuntosSuma2 xs n
  | otherwise = subconjuntosSuma2 xs n ++
                [x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)
-- =========================================

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]
subconjuntosSuma3 xs n =
  map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la
-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,
--    λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)
--    [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--     [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
-- Con las cabeceras,
--            0    1     2  3     4       5     6       7  8       9 
--    []     [[[]],[],   [],[],   [],     [],   [],     [],[],    [],
--    [1]     [[]],[[1]],[],[],   [],     [],   [],     [],[],    [],
--    [1,3]   [[]],[[1]],[],[[3]],[[3,1]],[],   [],     [],[],    [],
--    [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]
matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma3 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)
-- =========================================

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]
subconjuntosSuma4 xs = aux (sort xs)
  where aux _  0 = [[]]
        aux [] _ = []
        aux (y:ys) n
          | y > n     = []
          | otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)
-- ====================================

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]
subconjuntosSuma5 xs n =
  matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]
matrizSubconjuntosSuma5 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = [[]]
        f 0 _ = []
        f i j | v ! i > j = []
              | otherwise = q ! (i-1,j) ++
                            [v!i:ys | ys <- q ! (i-1,j-v!i)]

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

prop_subconjuntosSuma :: [Int] -> Int -> Bool
prop_subconjuntosSuma xs n =
  all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m
                                       , subconjuntosSuma4 ys m
                                       , subconjuntosSuma5 ys m ]
  where ys = map (\y -> 1 + abs y) xs 
        m  = abs n
        ordenado = sort . map sort
        igual xss yss = ordenado xss == ordenado yss

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

100

101

102

import Data.Array

import qualified Data.Matrix as M

import Data.Maybe

import Data.List

import Test.QuickCheck

-- 1ª definición (Calculando todos los subconjuntos)

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

subconjuntosSuma1 :: [Int] -> Int -> [[Int]]

subconjuntosSuma1 xs n =

[ys | ys <- subsequences xs, sum ys == n]

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

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

subconjuntosSuma2 :: [Int] -> Int -> [[Int]]

subconjuntosSuma2 _ 0 = [[]]

subconjuntosSuma2 [] _ = []

subconjuntosSuma2 (x:xs) n

| n < x = subconjuntosSuma2 xs n

| otherwise = subconjuntosSuma2 xs n ++

[x:ys | ys <- subconjuntosSuma2 xs (n-x)]

-- 3ª definición (por programación dinámica)

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

subconjuntosSuma3 :: [Int] -> Int -> [[Int]]

subconjuntosSuma3 xs n =

map reverse (matrizSubconjuntosSuma3 xs n ! (length xs,n))

-- (matrizSubconjuntosSuma3 xs m) es la matriz q tal que q(i,j) es la

-- lista de los subconjuntos de (take i xs) que suman j. Por ejemplo,

-- λ> elems (matrizSubconjuntosSuma3 [1,3,5] 9)

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

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

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

-- [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

-- Con las cabeceras,

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

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

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

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

-- [1,3,5] [[]],[[1]],[],[[3]],[[3,1]],[[5]],[[5,1]],[],[[5,3]],[[5,3,1]]]

matrizSubconjuntosSuma3 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma3 xs n = q

where m = length xs

v = listArray (1,m) xs

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

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | j < v ! i = q ! (i-1,j)

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

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- 4ª definición (ordenando y por recursión)

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

subconjuntosSuma4 :: [Int] -> Int -> [[Int]]

subconjuntosSuma4 xs = aux (sort xs)

where aux _ 0 = [[]]

aux [] _ = []

aux (y:ys) n

| y > n = []

| otherwise = aux ys n ++ [y:zs | zs <- aux ys (n-y)]

-- 5ª definición (ordenando y dinámica)

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

subconjuntosSuma5 :: [Int] -> Int -> [[Int]]

subconjuntosSuma5 xs n =

matrizSubconjuntosSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizSubconjuntosSuma5 :: [Int] -> Int -> Array (Int,Int) [[Int]]

matrizSubconjuntosSuma5 xs n = q

where m = length xs

v = listArray (1,m) xs

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

j <- [0..n]]

f _ 0 = [[]]

f 0 _ = []

f i j | v ! i > j = []

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

[v!i:ys | ys <- q ! (i-1,j-v!i)]

-- Equivalencia

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

prop_subconjuntosSuma :: [Int] -> Int -> Bool

prop_subconjuntosSuma xs n =

all (`igual` subconjuntosSuma2 ys m) [ subconjuntosSuma3 ys m

, subconjuntosSuma4 ys m

, subconjuntosSuma5 ys m ]

where ys = map (\y -> 1 + abs y) xs

m = abs n

ordenado = sort . map sort

igual xss yss = ordenado xss == ordenado yss

-- La comprobación es

-- λ> quickCheck prop_subconjuntosSuma

-- +++ OK, passed 100 tests.

Notas de evaluación acumulada

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

La evaluación acumulada, las notas se calculan recursivamente con la siguiente función

   N(1) = E(1)
   N(k) = máximo(E(k), 0.4*N(k-1)+0.6*E(k))

1 2	N(1) = E(1) N(k) = máximo(E(k), 0.4N(k-1)+0.6E(k))

donde E(k) es la nota del examen k. Por ejemplo, si las notas de los exámenes son [3,7,6,3] entonces las acumuladas son [3.0,7.0,6.4,4.4]

Las notas e los exámenes se encuentran en ficheros CSV con los valores separados por comas. Cada línea representa la nota de un alumno, el primer valor es el identificador del alumno y los restantes son sus notas. Por ejemplo, el contenido de examenes.csv es

   juaruigar,3,7,9,3
   evadialop,3,6,7,4
   carrodmes,0,9,8,7

juaruigar,3,7,9,3

evadialop,3,6,7,4

carrodmes,0,9,8,7

Definir las funciones

   acumuladas      :: [Double] -> [Double]
   notasAcumuladas :: FilePath -> FilePath -> IO ()

1 2	acumuladas :: [Double] -> [Double] notasAcumuladas :: FilePath -> FilePath -> IO ()

tales que

(acumuladas xs) es la lista de las notas acumuladas (redondeadas con un decimal) de los notas de los exámenes xs. Por ejemplo,

     acumuladas [2,5]      ==  [2.0,5.0]
     acumuladas [5,2]      ==  [5.0,3.2]
     acumuladas [3,7,6,3]  ==  [3.0,7.0,6.4,4.4]
     acumuladas [3,6,7,3]  ==  [3.0,6.0,7.0,4.6]

acumuladas [2,5] == [2.0,5.0]

acumuladas [5,2] == [5.0,3.2]

acumuladas [3,7,6,3] == [3.0,7.0,6.4,4.4]

acumuladas [3,6,7,3] == [3.0,6.0,7.0,4.6]

(notasAcumuladas f1 f2) que escriba en el fichero f2 las notas acumuladas correspondientes a las notas de los exámenes del fichero f1. Por ejemplo, al evaluar

     notasAcumuladas "examenes.csv" "acumuladas.csv"

1	notasAcumuladas "examenes.csv" "acumuladas.csv"

escribe en el fichero acumuladas.csv

     juaruigar,3.0,7.0,9.0,5.4
     evadialop,3.0,6.0,7.0,5.2
     carrodmes,0.0,9.0,8.4,7.6

juaruigar,3.0,7.0,9.0,5.4

evadialop,3.0,6.0,7.0,5.2

carrodmes,0.0,9.0,8.4,7.6

Soluciones

import Text.CSV
import Data.Either

-- Definicioń de acumuladas
-- ========================

acumuladas :: [Double] -> [Double]
acumuladas = reverse . aux . reverse
  where aux []     = []
        aux [x]    = [x]
        aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys 
          where (y:ys) = aux xs

--    conUnDecimal 7.26  ==  7.3
--    conUnDecimal 7.24  ==  7.2
conUnDecimal :: Double -> Double
conUnDecimal x = fromIntegral (round (10*x)) / 10

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

notasAcumuladas :: FilePath -> FilePath -> IO ()
notasAcumuladas f1 f2 = do
  cs <- readFile f1
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             . cadenaALista
                             )
                             (contenidoALineasDeNotas cs)))

--   λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n  \n"
--   ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]
contenidoALineasDeNotas :: String -> [String]
contenidoALineasDeNotas = filter esLineaDeNotas . lines
  where esLineaDeNotas = elem ','

--    cadenaALista "a,b c,d"            ==  ["a","b c","d"]
--    cadenaALista "juaruigar,3,7,6,3"  ==  ["juaruigar","3","7","6","3"]
cadenaALista :: String -> [String]
cadenaALista cs
  | tieneComas cs = d : cadenaALista ds
  | otherwise     = [cs]
  where (d,_:ds)   = span (/=',') cs
        tieneComas = elem ','

--    λ> listaANota ["juaruigar","3","7","6","3"]
--    ("juaruigar",[3.0,7.0,6.0,3.0])
listaANota :: [String] -> (String,[Double])
listaANota (x:xs) = (x,map read xs)

--   λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])
--   ("juaruigar",[3.0,7.0,6.4,4.4])
notaAAcumuladas :: (String,[Double]) -> (String,[Double])
notaAAcumuladas (x,xs) = (x, acumuladas xs)

--    λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])
--    "juaruigar,3.0,7.0,6.4,4.4"
acumuladaACadena :: (String,[Double]) -> String
acumuladaACadena (x,xs) =
  x ++ "," ++ tail (init (show xs))

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()
notasAcumuladas2 f1 f2 = do
  cs <- readFile f1
  let (Right csv) = parseCSV f1 cs
  let notas = [xs | xs <- csv, length xs > 1]
  writeFile f2 (unlines (map ( acumuladaACadena
                             . notaAAcumuladas
                             . listaANota
                             )
                             notas))

import Text.CSV

import Data.Either

-- Definicioń de acumuladas

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

acumuladas :: [Double] -> [Double]

acumuladas = reverse . aux . reverse

where aux [] = []

aux [x] = [x]

aux (x:xs) = conUnDecimal (max x (0.6*x+0.4*y)) : y : ys

where (y:ys) = aux xs

-- conUnDecimal 7.26 == 7.3

-- conUnDecimal 7.24 == 7.2

conUnDecimal :: Double -> Double

conUnDecimal x = fromIntegral (round (10*x)) / 10

-- 1ª definición de notasAcumuladas

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

notasAcumuladas :: FilePath -> FilePath -> IO ()

notasAcumuladas f1 f2 = do

cs <- readFile f1

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

. cadenaALista

)

(contenidoALineasDeNotas cs)))

-- λ> contenidoALineasDeNotas "juaruigar,3,7,6,3\nevadialop,3,6,7,3\n\n \n"

-- ["juaruigar,3,7,6,3","evadialop,3,6,7,3"]

contenidoALineasDeNotas :: String -> [String]

contenidoALineasDeNotas = filter esLineaDeNotas . lines

where esLineaDeNotas = elem ','

-- cadenaALista "a,b c,d" == ["a","b c","d"]

-- cadenaALista "juaruigar,3,7,6,3" == ["juaruigar","3","7","6","3"]

cadenaALista :: String -> [String]

cadenaALista cs

| tieneComas cs = d : cadenaALista ds

| otherwise = [cs]

where (d,_:ds) = span (/=',') cs

tieneComas = elem ','

-- λ> listaANota ["juaruigar","3","7","6","3"]

-- ("juaruigar",[3.0,7.0,6.0,3.0])

listaANota :: [String] -> (String,[Double])

listaANota (x:xs) = (x,map read xs)

-- λ> notaAAcumuladas ("juaruigar",[3.0,7.0,6.0,3.0])

-- ("juaruigar",[3.0,7.0,6.4,4.4])

notaAAcumuladas :: (String,[Double]) -> (String,[Double])

notaAAcumuladas (x,xs) = (x, acumuladas xs)

-- λ> acumuladaACadena ("juaruigar",[3.0,7.0,6.4,4.4])

-- "juaruigar,3.0,7.0,6.4,4.4"

acumuladaACadena :: (String,[Double]) -> String

acumuladaACadena (x,xs) =

x ++ "," ++ tail (init (show xs))

-- 2ª definición de notasAcumuladas

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

notasAcumuladas2 :: FilePath -> FilePath -> IO ()

notasAcumuladas2 f1 f2 = do

cs <- readFile f1

let (Right csv) = parseCSV f1 cs

let notas = [xs | xs <- csv, length xs > 1]

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

)

notas))

Reducción de opuestos

PorJosé A. Alonso 18-abril-201826-abril-2018

Se considera el siguiente procedimiento de reducción de listas: busca un par de elementos consecutivos iguales pero con signos opuestos, se eliminan dichos elementos y se continúa el proceso hasta que no se encuentren pares de elementos consecutivos iguales pero con signos opuestos. Por ejemplo, la reducción de [-2,1,-1,2,3,4,-3] es

   [-2,1,-1,2,3,4,-3]    (se elimina el par (1,-1))
   -> [-2,2,3,4,-3]      (se elimina el par (-2,2))
   -> [3,4,-3]           (el par (3,-3) no son consecutivos)

[-2,1,-1,2,3,4,-3] (se elimina el par (1,-1))

-> [-2,2,3,4,-3] (se elimina el par (-2,2))

-> [3,4,-3] (el par (3,-3) no son consecutivos)

Definir la función

   reducida :: [Int] -> [Int]

1	reducida :: [Int] -> [Int]

tal que (reducida xs) es la lista obtenida aplicando a xs el de eliminación de pares de elementos consecutivos opuestos. Por ejemplo,

   reducida [-2,1,-1,2,3,4,-3]           == [3,4,-3]
   reducida [-2,1,-1,2,3,-4,4,-3]        == []
   reducida [-2,1,-1,2,5,3,-4,4,-3]      == [5]
   reducida [-2,1,-1,2,5,3,-4,4,-3,-5]   == []

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

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

reducida [-2,1,-1,2,5,3,-4,4,-3] == [5]

reducida [-2,1,-1,2,5,3,-4,4,-3,-5] == []

Soluciones

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

reducida :: [Int] -> [Int]
reducida xs | xs == ys  = xs
            | otherwise = reducida ys
            where ys = paso xs

paso :: [Int] -> [Int]
paso [] = []
paso [x] = [x]
paso (x:y:zs) | x == -y   = paso zs
              | otherwise = x : paso (y:zs)

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

reducida2 :: [Int] -> [Int]
reducida2 xs = aux xs []
    where aux [] ys                   = reverse ys
          aux (x:xs) (y:ys) | x == -y = aux xs ys
          aux (x:xs) ys               = aux xs (x:ys)

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

--    λ> reducida (take (10^7) (cycle [1,-1]))
--    []
--    (9.40 secs, 1,280,127,720 bytes)
--    λ> reducida2 (take (10^7) (cycle [1,-1]))
--    []
--    (12.16 secs, 2,080,127,560 bytes)

-- 1ª solución

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

reducida :: [Int] -> [Int]

reducida xs | xs == ys = xs

| otherwise = reducida ys

where ys = paso xs

paso :: [Int] -> [Int]

paso [] = []

paso [x] = [x]

paso (x:y:zs) | x == -y = paso zs

| otherwise = x : paso (y:zs)

-- 2ª solución

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

reducida2 :: [Int] -> [Int]

reducida2 xs = aux xs []

where aux [] ys = reverse ys

aux (x:xs) (y:ys) | x == -y = aux xs ys

aux (x:xs) ys = aux xs (x:ys)

-- Comparación de eficiencia

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

-- λ> reducida (take (10^7) (cycle [1,-1]))

-- []

-- (9.40 secs, 1,280,127,720 bytes)

-- λ> reducida2 (take (10^7) (cycle [1,-1]))

-- []

-- (12.16 secs, 2,080,127,560 bytes)

Decidir si existe un subconjunto con suma dada

PorJosé A. Alonso 16-abril-201826-abril-2018

Sea S un conjunto finito de números naturales y m un número natural. El problema consiste en determinar si existe un subconjunto de S cuya suma es m. Por ejemplo, si S = [3,34,4,12,5,2] y m = 9, existe un subconjunto de S, [4,5], cuya suma es 9. En cambio, no hay ningún subconjunto de S que sume 13.

Definir la función

    existeSubSuma :: [Int] -> Int -> Bool

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

tal que (existeSubSuma xs m) se verifica si existe algún subconjunto de xs que sume m. Por ejemplo,

    existeSubSuma [3,34,4,12,5,2] 9                == True
    existeSubSuma [3,34,4,12,5,2] 13               == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13  == False
    existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True
    existeSubSuma [1..200] (sum [1..200])          == True

existeSubSuma [3,34,4,12,5,2] 9 == True

existeSubSuma [3,34,4,12,5,2] 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 13 == False

existeSubSuma ([3,34,4,12,5,2]++[20..400]) 654 == True

existeSubSuma [1..200] (sum [1..200]) == True

Soluciones

import Data.List  (subsequences, sort)
import Data.Array (Array, array, listArray, (!))
 
-- 1ª definición (Calculando todos los subconjuntos)
-- =================================================
 
existeSubSuma1 :: [Int] -> Int -> Bool
existeSubSuma1 xs n =
  any (\ys -> sum ys == n) (subsequences xs)
 
-- 2ª definición (por recursión)
-- =============================
 
existeSubSuma2 :: [Int] -> Int -> Bool
existeSubSuma2 _  0 = True
existeSubSuma2 [] _ = False
existeSubSuma2 (x:xs) n
  | n < x     = existeSubSuma2 xs n
  | otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n 
  
-- 3ª definición (por programación dinámica)
-- =========================================
 
existeSubSuma3 :: [Int] -> Int -> Bool
existeSubSuma3 xs n =
  matrizExisteSubSuma3 xs n ! (length xs,n) 
 
-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica
-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,
--    λ> elems (matrizExisteSubSuma3 [1,3,5] 9)
--    [True,False,False,False,False,False,False,False,False,False,
--     True,True, False,False,False,False,False,False,False,False,
--     True,True, False,True, True, False,False,False,False,False,
--     True,True, False,True, True, True, True, False,True, True]
-- Con las cabeceras,
--            0     1     2     3     4     5     6     7     8     9
--    []     [True,False,False,False,False,False,False,False,False,False,
--    [1]     True,True, False,False,False,False,False,False,False,False,
--    [1,3]   True,True, False,True, True, False,False,False,False,False,
--    [1,3,5] True,True, False,True, True, True, True, False,True, True]
matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma3 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = True
        f 0 _ = False
        f i j | j < v ! i = q ! (i-1,j)
              | otherwise = q ! (i-1,j-v!i) || q ! (i-1,j)
 
-- 4ª definición (ordenando y por recursión)
-- =========================================
 
existeSubSuma4 :: [Int] -> Int -> Bool
existeSubSuma4 xs = aux (sort xs)
  where aux _  0 = True
        aux [] _ = False
        aux (y:ys) n
          | y <= n    = aux ys (n-y) || aux ys n
          | otherwise = False
 
-- 5ª definición (ordenando y dinámica)
-- ====================================
 
existeSubSuma5 :: [Int] -> Int -> Bool
existeSubSuma5 xs n =
  matrizExisteSubSuma5 (reverse (sort xs)) n ! (length xs,n) 
 
matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool
matrizExisteSubSuma5 xs n = q
  where m = length xs
        v = listArray (1,m) xs
        q = array ((0,0),(m,n)) [((i,j), f i j) | i <- [0..m],
                                                  j <- [0..n]]
        f _ 0 = True
        f 0 _ = False
        f i j | v ! i <= j = q ! (i-1,j-v!i) || q ! (i-1,j) 
              | otherwise  = False
 
-- Equivalencia
-- ============
 
prop_existeSubSuma :: [Int] -> Int -> Bool
prop_existeSubSuma xs n =
  all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m
                               , existeSubSuma4 ys m
                               , existeSubSuma5 ys m ]
  where ys = map abs xs
        m  = abs n
 
-- La comprobación es
--    λ> quickCheck prop_existeSubSuma
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia:
-- ==========================

--    λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)
--    True
--    (7.76 secs, 3,892,403,928 bytes)
--    λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)
--    True
--    (0.02 secs, 95,968 bytes)
--    λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)
--    True
--    (0.03 secs, 6,055,200 bytes)
--    λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)
--    True
--    (0.01 secs, 98,880 bytes)
--    λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)
--    True
--    (0.02 secs, 2,827,560 bytes)
  
--    λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)
--    True
--    (0.01 secs, 182,280 bytes)
--    λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)
--    True
--    (8.89 secs, 1,875,071,968 bytes)
--    λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)
--    True
--    (0.02 secs, 217,128 bytes)
--    λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)
--    True
--    (8.66 secs, 1,875,087,976 bytes)
--
--    λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (2.82 secs, 323,372,512 bytes)
--    λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.65 secs, 221,806,376 bytes)
--    λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (4.12 secs, 535,153,152 bytes)
--    λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]
--    True
--    (0.73 secs, 238,579,696 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

import Data.List (subsequences, sort)

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

-- 1ª definición (Calculando todos los subconjuntos)

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

existeSubSuma1 :: [Int] -> Int -> Bool

existeSubSuma1 xs n =

any (\ys -> sum ys == n) (subsequences xs)

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

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

existeSubSuma2 :: [Int] -> Int -> Bool

existeSubSuma2 _ 0 = True

existeSubSuma2 [] _ = False

existeSubSuma2 (x:xs) n

| n < x = existeSubSuma2 xs n

| otherwise = existeSubSuma2 xs (n-x) || existeSubSuma2 xs n

-- 3ª definición (por programación dinámica)

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

existeSubSuma3 :: [Int] -> Int -> Bool

existeSubSuma3 xs n =

matrizExisteSubSuma3 xs n ! (length xs,n)

-- (matrizExisteSubSuma3 xs m) es la matriz q tal que q(i,j) se verifica

-- si existe algún subconjunto de (take i xs) que sume j. Por ejemplo,

-- λ> elems (matrizExisteSubSuma3 [1,3,5] 9)

-- [True,False,False,False,False,False,False,False,False,False,

-- True,True, False,False,False,False,False,False,False,False,

-- True,True, False,True, True, False,False,False,False,False,

-- True,True, False,True, True, True, True, False,True, True]

-- Con las cabeceras,

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

-- [] [True,False,False,False,False,False,False,False,False,False,

-- [1] True,True, False,False,False,False,False,False,False,False,

-- [1,3] True,True, False,True, True, False,False,False,False,False,

-- [1,3,5] True,True, False,True, True, True, True, False,True, True]

matrizExisteSubSuma3 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma3 xs n = q

where m = length xs

v = listArray (1,m) xs

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

j <- [0..n]]

f _ 0 = True

f 0 _ = False

f i j | j < v ! i = q ! (i-1,j)

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

-- 4ª definición (ordenando y por recursión)

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

existeSubSuma4 :: [Int] -> Int -> Bool

existeSubSuma4 xs = aux (sort xs)

where aux _ 0 = True

aux [] _ = False

aux (y:ys) n

| y <= n = aux ys (n-y) || aux ys n

| otherwise = False

-- 5ª definición (ordenando y dinámica)

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

existeSubSuma5 :: [Int] -> Int -> Bool

existeSubSuma5 xs n =

matrizExisteSubSuma5 (reverse (sort xs)) n ! (length xs,n)

matrizExisteSubSuma5 :: [Int] -> Int -> Array (Int,Int) Bool

matrizExisteSubSuma5 xs n = q

where m = length xs

v = listArray (1,m) xs

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

j <- [0..n]]

f _ 0 = True

f 0 _ = False

f i j | v ! i <= j = q ! (i-1,j-v!i) || q ! (i-1,j)

| otherwise = False

-- Equivalencia

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

prop_existeSubSuma :: [Int] -> Int -> Bool

prop_existeSubSuma xs n =

all (== existeSubSuma2 ys m) [ existeSubSuma3 ys m

, existeSubSuma4 ys m

, existeSubSuma5 ys m ]

where ys = map abs xs

m = abs n

-- La comprobación es

-- λ> quickCheck prop_existeSubSuma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

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

-- λ> let xs = [1..22] in existeSubSuma1 xs (sum xs)

-- True

-- (7.76 secs, 3,892,403,928 bytes)

-- λ> let xs = [1..22] in existeSubSuma2 xs (sum xs)

-- True

-- (0.02 secs, 95,968 bytes)

-- λ> let xs = [1..22] in existeSubSuma3 xs (sum xs)

-- True

-- (0.03 secs, 6,055,200 bytes)

-- λ> let xs = [1..22] in existeSubSuma4 xs (sum xs)

-- True

-- (0.01 secs, 98,880 bytes)

-- λ> let xs = [1..22] in existeSubSuma5 xs (sum xs)

-- True

-- (0.02 secs, 2,827,560 bytes)

-- λ> let xs = [1..200] in existeSubSuma2 xs (sum xs)

-- True

-- (0.01 secs, 182,280 bytes)

-- λ> let xs = [1..200] in existeSubSuma3 xs (sum xs)

-- True

-- (8.89 secs, 1,875,071,968 bytes)

-- λ> let xs = [1..200] in existeSubSuma4 xs (sum xs)

-- True

-- (0.02 secs, 217,128 bytes)

-- λ> let xs = [1..200] in existeSubSuma5 xs (sum xs)

-- True

-- (8.66 secs, 1,875,087,976 bytes)

-- λ> and [existeSubSuma2 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (2.82 secs, 323,372,512 bytes)

-- λ> and [existeSubSuma3 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.65 secs, 221,806,376 bytes)

-- λ> and [existeSubSuma4 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (4.12 secs, 535,153,152 bytes)

-- λ> and [existeSubSuma5 [1..20] n | n <- [1..sum [1..20]]]

-- True

-- (0.73 secs, 238,579,696 bytes)

Conjetura de Goldbach

PorJosé A. Alonso 21-marzo-201826-marzo-2022

Una forma de la conjetura de Golbach afirma que todo entero mayor que 1 se puede escribir como la suma de uno, dos o tres números primos.

Si se define el índice de Goldbach de n > 1 como la mínima cantidad de primos necesarios para que su suma sea n, entonces la conjetura de Goldbach afirma que todos los índices de Goldbach de los enteros mayores que 1 son menores que 4.

Definir las siguientes funciones

   indiceGoldbach  :: Int -> Int
   graficaGoldbach :: Int -> IO ()

1 2	indiceGoldbach :: Int -> Int graficaGoldbach :: Int -> IO ()

tales que

(indiceGoldbach n) es el índice de Goldbach de n. Por ejemplo,

     indiceGoldbach 2                        ==  1
     indiceGoldbach 4                        ==  2
     indiceGoldbach 27                       ==  3
     sum (map indiceGoldbach [2..5000])      ==  10619
     maximum (map indiceGoldbach [2..5000])  ==  3

indiceGoldbach 2 == 1

indiceGoldbach 4 == 2

indiceGoldbach 27 == 3

sum (map indiceGoldbach [2..5000]) == 10619

maximum (map indiceGoldbach [2..5000]) == 3

(graficaGoldbach n) dibuja la gráfica de los índices de Goldbach de los números entre 2 y n. Por ejemplo, (graficaGoldbach 150) dibuja

Comprobar con QuickCheck la conjetura de Goldbach anterior.

Soluciones

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


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

indiceGoldbach :: Int -> Int
indiceGoldbach n =
  minimum (map length (particiones n))

particiones :: Int -> [[Int]]
particiones n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)

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

indiceGoldbach2 :: Int -> Int
indiceGoldbach2 x =
  head [n | n <- [1..], esSumaDe x n]

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n
-- primos. Por ejemplo,
--    esSumaDe 2  1  ==  True
--    esSumaDe 4  1  ==  False
--    esSumaDe 4  2  ==  True
--    esSumaDe 27 2  ==  False
--    esSumaDe 27 3  ==  True
esSumaDe :: Int -> Int -> Bool
esSumaDe x 1 = isPrime x
esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

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

indiceGoldbach3 :: Int -> Int
indiceGoldbach3 x =
  head [n | n <- [1..], esSumaDe3 x n]

esSumaDe3 :: Int -> Int -> Bool
esSumaDe3 x n = a ! (x,n) where
  a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]
  f i 1 = isPrime i
  f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

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

indiceGoldbach4 :: Int -> Int
indiceGoldbach4 n = v ! n where
  v = array (2,n) [(i,f i) | i <- [2..n]]
  f i | isPrime i = 1
      | otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

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

--    λ> sum (map indiceGoldbach [2..80])
--    142
--    (2.66 secs, 1,194,330,496 bytes)
--    λ> sum (map indiceGoldbach2 [2..80])
--    142
--    (0.01 secs, 1,689,944 bytes)
--    λ> sum (map indiceGoldbach3 [2..80])
--    142
--    (0.03 secs, 27,319,296 bytes)
--    λ> sum (map indiceGoldbach4 [2..80])
--    142
--    (0.03 secs, 47,823,656 bytes)
--    
--    λ> sum (map indiceGoldbach2 [2..1000])
--    2030
--    (0.10 secs, 200,140,264 bytes)
--    λ> sum (map indiceGoldbach3 [2..1000])
--    2030
--    (3.10 secs, 4,687,467,664 bytes)

-- Gráfica
-- =======

graficaGoldbach :: Int -> IO ()
graficaGoldbach n =
  plotList [ Key Nothing
           , XRange (2,fromIntegral n)
           , PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png")
           ]
           [indiceGoldbach2 k | k <- [2..n]]

-- Comprobación de la conjetura de Goldbach
-- ========================================

-- La propiedad es
prop_Goldbach :: Int -> Property
prop_Goldbach x =
  x >= 2 ==> indiceGoldbach2 x < 4

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

100

101

102

103

104

105

106

107

import Data.Array

import Data.Numbers.Primes

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

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

indiceGoldbach :: Int -> Int

indiceGoldbach n =

minimum (map length (particiones n))

particiones :: Int -> [[Int]]

particiones n = v ! n where

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

where f 0 = [[]]

f m = [x:y | x <- xs,

y <- v ! (m-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= m) primes)

-- 2ª definición

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

indiceGoldbach2 :: Int -> Int

indiceGoldbach2 x =

head [n | n <- [1..], esSumaDe x n]

-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n

-- primos. Por ejemplo,

-- esSumaDe 2 1 == True

-- esSumaDe 4 1 == False

-- esSumaDe 4 2 == True

-- esSumaDe 27 2 == False

-- esSumaDe 27 3 == True

esSumaDe :: Int -> Int -> Bool

esSumaDe x 1 = isPrime x

esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]

-- 3ª definición

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

indiceGoldbach3 :: Int -> Int

indiceGoldbach3 x =

head [n | n <- [1..], esSumaDe3 x n]

esSumaDe3 :: Int -> Int -> Bool

esSumaDe3 x n = a ! (x,n) where

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

f i 1 = isPrime i

f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]

-- 4ª definición

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

indiceGoldbach4 :: Int -> Int

indiceGoldbach4 n = v ! n where

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

f i | isPrime i = 1

| otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]

-- Comparación de eficiencia

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

-- λ> sum (map indiceGoldbach [2..80])

-- 142

-- (2.66 secs, 1,194,330,496 bytes)

-- λ> sum (map indiceGoldbach2 [2..80])

-- 142

-- (0.01 secs, 1,689,944 bytes)

-- λ> sum (map indiceGoldbach3 [2..80])

-- 142

-- (0.03 secs, 27,319,296 bytes)

-- λ> sum (map indiceGoldbach4 [2..80])

-- 142

-- (0.03 secs, 47,823,656 bytes)

-- λ> sum (map indiceGoldbach2 [2..1000])

-- 2030

-- (0.10 secs, 200,140,264 bytes)

-- λ> sum (map indiceGoldbach3 [2..1000])

-- 2030

-- (3.10 secs, 4,687,467,664 bytes)

-- Gráfica

-- =======

graficaGoldbach :: Int -> IO ()

graficaGoldbach n =

plotList [ Key Nothing

, XRange (2,fromIntegral n)

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

]

[indiceGoldbach2 k | k <- [2..n]]

-- Comprobación de la conjetura de Goldbach

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

-- La propiedad es

prop_Goldbach :: Int -> Property

prop_Goldbach x =

x >= 2 ==> indiceGoldbach2 x < 4

-- La comprobación es

-- λ> quickCheck prop_Goldbach

-- +++ OK, passed 100 tests.

Particiones primas

PorJosé A. Alonso 20-marzo-201828-marzo-2018

Una partición prima de un número natural n es un conjunto de primos cuya suma es n. Por ejemplo, el número 7 tiene 7 particiones primas ya que

   7 = 7 = 5 + 2 = 3 + 2 + 2

1	7 = 7 = 5 + 2 = 3 + 2 + 2

Definir la función

   particiones :: Int -> [[Int]]

1	particiones :: Int -> [[Int]]

tal que (particiones n) es el comjunto de las particiones primas de n. Por ejemplo,

   particiones 7             ==  [[7],[5,2],[3,2,2]]
   particiones 8             ==  [[5,3],[3,3,2],[2,2,2,2]]
   particiones 9             ==  [[7,2],[5,2,2],[3,3,3],[3,2,2,2]]
   length (particiones 100)  ==  40899

particiones 7 == [[7],[5,2],[3,2,2]]

particiones 8 == [[5,3],[3,3,2],[2,2,2,2]]

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

length (particiones 100) == 40899

Soluciones

import Data.Numbers.Primes (primes)
import Data.Array          (Array, (!), array)

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

particiones1 :: Int -> [[Int]]
particiones1 0 = [[]]
particiones1 n = [x:y | x <- xs, 
                        y <- particiones1 (n-x), 
                        [x] >= take 1 y]
  where xs = reverse (takeWhile (<= n) primes)

-- 2ª solución (con programación dinámica)
-- =======================================

particiones2 :: Int -> [[Int]]
particiones2 n = (vectorParticiones n) ! n

-- (vectorParticiones n) es el vector con índices de 0 a n tal que el
-- valor del índice k es la lista de las particiones primas de k. Por
-- ejemplo, 
--    λ> mapM_ print (elems (vectorParticiones 9))
--    [[]]
--    []
--    [[2]]
--    [[3]]
--    [[2,2]]
--    [[5],[3,2]]
--    [[3,3],[2,2,2]]
--    [[7],[5,2],[3,2,2]]
--    [[5,3],[3,3,2],[2,2,2,2]]
--    [[7,2],[5,2,2],[3,3,3],[3,2,2,2]]
--    λ> elems (vectorParticiones 9) == map particiones1 [0..9]
--    True
vectorParticiones :: Int -> Array Int [[Int]]
vectorParticiones n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)

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

--    λ> length (particiones1 35)
--    175
--    (5.88 secs, 2,264,266,040 bytes)
--    λ> length (particiones2 35)
--    175
--    (0.02 secs, 1,521,560 bytes)

import Data.Numbers.Primes (primes)

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

-- 1ª solución

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

particiones1 :: Int -> [[Int]]

particiones1 0 = [[]]

particiones1 n = [x:y | x <- xs,

y <- particiones1 (n-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= n) primes)

-- 2ª solución (con programación dinámica)

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

particiones2 :: Int -> [[Int]]

particiones2 n = (vectorParticiones n) ! n

-- (vectorParticiones n) es el vector con índices de 0 a n tal que el

-- valor del índice k es la lista de las particiones primas de k. Por

-- ejemplo,

-- λ> mapM_ print (elems (vectorParticiones 9))

-- [[]]

-- []

-- [[2]]

-- [[3]]

-- [[2,2]]

-- [[5],[3,2]]

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

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

-- [[5,3],[3,3,2],[2,2,2,2]]

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

-- λ> elems (vectorParticiones 9) == map particiones1 [0..9]

-- True

vectorParticiones :: Int -> Array Int [[Int]]

vectorParticiones n = v where

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

where f 0 = [[]]

f m = [x:y | x <- xs,

y <- v ! (m-x),

[x] >= take 1 y]

where xs = reverse (takeWhile (<= m) primes)

-- Comparación de eficiencia

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

-- λ> length (particiones1 35)

-- 175

-- (5.88 secs, 2,264,266,040 bytes)

-- λ> length (particiones2 35)

-- 175

-- (0.02 secs, 1,521,560 bytes)

Camino de máxima suma en una matriz

PorJosé A. Alonso 16-marzo-201825-abril-2021

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El camino de máxima suma es el segundo (1, 7, 12, 8, 4, 9) que tiene una suma de 41.

Definir la función

   caminoMaxSuma :: Matrix Int -> [Int]

1	caminoMaxSuma :: Matrix Int -> [Int]

tal que (caminoMaxSuma m) es un camino de máxima suma en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [1,7,12,8,4,9]
   λ> sum (caminoMaxSuma (fromList 500 500 [1..]))
   187001249

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

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

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

187001249

Soluciones

import Data.Matrix

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

caminoMaxSuma1 :: Matrix Int -> [Int]
caminoMaxSuma1 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos1 m
        k  = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]

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

caminoMaxSuma2 :: Matrix Int -> [Int]
caminoMaxSuma2 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos2 m
        k  = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  

-- 3ª definición (con programación dinámica)
-- =========================================

caminoMaxSuma3 :: Matrix Int -> [Int]
caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))
  where nf = nrows m
        nc = ncols m
        q  = caminoMaxSumaAux m

caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])
caminoMaxSumaAux m = q 
  where
    nf = nrows m
    nc = ncols m
    q  = matrix nf nc f
      where
        f (1,1) = (m!(1,1),[m!(1,1)])
        f (1,j) = (k + m!(1,j), m!(1,j):xs)
          where (k,xs) = q!(1,j-1)
        f (i,1) = (k + m!(i,1), m!(i,1):xs)
          where (k,xs) = q!(i-1,1)        
        f (i,j) | k1 > k2   = (k1 + m!(i,j), m!(i,j):xs)
                | otherwise = (k2 + m!(i,j), m!(i,j):ys)
          where (k1,xs) = q!(i,j-1)
                (k2,ys) = q!(i-1,j)

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

--    λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))
--    21
--    (10.00 secs, 1,510,120,328 bytes)
--    λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))
--    21
--    (3.84 secs, 745,918,544 bytes)
--    λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))
--    21
--    (0.01 secs, 0 bytes)

import Data.Matrix

-- 1ª definición

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

caminoMaxSuma1 :: Matrix Int -> [Int]

caminoMaxSuma1 m =

head [c | c <- cs, sum c == k]

where cs = caminos1 m

k = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]

caminos1 m =

map reverse (caminos1Aux m (nf,nc))

where nf = nrows m

nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p

-- desde la posición (1,1) hasta la posición x. Por ejemplo,

caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]

caminos1Aux m (1,1) = [[m!(1,1)]]

caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]

caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]

caminos1Aux m (i,j) = [m!(i,j) : xs

| xs <- caminos1Aux m (i,j-1) ++

caminos1Aux m (i-1,j)]

-- 2ª definición

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

caminoMaxSuma2 :: Matrix Int -> [Int]

caminoMaxSuma2 m =

head [c | c <- cs, sum c == k]

where cs = caminos2 m

k = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]

caminos2 m =

map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]

matrizCaminos m = q

where

q = matrix (nrows m) (ncols m) f

f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]

f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]

f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]

-- 3ª definición (con programación dinámica)

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

caminoMaxSuma3 :: Matrix Int -> [Int]

caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))

where nf = nrows m

nc = ncols m

q = caminoMaxSumaAux m

caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])

caminoMaxSumaAux m = q

where

nf = nrows m

nc = ncols m

q = matrix nf nc f

where

f (1,1) = (m!(1,1),[m!(1,1)])

f (1,j) = (k + m!(1,j), m!(1,j):xs)

where (k,xs) = q!(1,j-1)

f (i,1) = (k + m!(i,1), m!(i,1):xs)

where (k,xs) = q!(i-1,1)

f (i,j) | k1 > k2 = (k1 + m!(i,j), m!(i,j):xs)

| otherwise = (k2 + m!(i,j), m!(i,j):ys)

where (k1,xs) = q!(i,j-1)

(k2,ys) = q!(i-1,j)

-- Comparación de eficiencia

-- -------------------------

-- λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))

-- 21

-- (10.00 secs, 1,510,120,328 bytes)

-- λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))

-- 21

-- (3.84 secs, 745,918,544 bytes)

-- λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))

-- 21

-- (0.01 secs, 0 bytes)

Máximo de las sumas de los caminos en una matriz

PorJosé A. Alonso 15-marzo-201825-abril-2021

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El máximo de las suma de los caminos es 41.

Definir la función

   maximaSuma :: Matrix Int -> Int

1	maximaSuma :: Matrix Int -> Int

tal que (maximaSuma m) es el máximo de las sumas de los caminos 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,

   λ> maximaSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   41
   λ> maximaSuma (fromList 800 800 [1..])
   766721999

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

λ> maximaSuma (fromList 800 800 [1..])

766721999

Soluciones

import Data.Matrix

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

maximaSuma1 :: Matrix Int -> Int
maximaSuma1 =
  maximum . map sum . caminos1

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

maximaSuma2 :: Matrix Int -> Int
maximaSuma2 =
  maximum . map sum . caminos2

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ª definicion (por recursión, sin calcular el camino)
-- =====================================================

maximaSuma3 :: Matrix Int -> Int
maximaSuma3 m = maximaSuma3Aux m (nf,nc)
  where nf = nrows m
        nc = ncols m

-- (maximaSuma3Aux m p) calcula la suma máxima de un camino hasta la
-- posición p. Por ejemplo,
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (3,4)
--    41
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (3,3)
--    32
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (2,4)
--    31
maximaSuma3Aux :: Matrix Int -> (Int,Int) -> Int
maximaSuma3Aux m (1,1) = m ! (1,1)
maximaSuma3Aux m (1,j) = maximaSuma3Aux m (1,j-1) + m ! (1,j)
maximaSuma3Aux m (i,1) = maximaSuma3Aux m (i-1,1) + m ! (i,1)
maximaSuma3Aux m (i,j) =
  max (maximaSuma3Aux m (i,j-1)) (maximaSuma3Aux m (i-1,j)) + m ! (i,j)

-- 4ª solución (mediante programación dinámica)
-- ============================================

maximaSuma4 :: Matrix Int -> Int
maximaSuma4 m = q ! (nf,nc)
  where nf = nrows m
        nc = ncols m
        q  = matrizMaximaSuma m

-- (matrizMaximaSuma m) es la matriz donde en cada posición p se
-- encuentra el máxima de las sumas de los caminos desde (1,1) a p en la
-- matriz m. Por ejemplo,   
--    λ> matrizMaximaSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) 
--    (  1  7 18 20 )
--    (  8 20 23 31 )
--    ( 11 28 32 41 )
matrizMaximaSuma :: Matrix Int -> Matrix Int
matrizMaximaSuma m = q 
  where nf = nrows m
        nc = ncols m
        q  = matrix nf nc f
          where  f (1,1) = m ! (1,1)
                 f (1,j) = q ! (1,j-1) + m ! (1,j)
                 f (i,1) = q ! (i-1,1) + m ! (i,1)
                 f (i,j) = max (q ! (i,j-1)) (q ! (i-1,j)) + m ! (i,j)

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

--    λ> maximaSuma1 (fromList 8 8 [1..])
--    659
--    (0.11 secs, 31,853,136 bytes)
--    λ> maximaSuma1a (fromList 8 8 [1..])
--    659
--    (0.09 secs, 19,952,640 bytes)
-- 
--    λ> maximaSuma1 (fromList 10 10 [1..])
--    1324
--    (2.25 secs, 349,722,744 bytes)
--    λ> maximaSuma2 (fromList 10 10 [1..])
--    1324
--    (0.76 secs, 151,019,296 bytes)
--    
--    λ> maximaSuma2 (fromList 11 11 [1..])
--    1781
--    (3.02 secs, 545,659,632 bytes)
--    λ> maximaSuma3 (fromList 11 11 [1..])
--    1781
--    (1.57 secs, 210,124,912 bytes)
--    
--    λ> maximaSuma3 (fromList 12 12 [1..])
--    2333
--    (5.60 secs, 810,739,032 bytes)
--    λ> maximaSuma4 (fromList 12 12 [1..])
--    2333
--    (0.01 secs, 23,154,776 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

import Data.Matrix

-- 1ª definición

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

maximaSuma1 :: Matrix Int -> Int

maximaSuma1 =

maximum . map sum . caminos1

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

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

maximaSuma2 :: Matrix Int -> Int

maximaSuma2 =

maximum . map sum . caminos2

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ª definicion (por recursión, sin calcular el camino)

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

maximaSuma3 :: Matrix Int -> Int

maximaSuma3 m = maximaSuma3Aux m (nf,nc)

where nf = nrows m

nc = ncols m

-- (maximaSuma3Aux m p) calcula la suma máxima de un camino hasta la

-- posición p. Por ejemplo,

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

-- 41

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

-- 32

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

-- 31

maximaSuma3Aux :: Matrix Int -> (Int,Int) -> Int

maximaSuma3Aux m (1,1) = m ! (1,1)

maximaSuma3Aux m (1,j) = maximaSuma3Aux m (1,j-1) + m ! (1,j)

maximaSuma3Aux m (i,1) = maximaSuma3Aux m (i-1,1) + m ! (i,1)

maximaSuma3Aux m (i,j) =

max (maximaSuma3Aux m (i,j-1)) (maximaSuma3Aux m (i-1,j)) + m ! (i,j)

-- 4ª solución (mediante programación dinámica)

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

maximaSuma4 :: Matrix Int -> Int

maximaSuma4 m = q ! (nf,nc)

where nf = nrows m

nc = ncols m

q = matrizMaximaSuma m

-- (matrizMaximaSuma m) es la matriz donde en cada posición p se

-- encuentra el máxima de las sumas de los caminos desde (1,1) a p en la

-- matriz m. Por ejemplo,

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

-- ( 1 7 18 20 )

-- ( 8 20 23 31 )

-- ( 11 28 32 41 )

matrizMaximaSuma :: Matrix Int -> Matrix Int

matrizMaximaSuma m = q

where nf = nrows m

nc = ncols m

q = matrix nf nc f

where f (1,1) = m ! (1,1)

f (1,j) = q ! (1,j-1) + m ! (1,j)

f (i,1) = q ! (i-1,1) + m ! (i,1)

f (i,j) = max (q ! (i,j-1)) (q ! (i-1,j)) + m ! (i,j)

-- Comparación de eficiencia

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

-- λ> maximaSuma1 (fromList 8 8 [1..])

-- 659

-- (0.11 secs, 31,853,136 bytes)

-- λ> maximaSuma1a (fromList 8 8 [1..])

-- 659

-- (0.09 secs, 19,952,640 bytes)

-- λ> maximaSuma1 (fromList 10 10 [1..])

-- 1324

-- (2.25 secs, 349,722,744 bytes)

-- λ> maximaSuma2 (fromList 10 10 [1..])

-- 1324

-- (0.76 secs, 151,019,296 bytes)

-- λ> maximaSuma2 (fromList 11 11 [1..])

-- 1781

-- (3.02 secs, 545,659,632 bytes)

-- λ> maximaSuma3 (fromList 11 11 [1..])

-- 1781

-- (1.57 secs, 210,124,912 bytes)

-- λ> maximaSuma3 (fromList 12 12 [1..])

-- 2333

-- (5.60 secs, 810,739,032 bytes)

-- λ> maximaSuma4 (fromList 12 12 [1..])

-- 2333

-- (0.01 secs, 23,154,776 bytes)

Caminos en una matriz

PorJosé A. Alonso 14-marzo-201825-abril-2021

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Definir la función

   caminos :: Matrix Int -> [[Int]]

1	caminos :: Matrix Int -> [[Int]]

tal que (caminos m) es la lista de los caminos 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,

   λ> caminos (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,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]]
   λ> length (caminos (fromList 12 13 [1..]))
   1352078

λ> caminos (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,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]]

λ> length (caminos (fromList 12 13 [1..]))

1352078

Soluciones

import Data.Matrix

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

caminos1 :: Matrix Int -> [[Int]]
caminos1 a = aux (1,1)
  where
    aux (i,j)
      | i == m           = [[a!(i,k) | k <- [j..n]]]
      | j == n           = [[a!(k,j) | k <- [i..m]]]
      | otherwise        = [a!(i,j) : cs | cs <- aux (i+1,j) ++ aux (i,j+1)]
      where m = nrows a
            n = ncols a

-- 2ª solución (mediante programación dinámica)
-- --------------------------------------------

caminos2 :: Matrix Int -> [[Int]]
caminos2 a = q ! (1,1)
  where
    q = matrix m n f
    m = nrows a
    n = ncols a
    f (i,j) | i == m    = [[a!(i,k) | k <- [j..n]]]
            | j == n    = [[a!(k,j) | k <- [i..m]]]
            | otherwise = [a!(i,j) : cs | cs <- q!(i+1,j) ++ q!(i,j+1)]  

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

caminos3 :: Matrix Int -> [[Int]]
caminos3 a
  | m == 1 || n == 1 = [toList a]
  | otherwise = map (a ! (1,1):) (caminos3 (submatrix 2 m 1 n a) ++
                                  caminos3 (submatrix 1 m 2 n a)) 
  where m = nrows a
        n = ncols a

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

--    λ> length (caminos1 (fromList 11 11 [1..]))
--    184756
--    (4.15 secs, 738,764,712 bytes)
--    λ> length (caminos2 (fromList 11 11 [1..]))
--    184756
--    (0.74 secs, 115,904,952 bytes)
--    λ> length (caminos3 (fromList 11 11 [1..]))
--    184756
--    (2.22 secs, 614,472,136 bytes)

import Data.Matrix

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

-- ----------------------------------------

caminos1 :: Matrix Int -> [[Int]]

caminos1 a = aux (1,1)

where

aux (i,j)

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

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

| otherwise = [a!(i,j) : cs | cs <- aux (i+1,j) ++ aux (i,j+1)]

where m = nrows a

n = ncols a

-- 2ª solución (mediante programación dinámica)

-- --------------------------------------------

caminos2 :: Matrix Int -> [[Int]]

caminos2 a = q ! (1,1)

where

q = matrix m n f

m = nrows a

n = ncols a

f (i,j) | i == m = [[a!(i,k) | k <- [j..n]]]

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

| otherwise = [a!(i,j) : cs | cs <- q!(i+1,j) ++ q!(i,j+1)]

-- 3ª solución

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

caminos3 :: Matrix Int -> [[Int]]

caminos3 a

| m == 1 || n == 1 = [toList a]

| otherwise = map (a ! (1,1):) (caminos3 (submatrix 2 m 1 n a) ++

caminos3 (submatrix 1 m 2 n a))

where m = nrows a

n = ncols a

-- Comparación de eficiencia

-- -------------------------

-- λ> length (caminos1 (fromList 11 11 [1..]))

-- 184756

-- (4.15 secs, 738,764,712 bytes)

-- λ> length (caminos2 (fromList 11 11 [1..]))

-- 184756

-- (0.74 secs, 115,904,952 bytes)

-- λ> length (caminos3 (fromList 11 11 [1..]))

-- 184756

-- (2.22 secs, 614,472,136 bytes)

Nodos con máxima suma de hijos

PorJosé A. Alonso 1-marzo-201830-marzo-2020

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

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

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

Por ejemplo, los árboles

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

1 3

/ \ /|\

2 3 / | \

| 5 4 7

4 | /|\

6 2 8 6

se representan por

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

ej1, ej2 :: Arbol Int

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

ej2 = N 3 [N 5 [N 6 []],

N 4 [],

N 7 [N 2 [], N 8 [], N 6 []]]

Definir la función

   nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

1	nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

tal que (nodosSumaMaxima a) es la lista de los nodos del árbol a cuyos hijos tienen máxima suma. Por ejemplo,

   nodosSumaMaxima ej1  ==  [1]
   nodosSumaMaxima ej2  ==  [7,3]

1 2	nodosSumaMaxima ej1 == [1] nodosSumaMaxima ej2 == [7,3]

Soluciones

import Data.List     (groupBy, sort)
import Data.Function (on)

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

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

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

nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima a =
  [x | (s,x) <- ns, s == m]
  where ns = reverse (sort (nodosSumas a))
        m  = fst (head ns)

-- (nodosSumas x) es la lista de los pares (s,n) donde n es un nodo del
-- árbol x y s es la suma de sus hijos. Por ejemplo,  
--    λ> nodosSumas ej1
--    [(5,1),(0,2),(4,3),(0,4)]
--    λ> nodosSumas ej2
--    [(16,3),(6,5),(0,6),(0,4),(16,7),(0,2),(0,8),(0,6)]
nodosSumas :: Num t => Arbol t -> [(t,t)]
nodosSumas (N x []) = [(0,x)]
nodosSumas (N x as) = (sum (raices as),x) : concatMap nodosSumas as

-- (raices b) es la lista de las raíces del bosque b. Por ejemplo,
--    raices [ej1,ej2]  ==  [1,3]
raices :: [Arbol t] -> [t]
raices = map raiz

-- (raiz a) es la raíz del árbol a. Por ejemplo,
--    raiz ej1  ==  1
--    raiz ej2  ==  3
raiz :: Arbol t -> t
raiz (N x _) = x

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

nodosSumaMaxima2 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima2 a =
  [x | (s,x) <- ns, s == m]
  where ns = sort (nodosOpSumas a)
        m  = fst (head ns)

-- (nodosOpSumas x) es la lista de los pares (s,n) donde n es un nodo del
-- árbol x y s es el opuesto de la suma de sus hijos. Por ejemplo,  
--    λ> nodosOpSumas ej1
--    [(-5,1),(0,2),(-4,3),(0,4)]
--    λ> nodosOpSumas ej2
--    [(-16,3),(-6,5),(0,6),(0,4),(-16,7),(0,2),(0,8),(0,6)]
nodosOpSumas :: Num t => Arbol t -> [(t,t)]
nodosOpSumas (N x []) = [(0,x)]
nodosOpSumas (N x as) = (-sum (raices as),x) : concatMap nodosOpSumas as


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

nodosSumaMaxima3 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima3 a =
  [x | (s,x) <- ns, s == m]
  where ns = sort (nodosOpSumas a)
        m  = fst (head ns)

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

nodosSumaMaxima4 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima4 a =
  map snd (head (groupBy (\p q -> fst p == fst q)
                         (sort (nodosOpSumas a))))

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

nodosSumaMaxima5 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima5 a =
  map snd (head (groupBy ((==) `on` fst)
                         (sort (nodosOpSumas a))))

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

nodosSumaMaxima6 :: (Num t, Ord t) => Arbol t -> [t]
nodosSumaMaxima6 =
  map snd
  . head
  . groupBy ((==) `on` fst)
  . sort
  . nodosOpSumas

import Data.List (groupBy, sort)

import Data.Function (on)

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

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

ej2 = N 3 [N 5 [N 6 []],

N 4 [],

N 7 [N 2 [], N 8 [], N 6 []]]

-- 1ª solución

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

nodosSumaMaxima :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima a =

[x | (s,x) <- ns, s == m]

where ns = reverse (sort (nodosSumas a))

m = fst (head ns)

-- (nodosSumas x) es la lista de los pares (s,n) donde n es un nodo del

-- árbol x y s es la suma de sus hijos. Por ejemplo,

-- λ> nodosSumas ej1

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

-- λ> nodosSumas ej2

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

nodosSumas :: Num t => Arbol t -> [(t,t)]

nodosSumas (N x []) = [(0,x)]

nodosSumas (N x as) = (sum (raices as),x) : concatMap nodosSumas as

-- (raices b) es la lista de las raíces del bosque b. Por ejemplo,

-- raices [ej1,ej2] == [1,3]

raices :: [Arbol t] -> [t]

raices = map raiz

-- (raiz a) es la raíz del árbol a. Por ejemplo,

-- raiz ej1 == 1

-- raiz ej2 == 3

raiz :: Arbol t -> t

raiz (N x _) = x

-- 2ª solución

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

nodosSumaMaxima2 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima2 a =

[x | (s,x) <- ns, s == m]

where ns = sort (nodosOpSumas a)

m = fst (head ns)

-- (nodosOpSumas x) es la lista de los pares (s,n) donde n es un nodo del

-- árbol x y s es el opuesto de la suma de sus hijos. Por ejemplo,

-- λ> nodosOpSumas ej1

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

-- λ> nodosOpSumas ej2

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

nodosOpSumas :: Num t => Arbol t -> [(t,t)]

nodosOpSumas (N x []) = [(0,x)]

nodosOpSumas (N x as) = (-sum (raices as),x) : concatMap nodosOpSumas as

-- 3ª solución

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

nodosSumaMaxima3 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima3 a =

[x | (s,x) <- ns, s == m]

where ns = sort (nodosOpSumas a)

m = fst (head ns)

-- 4ª solución

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

nodosSumaMaxima4 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima4 a =

map snd (head (groupBy (\p q -> fst p == fst q)

(sort (nodosOpSumas a))))

-- 5ª solución

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

nodosSumaMaxima5 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima5 a =

map snd (head (groupBy ((==) `on` fst)

(sort (nodosOpSumas a))))

-- 6ª solución

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

nodosSumaMaxima6 :: (Num t, Ord t) => Arbol t -> [t]

nodosSumaMaxima6 =

map snd

. head

. groupBy ((==) `on` fst)

. sort

. nodosOpSumas

Números trimórficos

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

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

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

Definir las funciones

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

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

tal que

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

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

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

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

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

densidadTrimorficos 10 == 0.6

densidadTrimorficos 100 == 0.13

densidadTrimorficos 1000 == 2.6e-2

densidadTrimorficos 10000 == 3.7e-3

densidadTrimorficos 100000 == 4.8e-4

Soluciones

import Data.List (genericLength, isPrefixOf)

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

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

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

import Data.List (genericLength, isPrefixOf)

trimorficos :: [Integer]

trimorficos = filter esTrimorfico [0..]

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

-- esTrimorfico 24 == True

esTrimorfico :: Integer -> Bool

esTrimorfico n =

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

densidadTrimorficos :: Integer -> Double

densidadTrimorficos n =

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

Recorrido de árboles en espiral

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

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

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

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 3 /|\ /|\ |

/ \ / \ 4 5 6 4 5 6 7

4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

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

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

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

Definir la función

   espiral :: Arbol a -> [a]

1	espiral :: Arbol a -> [a]

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

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

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

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

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

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

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

-- 1ª solución

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

espiral :: Arbol a -> [a]

espiral x =

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

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

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

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

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

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

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

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

-- nivel 0 ej1 == [1]

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

-- nivel 2 ej1 == [4]

-- nivel 4 ej1 == []

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

nivel 0 (N x _) = [x]

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

-- 2ª solución

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

espiral2 :: Arbol a -> [a]

espiral2 =

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

-- 3ª solución

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

espiral3 :: Arbol a -> [a]

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

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

niveles3 t = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a

raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]

subBosque (N _ ts) = ts

-- 4ª solución

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

espiral4 :: Arbol a -> [a]

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

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

niveles4 = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque)

. return

-- 5ª definición

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

espiral5 :: Arbol a -> [a]

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

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

niveles5 [] = []

niveles5 xs = a : niveles5 (concat b)

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

-- 6ª definición

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

espiral6 :: Arbol a -> [a]

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

Números somirp

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

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

Definir las funciones

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

esOmirp :: Integer -> Bool

omirps :: [Integer]

nOmirpsIntermedios :: Int -> Int

tales que

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

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

esOmirp 13 == True

esOmirp 11 == False

esOmirp 112207 == True

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

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

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

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

     nOmirpsIntermedios 2000  ==  4750

1	nOmirpsIntermedios 2000 == 4750

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

Soluciones

import Data.Numbers.Primes (isPrime,primes)

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

omirps :: [Integer]
omirps = filter esOmirp primes

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

import Data.Numbers.Primes (isPrime,primes)

esOmirp :: Integer -> Bool

esOmirp n = n /= rn && isPrime rn

where rn = read . reverse . show $ n

omirps :: [Integer]

omirps = filter esOmirp primes

nOmirpsIntermedios :: Int -> Int

nOmirpsIntermedios n =

length

. filter esOmirp

. takeWhile (< rx)

. dropWhile (<= x) $ primes

where x = omirps !! n

rx = read . reverse . show $ x

Ofertas 3 por 2

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

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

Definir la función

   minimoConOferta :: [Int] -> Int

1	minimoConOferta :: [Int] -> Int

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

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

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

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

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

Soluciones

import Data.List (sort)

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

import Data.List (sort)

minimoConOferta :: [Int] -> Int

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

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

aux as n = n + sum as

De hexadecimal a decimal

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

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

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

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

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

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

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

= 15882

Definir la función

   hexAdec :: String -> Int

1	hexAdec :: String -> Int

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

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

hexAdec "3E0A" == 15882

hexAdec "ABCDEF" == 11259375

hexAdec "FEDCBA" == 16702650

Soluciones

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

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

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

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

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

import Data.Char (digitToInt)

import Numeric(readHex)

import Data.List (foldl')

-- 1ª solución

hexAdec1 :: String -> Int

hexAdec1 s =

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

-- 2ª solución

hexAdec2 :: String -> Int

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

-- 3ª solución

hexAdec3 :: String -> Int

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

-- 4ª solución

hexAdec4 :: String -> Int

hexAdec4 = fst . head . readHex

Reconocimiento de recorridos correctos

PorJosé A. Alonso 12-diciembre-201719-diciembre-2017

Se usará la misma representación del ejercicio anterior para las subidas y bajadas en el autobús; es decir, una lista de pares donde los primeros elementos es el número de viajeros que suben y los segundo es el de los que bajan.

Un recorrido es correcto si en cada bajada tanto el número de viajeros que suben como los que bajan son positivos, el número de viajeros en el autobús no puede ser mayor que su capacidad y el número de viajeros que bajan no puede ser mayor que el número de viajeros en el autobús. Se supone que en la primera parada el autobús no tiene viajeros.

Definir la función

   recorridoCorrecto :: Int -> [(Int,Int)] -> Bool

1	recorridoCorrecto :: Int -> [(Int,Int)] -> Bool

tal que (recorridoCorrecto n ps) se verifica si ps es un recorrido correcto en un autobús cuya capacidad es n. Por ejemplo,

  recorridoCorrecto 20 [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  True
  recorridoCorrecto 15 [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  False
  recorridoCorrecto 15 [(3,2),(9,1),(4,10),(12,2),(6,1)]  ==  False
  recorridoCorrecto 15 [(3,0),(2,7),(4,10),(12,2),(6,1)]  ==  False

recorridoCorrecto 20 [(3,0),(9,1),(4,10),(12,2),(6,1)] == True

recorridoCorrecto 15 [(3,0),(9,1),(4,10),(12,2),(6,1)] == False

recorridoCorrecto 15 [(3,2),(9,1),(4,10),(12,2),(6,1)] == False

recorridoCorrecto 15 [(3,0),(2,7),(4,10),(12,2),(6,1)] == False

el segundo ejemplo es incorrecto porque en la última para se supera la capacidad del autobús; el tercero, porque en la primera para no hay viajeros en el autobús que se puedan bajar y el cuarto, porque en la 2ª parada el autobús tiene 3 viajeros por lo que es imposible que se bajen 7.

Soluciones

-- 1ª definición
recorridoCorrecto1 :: Int -> [(Int,Int)] -> Bool
recorridoCorrecto1 _ [] = True
recorridoCorrecto1 n ps = aux 0 ps
  where aux _ []         = True
        aux k ((a,b):ps) = 0 <= a && a <= n - k + b &&
                           0 <= b && b <= k &&
                           aux (k + a - b) ps

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

recorridoCorrecto2 :: Int -> [(Int,Int)] -> Bool
recorridoCorrecto2 n ps =
  all (\(x,y) -> x >= 0 && y >= 0) ps &&
  all (\k -> 0 <= k && k <= n) (viajeros ps)

-- (viajeros ps) es el número de viajeros después de cada parada del
-- recorrido ps. Por ejemplo,
--   viajeros [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  [0,3,11,5,15,20]
--   viajeros [(3,0),(2,7),(4,10),(12,2),(6,1)]  ==  [0,3,-2,-8,2,7]
viajeros :: [(Int,Int)] -> [Int]
viajeros ps = aux [0] ps
  where aux ns     []         = reverse ns
        aux (n:ns) ((a,b):ps) = aux (n+a-b:n:ns) ps 

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

recorridoCorrecto3 :: Int -> [(Int,Int)] -> Bool
recorridoCorrecto3 n ps =
  all (\(x,y) -> x >= 0 && y >= 0) ps &&
  all (\k -> 0 <= k && k <= n) (viajeros3 ps)

-- (viajeros3 ps) es el número de viajeros después de cada parada del
-- recorrido ps. Por ejemplo,
--   viajeros3 [(3,0),(9,1),(4,10),(12,2),(6,1)]  ==  [0,3,11,5,15,20]
--   viajeros3 [(3,0),(2,7),(4,10),(12,2),(6,1)]  ==  [0,3,-2,-8,2,7]
viajeros3 :: [(Int,Int)] -> [Int]
viajeros3 = scanl (\k (a,b) -> k+a-b) 0

-- 1ª definición

recorridoCorrecto1 :: Int -> [(Int,Int)] -> Bool

recorridoCorrecto1 _ [] = True

recorridoCorrecto1 n ps = aux 0 ps

where aux _ [] = True

aux k ((a,b):ps) = 0 <= a && a <= n - k + b &&

0 <= b && b <= k &&

aux (k + a - b) ps

-- 2ª definición

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

recorridoCorrecto2 :: Int -> [(Int,Int)] -> Bool

recorridoCorrecto2 n ps =

all (\(x,y) -> x >= 0 && y >= 0) ps &&

all (\k -> 0 <= k && k <= n) (viajeros ps)

-- (viajeros ps) es el número de viajeros después de cada parada del

-- recorrido ps. Por ejemplo,

-- viajeros [(3,0),(9,1),(4,10),(12,2),(6,1)] == [0,3,11,5,15,20]

-- viajeros [(3,0),(2,7),(4,10),(12,2),(6,1)] == [0,3,-2,-8,2,7]

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

viajeros ps = aux [0] ps

where aux ns [] = reverse ns

aux (n:ns) ((a,b):ps) = aux (n+a-b:n:ns) ps

-- 3ª definición

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

recorridoCorrecto3 :: Int -> [(Int,Int)] -> Bool

recorridoCorrecto3 n ps =

all (\(x,y) -> x >= 0 && y >= 0) ps &&

all (\k -> 0 <= k && k <= n) (viajeros3 ps)

-- (viajeros3 ps) es el número de viajeros después de cada parada del

-- recorrido ps. Por ejemplo,

-- viajeros3 [(3,0),(9,1),(4,10),(12,2),(6,1)] == [0,3,11,5,15,20]

-- viajeros3 [(3,0),(2,7),(4,10),(12,2),(6,1)] == [0,3,-2,-8,2,7]

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

viajeros3 = scanl (\k (a,b) -> k+a-b) 0

Ordenación valle

PorJosé A. Alonso 8-diciembre-201715-diciembre-2017

La ordenación valle de la lista [79,35,54,19,35,25,12] es la lista [79,35,25,12,19,35,54] ya que es una permutación de la primera y cumple las siguientes condiciones

se compone de una parte decreciente ([79,35,25]), un elemento mínimo (12) y una parte creciente ([19,35,54]);
las dos partes tienen el mismo número de elementos;
cada elemento de la primera parte es mayor o igual que su correspondiente en la segunda parte; es decir. 79 ≥ 54, 35 ≥ 35 y 25 ≥ 19;
además, la diferencia entre dichos elementos es la menor posible.

En el caso, de que la longitud de la lista sea par, la división tiene sólo dos partes (sin diferenciar el menor elemento). Por ejemplo, el valle de [79,35,54,19,35,25] es [79,35,25,19,35,54].

Definir la función

   valle :: [Int] -> [Int]

1	valle :: [Int] -> [Int]

tal que (valle xs) es la ordenación valle de la lista xs. Por ejemplo,

   valle [79,35,54,19,35,25,12]       ==  [79,35,25,12,19,35,54]
   valle [79,35,54,19,35,25]          ==  [79,35,25,19,35,54]
   valle [67,93,100,-16,65,97,92]     ==  [100,93,67,-16,65,92,97]
   valle [14,14,14,14,7,14]           ==  [14,14,14,7,14,14]
   valle [14,14,14,14,14]             ==  [14,14,14,14,14]
   valle [17,17,15,14,8,7,7,5,4,4,1]  ==  [17,15,8,7,4,1,4,5,7,14,17]

valle [79,35,54,19,35,25,12] == [79,35,25,12,19,35,54]

valle [79,35,54,19,35,25] == [79,35,25,19,35,54]

valle [67,93,100,-16,65,97,92] == [100,93,67,-16,65,92,97]

valle [14,14,14,14,7,14] == [14,14,14,7,14,14]

valle [14,14,14,14,14] == [14,14,14,14,14]

valle [17,17,15,14,8,7,7,5,4,4,1] == [17,15,8,7,4,1,4,5,7,14,17]

En el último ejemplo se muestra cómo la última condición descarta la posibilidad de que la lista [17,17,15,14,8,1,4,4,5,7,7] también sea solución ya que aunque se cumplen se cumplen las tres primeras condiciones la diferencia entre los elementos correspondientes es mayor que en la solución; por ejemplo, 17 – 7 > 17 – 17.

Soluciones

import Data.List (sort, sortBy)

-- 1ª solución
valle1 :: [Int] -> [Int]
valle1 xs = ys ++ reverse zs
  where (ys,zs) = aux (reverse (sort xs))
        aux []       = ([],[])
        aux [x]      = ([x],[])
        aux [x,y]    = ([x,y],[])
        aux (x:y:zs) = (x:as,y:bs)
          where (as,bs) = aux zs

-- 2ª solución
valle2 :: [Int] -> [Int]
valle2 = aux . reverse . sort
  where aux []       = []
        aux [x]      = [x]
        aux (x:y:xs) = x : aux xs ++ [y]

-- 3ª solución
valle3 :: [Int] -> [Int]
valle3 = aux . sortBy (flip compare)
  where aux []       = []
        aux [x]      = [x]
        aux (x:y:xs) = x : aux xs ++ [y]
        
-- Comparación de eficiencia
-- =========================

-- λ> length (valle1 [1..2*10^4])
-- 20000
-- (0.02 secs, 8,621,240 bytes)
-- λ> length (valle2 [1..2*10^4])
-- 20000
-- (2.68 secs, 8,595,637,880 bytes)
-- λ> length (valle3 [1..2*10^4])
-- 20000
-- (2.67 secs, 8,594,678,104 bytes)

import Data.List (sort, sortBy)

-- 1ª solución

valle1 :: [Int] -> [Int]

valle1 xs = ys ++ reverse zs

where (ys,zs) = aux (reverse (sort xs))

aux [] = ([],[])

aux [x] = ([x],[])

aux [x,y] = ([x,y],[])

aux (x:y:zs) = (x:as,y:bs)

where (as,bs) = aux zs

-- 2ª solución

valle2 :: [Int] -> [Int]

valle2 = aux . reverse . sort

where aux [] = []

aux [x] = [x]

aux (x:y:xs) = x : aux xs ++ [y]

-- 3ª solución

valle3 :: [Int] -> [Int]

valle3 = aux . sortBy (flip compare)

where aux [] = []

aux [x] = [x]

aux (x:y:xs) = x : aux xs ++ [y]

-- Comparación de eficiencia

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

-- λ> length (valle1 [1..2*10^4])

-- 20000

-- (0.02 secs, 8,621,240 bytes)

-- λ> length (valle2 [1..2*10^4])

-- 20000

-- (2.68 secs, 8,595,637,880 bytes)

-- λ> length (valle3 [1..2*10^4])

-- 20000

-- (2.67 secs, 8,594,678,104 bytes)

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico