José A. Alonso

Problema de Ullman

PorJosé A. Alonso 6-junio-20175-junio-2017

Definir la función

   ullman :: (Num a, Ord a) => a -> Int -> [a] -> Bool

1	ullman :: (Num a, Ord a) => a -> Int -> [a] -> Bool

tal que (ullman t k xs) se verifica si xs tiene un subconjunto con k elementos cuya suma sea menor que t. Por ejemplo,

   ullman  9 3 [1..10]    ==  True
   ullman  5 3 [1..10]    ==  False
   ullman  9 5 [1..10^6]  ==  False
   ullman 29 5 [1..10^6]  ==  True

ullman 9 3 [1..10] == True

ullman 5 3 [1..10] == False

ullman 9 5 [1..10^6] == False

ullman 29 5 [1..10^6] == True

Soluciones

[schedule expon=’2017-06-13′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-06-13′ at=»06:00″]

import Data.List (sort, subsequences)

-- 1ª solución
ullman1 :: (Num a, Ord a) => a -> Int -> [a] -> Bool
ullman1 t k xs = 
  (not . null) [ys | ys <- subsequences xs, length ys == k, sum ys < t]

-- 2ª solución
ullman2 :: (Ord a, Num a) => a -> Int -> [a] -> Bool
ullman2 t k xs = sum (take k (sort xs)) < t

-- Comparación de eficiencia
--    λ> ullman1 9 5 [1..23]
--    False
--    (10.73 secs, 1,761,726,376 bytes)
--    λ> ullman2 9 5 [1..23]
--    False
--    (0.01 secs, 0 bytes)

import Data.List (sort, subsequences)

-- 1ª solución

ullman1 :: (Num a, Ord a) => a -> Int -> [a] -> Bool

ullman1 t k xs =

(not . null) [ys | ys <- subsequences xs, length ys == k, sum ys < t]

-- 2ª solución

ullman2 :: (Ord a, Num a) => a -> Int -> [a] -> Bool

ullman2 t k xs = sum (take k (sort xs)) < t

-- Comparación de eficiencia

-- λ> ullman1 9 5 [1..23]

-- False

-- (10.73 secs, 1,761,726,376 bytes)

-- λ> ullman2 9 5 [1..23]

-- False

-- (0.01 secs, 0 bytes)

[/schedule]

Subsucesiones cuya suma de sus cuadrados es divisible por la longitud de la sucesión

PorJosé A. Alonso 5-junio-20175-junio-2017

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1966 es

Sea a(1),…,a(n) (n ≥ 2) una sucesión de enteros. Demostrar que existe una subsucesión 1 ≤ k(1) < k(2) < ··· < k(m) ≤ n, tal que a(k(1))^2 + ... + a(k(m))^2 es divisible por n.

Definir la función

   subsucesionesE :: [Int] -> [[Int]]

1	subsucesionesE :: [Int] -> [[Int]]

tal que (subsucesionesE xs) es la lista de las subsucesiones de xs tales que la suma de sus cuadrados es divisible por la longitud de xs. Por ejemplo,

   subsucesionesE [3,2,9]     ==  [[3],[9],[3,9]]
   subsucesionesE [3,2,1]     ==  [[3]]
   subsucesionesE [5,2,1]     ==  [[5,2,1]]
   subsucesionesE [3,9,6,4,1] ==  [[3,9],[3,6],[3,4],[3,1]]
   subsucesionesE [1,9,6,4,3] ==  [[1,3],[9,3],[6,3],[4,3]]

subsucesionesE [3,2,9] == [[3],[9],[3,9]]

subsucesionesE [3,2,1] == [[3]]

subsucesionesE [5,2,1] == [[5,2,1]]

subsucesionesE [3,9,6,4,1] == [[3,9],[3,6],[3,4],[3,1]]

subsucesionesE [1,9,6,4,3] == [[1,3],[9,3],[6,3],[4,3]]

Comprobar con QuickCheck que toda lista no vacía xs tiene alguna subsucesión ys tal que la suma de los cuadrados de los elementos de ys es divisible por la longitud de xs.

Soluciones

[schedule expon=’2017-06-12′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-06-12′ at=»06:00″]

import Data.List (subsequences)
import Test.QuickCheck

subsucesionesE :: [Int] -> [[Int]]
subsucesionesE xs = [ys | ys <- tail (subsequences xs),
                          sum [y^2 | y <- ys] `rem` length xs == 0]

-- La propiedad es
prop_subsucesionesE :: [Int] -> Property
prop_subsucesionesE xs =
  not (null xs) ==> not (null (subsucesionesE xs))

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

import Data.List (subsequences)

import Test.QuickCheck

subsucesionesE :: [Int] -> [[Int]]

subsucesionesE xs = [ys | ys <- tail (subsequences xs),

sum [y^2 | y <- ys] `rem` length xs == 0]

-- La propiedad es

prop_subsucesionesE :: [Int] -> Property

prop_subsucesionesE xs =

not (null xs) ==> not (null (subsucesionesE xs))

-- La comprobación es

-- λ> quickCheck prop_subsucesionesE

-- +++ OK, passed 100 tests.

[/schedule]

Suma de los cuadrados de los divisores

PorJosé A. Alonso 2-junio-20171-junio-2017

Dado un entero positivo n, consideremos la suma de los cuadrados de sus divisores. Por ejemplo,

   f(10) = 1 + 4 + 25 + 100 = 130
   f(42) = 1 + 4 +  9 +  36 + 49 + 196 + 441 + 1764 = 2500

1 2	f(10) = 1 + 4 + 25 + 100 = 130 f(42) = 1 + 4 + 9 + 36 + 49 + 196 + 441 + 1764 = 2500

Decimos que n es especial si f(n) es un cuadrado perfecto. En los ejemplos anteriores, 42 es especial y 10 no lo es.

Definir la función

   especial:: Int -> Bool

1	especial:: Int -> Bool

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

   especial 42  ==  True
   especial 10  ==  False

1 2	especial 42 == True especial 10 == False

Calcular todos los números especiales de tres cifras.

Nota: El ejercicio está basado en el Problema 211 del proyecto Euler.

Soluciones

[schedule expon=’2017-06-09′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-06-09′ at=»06:00″]

especial :: Int -> Bool
especial n = esCuadrado (sum (map (^2) (divisores n)))

-- (esCuadrado n) se verifica si n es un cuadrado perfecto. Por ejemplo, 
--    esCuadrado 36  ==  True
--    esCuadrado 40  ==  False
esCuadrado :: Int -> Bool
esCuadrado n = y^2 == n
  where y = floor (sqrt (fromIntegral n))

-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 36  ==  [1,2,3,4,6,9,12,18,36]
divisores :: Int -> [Int]        
divisores n = [x | x <- [1..n], rem n x == 0]

especial :: Int -> Bool

especial n = esCuadrado (sum (map (^2) (divisores n)))

-- (esCuadrado n) se verifica si n es un cuadrado perfecto. Por ejemplo,

-- esCuadrado 36 == True

-- esCuadrado 40 == False

esCuadrado :: Int -> Bool

esCuadrado n = y^2 == n

where y = floor (sqrt (fromIntegral n))

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

-- divisores 36 == [1,2,3,4,6,9,12,18,36]

divisores :: Int -> [Int]

divisores n = [x | x <- [1..n], rem n x == 0]

[/schedule]

Mayores sublistas crecientes

PorJosé A. Alonso 1-junio-201730-mayo-2017

Definir las funciones

   mayoresCrecientes :: Ord a => [a] -> [[a]]
   longitudMayorSublistaCreciente :: Ord a => [a] -> Int

1 2	mayoresCrecientes :: Ord a => [a] -> [[a]] longitudMayorSublistaCreciente :: Ord a => [a] -> Int

tales que

(mayoresCrecientes xs) es la lista de las sublistas crecientes de xs de mayor longitud. Por ejemplo,

     λ> mayoresCrecientes [3,2,6,4,5,1]
     [[3,4,5],[2,4,5]]
     λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
     [[10,22,33,50,60,80],[10,22,33,41,60,80]]
     λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
     [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
     λ> length (head (mayoresCrecientes (show (2^70))))
     5

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

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

λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]

[[10,22,33,50,60,80],[10,22,33,41,60,80]]

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

[[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]

λ> length (head (mayoresCrecientes (show (2^70))))

(longitudMayorSublistaCreciente xs) es el máximo de las longitudes de las sublistas crecientes de xs. Por ejemplo,

     λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]
     3
     λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]
     6
     λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
     6
     λ> longitudMayorSublistaCreciente [1..2000]
     2000
     λ> longitudMayorSublistaCreciente [2000,1999..1]
     1

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

λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]

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

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

Soluciones

[schedule expon=’2017-06-08′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-06-08′ at=»06:00″]

import Data.List (nub, sort, subsequences)
import Data.Array

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

mayoresCrecientes1 :: Ord a => [a] -> [[a]]
mayoresCrecientes1 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes [3,2,5]
--    [[],[3],[2],[5],[3,5],[2,5]]
sublistasCrecientes :: Ord a => [a] -> [[a]]
sublistasCrecientes xs =
  [ys | ys <- subsequences xs
      , esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por
-- ejemplo,  
--    esCreciente [2,3,5]  ==  True
--    esCreciente [2,3,1]  ==  False
--    esCreciente [2,3,3]  ==  False
esCreciente :: Ord a => [a] -> Bool
esCreciente (x:y:zs) = x < y && esCreciente (y:zs)
esCreciente _        = True

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

mayoresCrecientes2 :: Ord a => [a] -> [[a]]
mayoresCrecientes2 xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes2 xs
        m   = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de
-- xs. Por ejemplo,
--    λ> sublistasCrecientes2 [3,2,5]
--    [[3,5],[3],[2,5],[2],[5],[]]
sublistasCrecientes2 :: Ord a => [a] -> [[a]]
sublistasCrecientes2 []  = [[]]
sublistasCrecientes2 (x:xs) =
  [x:ys | ys <- yss, null ys || x < head ys] ++ yss
  where yss = sublistasCrecientes2 xs

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

--    λ> length (head (mayoresCrecientes1 (show (2^70))))
--    5
--    (10.93 secs, 1,958,822,896 bytes)
--    λ> length (head (mayoresCrecientes2 (show (2^70))))
--    5
--    (0.02 secs, 0 bytes)

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

longitudMayorSublistaCreciente1 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente1 =
  length . head . mayoresCrecientes1

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

longitudMayorSublistaCreciente2 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente2 =
  length . head . mayoresCrecientes2

-- Comparación de eficiencia:
--    λ> longitudMayorSublistaCreciente1 (show (2^70))
--    5
--    (10.78 secs, 1,969,452,328 bytes)
--    λ> longitudMayorSublistaCreciente2 (show (2^70))
--    5
--    (0.02 secs, 0 bytes)

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

longitudMayorSublistaCreciente3 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente3 xs =
  longitudSCM xs (sort (nub xs))
  
-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e
-- ys. Por ejemplo, 
--   longitudSCM "amapola" "matamoscas" == 4
--   longitudSCM "atamos" "matamoscas"  == 6
--   longitudSCM "aaa" "bbbb"           == 0
longitudSCM :: Eq a => [a] -> [a] -> Int
longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)
  where n = length xs
        m = length ys

-- (matrizLongitudSCM2 xs ys) es la matriz de orden (n+1)x(m+1) (donde n
-- y m son los números de elementos de xs e ys, respectivamente) tal que
-- el valor en la posición (i,j) es la longitud de la SCM de los i
-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,
--    λ> elems (matrizLongitudSCM "amapola" "matamoscas")
--    [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,
--     0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,
--     0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]
-- Gráficamente,
--       m a t a m o s c a s
--    [0,0,0,0,0,0,0,0,0,0,0,
-- a   0,0,1,1,1,1,1,1,1,1,1,
-- m   0,1,1,1,1,2,2,2,2,2,2,
-- a   0,1,2,2,2,2,2,2,2,3,3,
-- p   0,1,2,2,2,2,2,2,2,3,3,
-- o   0,1,2,2,2,2,3,3,3,3,3,
-- l   0,1,2,2,2,2,3,3,3,3,3,
-- a   0,1,2,2,3,3,3,3,3,4,4]
matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int
matrizLongitudSCM xs ys = q
  where
    n = length xs
    m = length ys
    v = listArray (1,n) xs
    w = listArray (1,m) ys
    q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
      where f 0 _ = 0
            f _ 0 = 0
            f i j | v ! i == w ! j = 1 + q ! (i-1,j-1)
                  | otherwise      = max (q ! (i-1,j)) (q ! (i,j-1))
  
-- Comparación de eficiencia
-- -------------------------

--    λ> longitudMayorSublistaCreciente2 [1..22]
--    22
--    (19.63 secs, 2,271,936,784 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..22]
--    22
--    (0.01 secs, 0 bytes)

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

longitudMayorSublistaCreciente4 :: Ord a => [a] -> Int
longitudMayorSublistaCreciente4 xs =
  maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n
-- tal que el valor i-ésimo es la longitud de la sucesión más largar que
-- termina en el elemento i-ésimo de xs. Por ejemplo, 
--    λ> vectorlongitudMayorSublistaCreciente [3,2,6,4,5,1]
--    array (1,6) [(1,1),(2,1),(3,2),(4,2),(5,3),(6,1)]
vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int
vectorlongitudMayorSublistaCreciente xs = v
  where v = array (1,n) [(i,f i) | i <- [1..n]]
        n = length xs
        w = listArray (1,n) xs
        f 1 = 1
        f i | null ls   = 1
            | otherwise = 1 + maximum ls
          where ls = [v ! j | j <- [1..i-1], w ! j < w ! i]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

import Data.List (nub, sort, subsequences)

import Data.Array

-- 1ª definición de mayoresCrecientes

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

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

mayoresCrecientes1 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

-- (sublistasCrecientes1 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes [3,2,5]

-- [[],[3],[2],[5],[3,5],[2,5]]

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

sublistasCrecientes xs =

[ys | ys <- subsequences xs

, esCreciente ys]

-- (esCreciente xs) se verifica si la lista xs es creciente. Por

-- ejemplo,

-- esCreciente [2,3,5] == True

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

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

esCreciente :: Ord a => [a] -> Bool

esCreciente (x:y:zs) = x < y && esCreciente (y:zs)

esCreciente _ = True

-- 2ª definición de mayoresCrecientes

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

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

mayoresCrecientes2 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes2 xs

m = maximum (map length xss)

-- (sublistasCrecientes2 xs) es la lista de las sublistas crecientes de

-- xs. Por ejemplo,

-- λ> sublistasCrecientes2 [3,2,5]

-- [[3,5],[3],[2,5],[2],[5],[]]

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

sublistasCrecientes2 [] = [[]]

sublistasCrecientes2 (x:xs) =

[x:ys | ys <- yss, null ys || x < head ys] ++ yss

where yss = sublistasCrecientes2 xs

-- Comparación de eficiencia

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

-- λ> length (head (mayoresCrecientes1 (show (2^70))))

-- 5

-- (10.93 secs, 1,958,822,896 bytes)

-- λ> length (head (mayoresCrecientes2 (show (2^70))))

-- 5

-- (0.02 secs, 0 bytes)

-- 1ª definición de longitudMayorSublistaCreciente

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

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

longitudMayorSublistaCreciente1 =

length . head . mayoresCrecientes1

-- 2ª definición de longitudMayorSublistaCreciente

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

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

longitudMayorSublistaCreciente2 =

length . head . mayoresCrecientes2

-- Comparación de eficiencia:

-- λ> longitudMayorSublistaCreciente1 (show (2^70))

-- 5

-- (10.78 secs, 1,969,452,328 bytes)

-- λ> longitudMayorSublistaCreciente2 (show (2^70))

-- 5

-- (0.02 secs, 0 bytes)

-- 3ª definición de longitudMayorSublistaCreciente

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

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

longitudMayorSublistaCreciente3 xs =

longitudSCM xs (sort (nub xs))

-- (longitudSCM xs ys) es la longitud de la subsecuencia máxima de xs e

-- ys. Por ejemplo,

-- longitudSCM "amapola" "matamoscas" == 4

-- longitudSCM "atamos" "matamoscas" == 6

-- longitudSCM "aaa" "bbbb" == 0

longitudSCM :: Eq a => [a] -> [a] -> Int

longitudSCM xs ys = (matrizLongitudSCM xs ys) ! (n,m)

where n = length xs

m = length ys

-- (matrizLongitudSCM2 xs ys) es la matriz de orden (n+1)x(m+1) (donde n

-- y m son los números de elementos de xs e ys, respectivamente) tal que

-- el valor en la posición (i,j) es la longitud de la SCM de los i

-- primeros elementos de xs y los j primeros elementos de ys. Por ejemplo,

-- λ> elems (matrizLongitudSCM "amapola" "matamoscas")

-- [0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,1,1,1,1,2,2,2,2,2,2,

-- 0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,2,2,2,3,3,0,1,2,2,2,2,3,3,3,3,3,

-- 0,1,2,2,2,2,3,3,3,3,3,0,1,2,2,3,3,3,3,3,4,4]

-- Gráficamente,

-- m a t a m o s c a s

-- [0,0,0,0,0,0,0,0,0,0,0,

-- a 0,0,1,1,1,1,1,1,1,1,1,

-- m 0,1,1,1,1,2,2,2,2,2,2,

-- a 0,1,2,2,2,2,2,2,2,3,3,

-- p 0,1,2,2,2,2,2,2,2,3,3,

-- o 0,1,2,2,2,2,3,3,3,3,3,

-- l 0,1,2,2,2,2,3,3,3,3,3,

-- a 0,1,2,2,3,3,3,3,3,4,4]

matrizLongitudSCM :: Eq a => [a] -> [a] -> Array (Int,Int) Int

matrizLongitudSCM xs ys = q

where

n = length xs

m = length ys

v = listArray (1,n) xs

w = listArray (1,m) ys

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

where f 0 _ = 0

f _ 0 = 0

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

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

-- Comparación de eficiencia

-- -------------------------

-- λ> longitudMayorSublistaCreciente2 [1..22]

-- 22

-- (19.63 secs, 2,271,936,784 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..22]

-- 22

-- (0.01 secs, 0 bytes)

-- 4ª definición de longitudMayorSublistaCreciente

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

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

longitudMayorSublistaCreciente4 xs =

maximum (elems (vectorlongitudMayorSublistaCreciente xs))

-- (vectorlongitudMayorSublistaCreciente xs) es el vector de longitud n

-- tal que el valor i-ésimo es la longitud de la sucesión más largar que

-- termina en el elemento i-ésimo de xs. Por ejemplo,

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

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

vectorlongitudMayorSublistaCreciente :: Ord a => [a] -> Array Int Int

vectorlongitudMayorSublistaCreciente xs = v

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

n = length xs

w = listArray (1,n) xs

f 1 = 1

f i | null ls = 1

| otherwise = 1 + maximum ls

where ls = [v ! j | j <- [1..i-1], w ! j < w ! i]

[/schedule]

Sucesiones de listas de números

PorJosé A. Alonso 31-mayo-201726-marzo-2022

En la Olimpiada Internacional de Matemáticas del 2012 se propuso el siguiente problema:

Varios enteros positivos se escriben en una lista. Iterativamente, Alicia elige dos números adyacentes x e y tales que x > y y x está a la izquierda de y y reemplaza el par (x,y) por (y+1,x) o (x-1,x). Demostrar que sólo puede aplicar un número finito de dichas iteraciones.

Por ejemplo, las transformadas de la lista [1,3,2] son [1,2,3] y [1,3,3] y las dos obtenidas son finales (es decir, no se les puede aplicar ninguna transformación).

Definir las funciones

   soluciones :: [Int] -> [Estado]
   finales :: [Int] -> [[Int]]
   finalesMaximales :: [Int] -> (Int,[[Int]])

soluciones :: [Int] -> [Estado]

finales :: [Int] -> [[Int]]

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

tales que

(soluciones xs) es la lista de pares (n,ys) tales que ys es una lista final obtenida aplicándole n transformaciones a xs. Por ejemplo,

     λ> soluciones [1,3,2]
     [(1,[1,3,3]),(1,[1,2,3])]
     λ> sort (nub (soluciones [3,3,2]))
     [(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]
     λ> sort (nub (soluciones [3,2,1]))
     [(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

λ> soluciones [1,3,2]

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

λ> sort (nub (soluciones [3,3,2]))

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

λ> sort (nub (soluciones [3,2,1]))

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

(finales xs) son las listas obtenidas transformando xs y a las que no se les puede aplicar más transformaciones. Por ejemplo,

     finales [1,2,3]               ==  [[1,2,3]]
     finales [1,3,2]               ==  [[1,2,3],[1,3,3]]
     finales [3,2,1]               ==  [[2,2,3],[2,3,3],[3,3,3]]
     finales [1,3,2,4]             ==  [[1,2,3,4],[1,3,3,4]]
     finales [1,3,2,3]             ==  [[1,2,3,3],[1,3,3,3]]
     length (finales [9,6,0,7,2])  ==  19
     length (finales [80,60..0])   ==  420

finales [1,2,3] == [[1,2,3]]

finales [1,3,2] == [[1,2,3],[1,3,3]]

finales [3,2,1] == [[2,2,3],[2,3,3],[3,3,3]]

finales [1,3,2,4] == [[1,2,3,4],[1,3,3,4]]

finales [1,3,2,3] == [[1,2,3,3],[1,3,3,3]]

length (finales [9,6,0,7,2]) == 19

length (finales [80,60..0]) == 420

(finalesMaximales xs) es el par (n,yss) tal que la longitud de las cadenas más largas de transformaciones a partir de xs e yss es la lista de los estados finales a partir de xs con n transformaciones. Por ejemplo,

     finalesMaximales [9,5,7]   ==  (2,[[6,8,9],[8,8,9]])
     finalesMaximales [3,2,1]   ==  (4,[[2,3,3],[3,3,3]])
     finalesMaximales [3,2..0]  ==  (10,[[2,3,3,3],[3,3,3,3]])
     finalesMaximales [4,3..0]  ==  (20,[[3,4,4,4,4],[4,4,4,4,4]])

finalesMaximales [9,5,7] == (2,[[6,8,9],[8,8,9]])

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

finalesMaximales [3,2..0] == (10,[[2,3,3,3],[3,3,3,3]])

finalesMaximales [4,3..0] == (20,[[3,4,4,4,4],[4,4,4,4,4]])

Soluciones

[schedule expon=’2017-06-07′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-06-07′ at=»06:00″]

import Data.List (nub, sort)
import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado
inicial xs = (0,xs)

esFinal :: Estado -> Bool
esFinal e = null (sucesores e)

--    λ> sucesores [9,6,0,7,2]
--    [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]
sucesores :: Estado -> [Estado]
sucesores (_,[])  = []
sucesores (_,[_]) = []
sucesores (n,x:y:xs) | x > y     = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss
                     | otherwise = yss
    where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]
                       

soluciones :: [Int] -> [Estado]
soluciones xs =
    buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]
finales xs =
    sort (nub (map snd (soluciones xs)))
            
finalesMaximales :: [Int] -> (Int,[[Int]])
finalesMaximales xs =
    (m, [xs | (n,xs) <- es, n == m])
    where es    = sort (nub (soluciones xs))
          (m,_) = maximum es

import Data.List (nub, sort)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado

inicial xs = (0,xs)

esFinal :: Estado -> Bool

esFinal e = null (sucesores e)

-- λ> sucesores [9,6,0,7,2]

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

sucesores :: Estado -> [Estado]

sucesores (_,[]) = []

sucesores (_,[_]) = []

sucesores (n,x:y:xs) | x > y = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss

| otherwise = yss

where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]

soluciones :: [Int] -> [Estado]

soluciones xs =

buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]

finales xs =

sort (nub (map snd (soluciones xs)))

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

finalesMaximales xs =

(m, [xs | (n,xs) <- es, n == m])

where es = sort (nub (soluciones xs))

(m,_) = maximum es

[/schedule]

Sin ceros consecutivos

PorJosé A. Alonso 30-mayo-201725-abril-2021

Definir la función

   sinDobleCero :: Int -> [[Int]]

1	sinDobleCero :: Int -> [[Int]]

tal que (sinDobleCero n) es la lista de las listas de longitud n formadas por el 0 y el 1 tales que no contiene dos ceros consecutivos. Por ejemplo,

   ghci> sinDobleCero 2
   [[1,0],[1,1],[0,1]]
   ghci> sinDobleCero 3
   [[1,1,0],[1,1,1],[1,0,1],[0,1,0],[0,1,1]]
   ghci> sinDobleCero 4
   [[1,1,1,0],[1,1,1,1],[1,1,0,1],[1,0,1,0],[1,0,1,1],
    [0,1,1,0],[0,1,1,1],[0,1,0,1]]

ghci> sinDobleCero 2

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

ghci> sinDobleCero 3

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

ghci> sinDobleCero 4

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

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

Soluciones

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

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

[/schedule]

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

sinDobleCero :: Int -> [[Int]]
sinDobleCero 0 = [[]]
sinDobleCero 1 = [[0],[1]]
sinDobleCero n = [1:xs | xs <- sinDobleCero (n-1)] ++
                 [0:1:ys | ys <- sinDobleCero (n-2)]

sinDobleCero :: Int -> [[Int]]

sinDobleCero 0 = [[]]

sinDobleCero 1 = [[0],[1]]

sinDobleCero n = [1:xs | xs <- sinDobleCero (n-1)] ++

[0:1:ys | ys <- sinDobleCero (n-2)]

[/schedule]

Un mínimo local de una lista es un elemento de la lista que es menor que su predecesor y que su sucesor en la lista. Por ejemplo, 1 es un mínimo local de [8,2,1,3,7,6,4,0,5] ya que es menor que 2 (su predecesor) y que 3 (su sucesor).

Análogamente se definen los máximos locales. Por ejemplo, 7 es un máximo local de [8,2,1,3,7,6,4,0,5] ya que es mayor que 7 (su predecesor) y que 6 (su sucesor).

Los extremos locales están formados por los mínimos y máximos locales. Por ejemplo, los extremos locales de [8,2,1,3,7,6,4,0,5] son el 1, el 7 y el 0.

Definir la función

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

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

tal que (extremos xs) es la lista de los extremos locales de la lista xs. Por ejemplo,

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

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

Soluciones

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

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

[/schedule]

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

-- 1ª definición (por comprensión)
-- ===============================
extremos1 :: Ord a => [a] -> [a]
extremos1 xs = 
    [y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), extremo x y z]

-- (extremo x y z) se verifica si y es un extremo local de [x,y,z]. Por
-- ejemplo,
--    extremo 2 1 3  ==  True
--    extremo 3 7 6  ==  True
--    extremo 7 6 4  ==  False
--    extremo 5 6 7  ==  False
--    extremo 5 5 7  ==  False
extremo :: Ord a => a -> a -> a -> Bool
extremo x y z = (y < x && y < z) || (y > x && y > z)

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

extremos2 :: Ord a => [a] -> [a]
extremos2 (x:y:z:xs) 
    | extremo x y z = y : extremos2 (y:z:xs)
    | otherwise     = extremos2 (y:z:xs)
extremos2 _ = []

-- 1ª definición (por comprensión)

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

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

extremos1 xs =

[y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), extremo x y z]

-- (extremo x y z) se verifica si y es un extremo local de [x,y,z]. Por

-- ejemplo,

-- extremo 2 1 3 == True

-- extremo 3 7 6 == True

-- extremo 7 6 4 == False

-- extremo 5 6 7 == False

-- extremo 5 5 7 == False

extremo :: Ord a => a -> a -> a -> Bool

extremo x y z = (y < x && y < z) || (y > x && y > z)

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

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

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

extremos2 (x:y:z:xs)

| extremo x y z = y : extremos2 (y:z:xs)

| otherwise = extremos2 (y:z:xs)

extremos2 _ = []

[/schedule]

Subexpresiones aritméticas

PorJosé A. Alonso 26-mayo-201725-abril-2021

Las expresiones aritméticas pueden representarse usando el siguiente tipo de datos

   data Expr = N Int | S Expr Expr | P Expr Expr  
     deriving (Eq, Ord, Show)

1 2	data Expr = N Int \| S Expr Expr \| P Expr Expr deriving (Eq, Ord, Show)

Por ejemplo, la expresión 2*(3+7) se representa por

   P (N 2) (S (N 3) (N 7))

1	P (N 2) (S (N 3) (N 7))

Definir la función

   subexpresiones :: Expr -> Set Expr

1	subexpresiones :: Expr -> Set Expr

tal que (subexpresiones e) es el conjunto de las subexpresiones de e. Por ejemplo,

   λ> subexpresiones (S (N 2) (N 3))
   fromList [N 2,N 3,S (N 2) (N 3)]
   λ> subexpresiones (P (S (N 2) (N 2)) (N 7))
   fromList [N 2,N 7,S (N 2) (N 2),P (S (N 2) (N 2)) (N 7)]

λ> subexpresiones (S (N 2) (N 3))

fromList [N 2,N 3,S (N 2) (N 3)]

λ> subexpresiones (P (S (N 2) (N 2)) (N 7))

fromList [N 2,N 7,S (N 2) (N 2),P (S (N 2) (N 2)) (N 7)]

Soluciones

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

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

[/schedule]

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

import Data.Set

data Expr = N Int | S Expr Expr | P Expr Expr  
  deriving (Eq, Ord, Show)

subexpresiones :: Expr -> Set Expr
subexpresiones (N x)   = singleton (N x)
subexpresiones (S i d) =
  S i d `insert` (subexpresiones i `union` subexpresiones d)
subexpresiones (P i d) =
  P i d `insert` (subexpresiones i `union` subexpresiones d)

import Data.Set

data Expr = N Int | S Expr Expr | P Expr Expr

deriving (Eq, Ord, Show)

subexpresiones :: Expr -> Set Expr

subexpresiones (N x) = singleton (N x)

subexpresiones (S i d) =

S i d `insert` (subexpresiones i `union` subexpresiones d)

subexpresiones (P i d) =

P i d `insert` (subexpresiones i `union` subexpresiones d)

[/schedule]

Representaciones de grafos

PorJosé A. Alonso 24-mayo-201725-abril-2021

Los grafos no dirigidos puede representarse mediante matrices de adyacencia y también mediante listas de adyacencia. Por ejemplo, el grafo

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

1 ----- 2

| \ |

| 3 |

| / |

4 ----- 5

se puede representar por la matriz de adyacencia

   |0 1 1 1 0|
   |1 0 0 0 1|
   |1 0 0 1 0|
   |1 0 1 0 1|
   |0 1 0 1 0|

|0 1 1 1 0|

|1 0 0 0 1|

|1 0 0 1 0|

|1 0 1 0 1|

|0 1 0 1 0|

donde el elemento (i,j) es 1 si hay una arista entre los vértices i y j y es 0 si no la hay. También se puede representar por la lista de adyacencia

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

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

donde las primeras componentes son los vértices y las segundas la lista de los vértices conectados.

Definir las funciones

   matrizAlista :: Matrix Int -> [(Int,[Int])]
   listaAmatriz :: [(Int,[Int])] -> Matrix Int

1 2	matrizAlista :: Matrix Int -> [(Int,[Int])] listaAmatriz :: [(Int,[Int])] -> Matrix Int

tales que

(matrizAlista a) es la lista de adyacencia correspondiente a la matriz de adyacencia a. Por ejemplo, definiendo la matriz anterior por

     ejMatriz :: Matrix Int
     ejMatriz = fromLists [[0,1,1,1,0],
                           [1,0,0,0,1],
                           [1,0,0,1,0],
                           [1,0,1,0,1],
                           [0,1,0,1,0]]

ejMatriz :: Matrix Int

ejMatriz = fromLists [[0,1,1,1,0],

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

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

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

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

se tiene que

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

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

(listaAmatriz ps) es la matriz de adyacencia correspondiente a la lista de adyacencia ps. Por ejemplo,

     λ> listaAmatriz [(1,[2,3,4]),(2,[1,5]),(3,[1,4]),(4,[1,3,5]),(5,[2,4])]
     ( 0 1 1 1 0 )
     ( 1 0 0 0 1 )
     ( 1 0 0 1 0 )
     ( 1 0 1 0 1 )
     ( 0 1 0 1 0 )
     λ> matrizAlista it
     [(1,[2,3,4]),(2,[1,5]),(3,[1,4]),(4,[1,3,5]),(5,[2,4])]

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

( 0 1 1 1 0 )

( 1 0 0 0 1 )

( 1 0 0 1 0 )

( 1 0 1 0 1 )

( 0 1 0 1 0 )

λ> matrizAlista it

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

Soluciones

[schedule expon=’2017-05-31′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-31′ at=»06:00″]

import Data.List (sort)
import Data.Matrix

ejMatriz :: Matrix Int
ejMatriz = fromLists [[0,1,1,1,0],
                      [1,0,0,0,1],
                      [1,0,0,1,0],
                      [1,0,1,0,1],
                      [0,1,0,1,0]]

matrizAlista :: Matrix Int -> [(Int,[Int])]
matrizAlista a = 
  [(i,[j | j <- [1..n], a!(i,j) == 1]) | i <- [1..n]]
  where n = nrows a

listaAmatriz :: [(Int,[Int])] -> Matrix Int
listaAmatriz ps = fromLists [fila n xs | (_,xs) <- sort ps]
  where n = length ps
        fila n xs = [f i | i <- [1..n]]
          where f i | i `elem` xs = 1
                    | otherwise   = 0

import Data.List (sort)

import Data.Matrix

ejMatriz :: Matrix Int

ejMatriz = fromLists [[0,1,1,1,0],

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

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

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

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

matrizAlista :: Matrix Int -> [(Int,[Int])]

matrizAlista a =

[(i,[j | j <- [1..n], a!(i,j) == 1]) | i <- [1..n]]

where n = nrows a

listaAmatriz :: [(Int,[Int])] -> Matrix Int

listaAmatriz ps = fromLists [fila n xs | (_,xs) <- sort ps]

where n = length ps

fila n xs = [f i | i <- [1..n]]

where f i | i `elem` xs = 1

| otherwise = 0

[/schedule]

Polinomios de Fibonacci

PorJosé A. Alonso 23-mayo-201726-marzo-2022

La sucesión de polinomios de Fibonacci se define por

   p(0) = 0
   p(1) = 1
   p(n) = x*p(n-1) + p(n-2)

p(0) = 0

p(1) = 1

p(n) = x*p(n-1) + p(n-2)

Los primeros términos de la sucesión son

   p(2) = x
   p(3) = x^2 + 1
   p(4) = x^3 + 2*x
   p(5) = x^4 + 3*x^2 + 1

p(2) = x

p(3) = x^2 + 1

p(4) = x^3 + 2*x

p(5) = x^4 + 3*x^2 + 1

Definir la lista

   sucPolFib :: [Polinomio Integer]

1	sucPolFib :: [Polinomio Integer]

tal que sus elementos son los polinomios de Fibonacci. Por ejemplo,

   λ> take 7 sucPolFib
   [0,1,1*x,x^2 + 1,x^3 + 2*x,x^4 + 3*x^2 + 1,x^5 + 4*x^3 + 3*x]
   λ> sum (map grado (take 3000 sucPolFib2))
   4495501

λ> take 7 sucPolFib

[0,1,1*x,x^2 + 1,x^3 + 2*x,x^4 + 3*x^2 + 1,x^5 + 4*x^3 + 3*x]

λ> sum (map grado (take 3000 sucPolFib2))

4495501

Comprobar con QuickCheck que el valor del n-ésimo término de sucPolFib para x=1 es el n-ésimo término de la sucesión de Fibonacci 0, 1, 1, 2, 3, 5, 8, …

Nota. Limitar la búsqueda a ejemplos pequeños usando

   quickCheckWith (stdArgs {maxSize=5}) prop_polFib

1	quickCheckWith (stdArgs {maxSize=5}) prop_polFib

Soluciones

[schedule expon=’2017-05-30′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-30′ at=»06:00″]

import Data.List (genericIndex)
import I1M.PolOperaciones
import Test.QuickCheck

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

sucPolFib :: [Polinomio Integer]
sucPolFib = [polFibR n | n <- [0..]]

polFibR :: Integer -> Polinomio Integer
polFibR 0 = polCero
polFibR 1 = polUnidad
polFibR n = 
  sumaPol (multPol (consPol 1 1 polCero) (polFibR (n-1)))
          (polFibR (n-2))

-- 2ª definición (dinámica)
-- ========================

sucPolFib2 :: [Polinomio Integer]
sucPolFib2 = 
  polCero : polUnidad : zipWith f (tail sucPolFib2) sucPolFib2
  where f p = sumaPol (multPol (consPol 1 1 polCero) p)

-- La propiedad es
prop_polFib :: Integer -> Property
prop_polFib n = 
    n >= 0 ==> valor (polFib n) 1 == fib n
    where polFib n = sucPolFib2 `genericIndex` n
          fib n    = fibs `genericIndex` n

fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

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

import Data.List (genericIndex)

import I1M.PolOperaciones

import Test.QuickCheck

-- 1ª solución

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

sucPolFib :: [Polinomio Integer]

sucPolFib = [polFibR n | n <- [0..]]

polFibR :: Integer -> Polinomio Integer

polFibR 0 = polCero

polFibR 1 = polUnidad

polFibR n =

sumaPol (multPol (consPol 1 1 polCero) (polFibR (n-1)))

(polFibR (n-2))

-- 2ª definición (dinámica)

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

sucPolFib2 :: [Polinomio Integer]

sucPolFib2 =

polCero : polUnidad : zipWith f (tail sucPolFib2) sucPolFib2

where f p = sumaPol (multPol (consPol 1 1 polCero) p)

-- La propiedad es

prop_polFib :: Integer -> Property

prop_polFib n =

n >= 0 ==> valor (polFib n) 1 == fib n

where polFib n = sucPolFib2 `genericIndex` n

fib n = fibs `genericIndex` n

fibs :: [Integer]

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

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=5}) prop_polFib

-- +++ OK, passed 100 tests.

[/schedule]

El pasatiempo de Ulises

PorJosé A. Alonso 22-mayo-201726-marzo-2022

Ulises, en sus ratos libres, juega a un pasatiempo que consiste en, dada una serie de números naturales positivos en una cola, sacar un elemento y, si es distinto de 1, volver a meter el mayor de sus divisores propios. Si el número que saca es el 1, entonces lo deja fuera y no mete ningún otro. El pasatiempo continúa hasta que la cola queda vacía.

Por ejemplo, a partir de una cola con los números 10, 20 y 30, el pasatiempo se desarrollaría como sigue:

  C [30,20,10]
  C [20,10,15]
  C [10,15,10]
  C [15,10,5]
  C [10,5,5]
  C [5,5,5]
  C [5,5,1]
  C [5,1,1]
  C [1,1,1]
  C [1,1]
  C [1]
  C []

C [30,20,10]

C [20,10,15]

C [10,15,10]

C [15,10,5]

C [10,5,5]

C [5,5,5]

C [5,5,1]

C [5,1,1]

C [1,1,1]

C [1,1]

C [1]

C []

Definir la función

   numeroPasos :: Cola Int -> Int

1	numeroPasos :: Cola Int -> Int

tal que (numeroPasos c) es el número de veces que Ulises saca algún número de la cola c al utilizarla en su pasatiempo. Por ejemplo,

   numeroPasos (foldr inserta vacia [30])        ==  4
   numeroPasos (foldr inserta vacia [20])        ==  4
   numeroPasos (foldr inserta vacia [10])        ==  3
   numeroPasos (foldr inserta vacia [10,20,30])  ==  11

numeroPasos (foldr inserta vacia [30]) == 4

numeroPasos (foldr inserta vacia [20]) == 4

numeroPasos (foldr inserta vacia [10]) == 3

numeroPasos (foldr inserta vacia [10,20,30]) == 11

Soluciones

[schedule expon=’2017-05-29′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-29′ at=»06:00″]

import I1M.Cola
import Data.Numbers.Primes (primeFactors)

numeroPasos :: Cola Int -> Int
numeroPasos c
    | esVacia c = 0
    | pc == 1   = 1 + numeroPasos rc
    | otherwise = 1 + numeroPasos (inserta (mayorDivisorPropio pc) rc)
    where pc = primero c
          rc = resto c

-- 1ª definición de mayorDivisorPropio
mayorDivisorPropio1 :: Int -> Int
mayorDivisorPropio1 n = 
    head [x | x <- [n-1,n-2..], n `mod` x == 0]

-- 2ª definición de mayorDivisorPropio
mayorDivisorPropio2 :: Int -> Int
mayorDivisorPropio2 n =
    n `div` head (primeFactors n)

-- Comparación de eficiencia:
--    ghci> sum (map mayorDivisorPropio1 [2..3000])
--    1485659
--    (3.91 secs, 618,271,360 bytes)
--    ghci> sum (map mayorDivisorPropio2 [2..3000])
--    1485659
--    (0.04 secs, 22,726,600 bytes)

import I1M.Cola

import Data.Numbers.Primes (primeFactors)

numeroPasos :: Cola Int -> Int

numeroPasos c

| esVacia c = 0

| pc == 1 = 1 + numeroPasos rc

| otherwise = 1 + numeroPasos (inserta (mayorDivisorPropio pc) rc)

where pc = primero c

rc = resto c

-- 1ª definición de mayorDivisorPropio

mayorDivisorPropio1 :: Int -> Int

mayorDivisorPropio1 n =

head [x | x <- [n-1,n-2..], n `mod` x == 0]

-- 2ª definición de mayorDivisorPropio

mayorDivisorPropio2 :: Int -> Int

mayorDivisorPropio2 n =

n `div` head (primeFactors n)

-- Comparación de eficiencia:

-- ghci> sum (map mayorDivisorPropio1 [2..3000])

-- 1485659

-- (3.91 secs, 618,271,360 bytes)

-- ghci> sum (map mayorDivisorPropio2 [2..3000])

-- 1485659

-- (0.04 secs, 22,726,600 bytes)

[/schedule]

Caminos reducidos

PorJosé A. Alonso 19-mayo-201725-abril-2021

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

1 2	data Direccion = N \| S \| E \| O deriving (Show, Eq) type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

1	reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [S,S,S,N,N,N]                   ==  []
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

reducido [] == []

reducido [N] == [N]

reducido [N,O] == [N,O]

reducido [N,O,E] == [N]

reducido [N,O,E,S] == []

reducido [N,O,S,E] == [N,O,S,E]

reducido [S,S,S,N,N,N] == []

reducido [N,S,S,E,O,N] == []

reducido [N,S,S,E,O,N,O] == [O]

reducido (take (10^7) (cycle [N,E,O,S])) == []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

[N,S,S,E,O,N,O]

--> [S,E,O,N,O]

--> [S,N,O]

--> [O]

Soluciones

[schedule expon=’2017-05-26′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-26′ at=»06:00″]

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds

opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E

-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs

-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds

-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs

-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (2.17 secs, 379049224 bytes)

data Direccion = N | S | E | O deriving (Show, Eq)

type Camino = [Direccion]

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

reducido1 :: Camino -> Camino

reducido1 [] = []

reducido1 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido1 ds

opuesta :: Direccion -> Direccion

opuesta N = S

opuesta S = N

opuesta E = O

opuesta O = E

-- 2ª solución (por plegado)

reducido2 :: Camino -> Camino

reducido2 = foldr aux []

where aux N (S:xs) = xs

aux S (N:xs) = xs

aux E (O:xs) = xs

aux O (E:xs) = xs

aux x xs = x:xs

-- 3ª solución

reducido3 :: Camino -> Camino

reducido3 [] = []

reducido3 (N:S:ds) = reducido3 ds

reducido3 (S:N:ds) = reducido3 ds

reducido3 (E:O:ds) = reducido3 ds

reducido3 (O:E:ds) = reducido3 ds

reducido3 (d:ds) | null ds' = [d]

| d == opuesta (head ds') = tail ds'

| otherwise = d:ds'

where ds' = reducido3 ds

-- 4ª solución

reducido4 :: Camino -> Camino

reducido4 ds = reverse (aux ([],ds)) where

aux (N:xs, S:ys) = aux (xs,ys)

aux (S:xs, N:ys) = aux (xs,ys)

aux (E:xs, O:ys) = aux (xs,ys)

aux (O:xs, E:ys) = aux (xs,ys)

aux ( xs, y:ys) = aux (y:xs,ys)

aux ( xs, []) = xs

-- Comparación de eficiencia

-- ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (3.87 secs, 460160736 bytes)

-- ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (1.16 secs, 216582880 bytes)

-- ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.58 secs, 98561872 bytes)

-- ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))

-- []

-- (0.64 secs, 176154640 bytes)

-- ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (5.43 secs, 962694784 bytes)

-- ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))

-- []

-- (9.29 secs, 1722601528 bytes)

-- ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (4.52 secs, 547004960 bytes)

-- ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])

-- 400002

-- (2.17 secs, 379049224 bytes)

[/schedule]

Descomposiciones de N como sumas de 1, 3 ó 4.

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

El número 5 se puede descomponer en 6 formas distintas como sumas cuyos sumandos sean 1, 3 ó 4:

   5 = 1 + 1 + 1 + 1 + 1
   5 = 1 + 1 + 3
   5 = 1 + 3 + 1
   5 = 3 + 1 + 1
   5 = 1 + 4
   5 = 4 + 1

5 = 1 + 1 + 1 + 1 + 1

5 = 1 + 1 + 3

5 = 1 + 3 + 1

5 = 3 + 1 + 1

5 = 1 + 4

5 = 4 + 1

Definir las funciones

   descomposiciones  :: Integer -> [[Integer]]
   nDescomposiciones :: Integer -> Integer

1 2	descomposiciones :: Integer -> [[Integer]] nDescomposiciones :: Integer -> Integer

tales que

(descomposiciones n) es la lista de las descomposiciones de n como sumas cuyos sumandos sean 1, 3 ó 4. Por ejemplo,

      λ> descomposiciones1 4
      [[4],[3,1],[1,3],[1,1,1,1]]
      λ> descomposiciones1 5
      [[4,1],[1,4],[3,1,1],[1,3,1],[1,1,3],[1,1,1,1,1]]
      λ> descomposiciones1 6
      [[3,3],[4,1,1],[1,4,1],[1,1,4],[3,1,1,1],[1,3,1,1],[1,1,3,1],
       [1,1,1,3],[1,1,1,1,1,1]]

λ> descomposiciones1 4

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

λ> descomposiciones1 5

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

λ> descomposiciones1 6

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

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

(nDescomposiciones n) es el número de descomposiciones de n como sumas cuyos sumandos sean 1, 3 ó 4. Por ejemplo,

     nDescomposiciones 5                       ==  6
     nDescomposiciones 10                      ==  64
     nDescomposiciones 20                      ==  7921
     nDescomposiciones 30                      ==  974169
     length (show (nDescomposiciones (10^5)))  ==  20899

nDescomposiciones 5 == 6

nDescomposiciones 10 == 64

nDescomposiciones 20 == 7921

nDescomposiciones 30 == 974169

length (show (nDescomposiciones (10^5))) == 20899

Nota: Se puede usar programación dinámica.

Soluciones

[schedule expon=’2017-05-25′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-25′ at=»06:00″]

import Data.List (genericLength)
import Data.Array

-- 1ª definición de descomposiciones (espacios de estado)
-- ======================================================

descomposiciones1 :: Integer -> [[Integer]]
descomposiciones1 n = busca [inicial]
  where
    busca []        = []
    busca (e:es)  
      | esFinal n e = e : busca es
      | otherwise   = busca (es ++ sucesores n e)

-- Un estado es la lista de monedas usadas hasta ahora.
type Estado = [Integer] 

-- inicial es el estado inicial del problema; es decir, cuando no se
-- ha usado ninguna moneda.
inicial :: Estado
inicial = []

-- (esFinal n e) es verifica si e es un estado final del problema n. Por
-- ejemplo, 
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal :: Integer -> Estado -> Bool
esFinal n xs = sum xs == n

-- (sucesores n e) es la lista de los sucesores del estado e en el
-- problema n. 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 :: Integer -> Estado -> [Estado]
sucesores n xs =
     [1:xs | 1 + k <= n]
  ++ [3:xs | 3 + k <= n]
  ++ [4:xs | 4 + k <= n]
  where k = sum xs

-- 2ª definición de descomposiciones (espacios de estado)
-- ======================================================

descomposiciones2 :: Integer -> [[Integer]]
descomposiciones2 n = busca [inicial2 n]
  where
    busca []       = []
    busca (e:es)  
      | esFinal2 e = snd e : busca es
      | otherwise  = busca (es ++ sucesores2 n e)

-- Un estado es una par formado por la cantidad a conseguir y la lista
-- de monedas usadas hasta ahora.
type Estado2 = (Integer,[Integer]) 

-- (inicial2 n) es el estado inicial del problema; es decir, cuando no se
-- ha usado ninguna moneda.
inicial2 :: Integer -> Estado2
inicial2 n = (n,[])

-- (esFinal2 e) es verifica si e es un estado final del problema. Por
-- ejemplo, 
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal2 :: Estado2 -> Bool
esFinal2 (k,_) = k == 0

-- (sucesores2 n e) es la lista de los sucesores del estado e en el
-- problema n. 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)]
sucesores2 :: Integer -> Estado2 -> [Estado2]
sucesores2 n (k,xs) =
     [(k-1, 1:xs) | k >= 1]
  ++ [(k-3, 3:xs) | k >= 3]
  ++ [(k-4, 4:xs) | k >= 4]

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

descomposiciones3 :: Integer -> [[Integer]]
descomposiciones3 0 = [[]]
descomposiciones3 1 = [[1]]
descomposiciones3 2 = [[1,1]]
descomposiciones3 3 = [[1,1,1],[3]]
descomposiciones3 n =
     [1:xs | xs <- descomposiciones3 (n-1)]
  ++ [3:xs | xs <- descomposiciones3 (n-3)]
  ++ [4:xs | xs <- descomposiciones3 (n-4)]  

-- 4ª definición de descomposiciones (dinámica)
-- ============================================

descomposiciones4 :: Integer -> [[Integer]]
descomposiciones4 n = v!n
  where v = array (0,n) [(i,aux v i) | i <- [0..n]] 
        aux v 0 = [[]]
        aux v 1 = [[1]]
        aux v 2 = [[1,1]]
        aux v 3 = [[1,1,1],[3]]
        aux v k =    map (1:) (v!(k-1))
                  ++ map (3:) (v!(k-3))
                  ++ map (4:) (v!(k-4))

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

nDescomposiciones1 :: Integer -> Integer
nDescomposiciones1 =
  genericLength . descomposiciones1

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

nDescomposiciones2 :: Integer -> Integer
nDescomposiciones2 =
  genericLength . descomposiciones2

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

nDescomposiciones3 :: Integer -> Integer
nDescomposiciones3 =
  genericLength . descomposiciones3

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

nDescomposiciones4 :: Integer -> Integer
nDescomposiciones4 =
  genericLength . descomposiciones4

-- 5ª definición de nDescomposiciones (dinámica)
-- =============================================

nDescomposiciones5 :: Integer -> Integer
nDescomposiciones5 n = v!n
  where v = array (0,n) [(i,aux v i) | i <- [0..n]] 
        aux v 0 = 1
        aux v 1 = 1
        aux v 2 = 1
        aux v 3 = 2
        aux v k = v!(k-1) + v!(k-3) + v!(k-4)

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

--    λ> nDescomposiciones1 20
--    7921
--    (3.21 secs, 3,199,383,064 bytes)
--    λ> nDescomposiciones2 20
--    7921
--    (3.17 secs, 3,176,666,880 bytes)
--    λ> nDescomposiciones3 20
--    7921
--    (0.08 secs, 17,714,152 bytes)
--    
--    λ> nDescomposiciones3 27
--    229970
--    (3.73 secs, 628,730,968 bytes)
--    λ> nDescomposiciones4 27
--    229970
--    (0.45 secs, 111,518,016 bytes)
--    
--    λ> nDescomposiciones4 30
--    974169
--    (2.02 secs, 454,484,992 bytes)
--    λ> nDescomposiciones5 30
--    974169
--    (0.00 secs, 0 bytes)

--    λ> nDescomposiciones2 30
--    974169
--    (2.10 secs, 441,965,208 bytes)
--    λ> nDescomposiciones3 30
--    974169
--    (0.00 secs, 0 bytes)
--    
--    λ> length (show (nDescomposiciones5 (10^5)))
--    20899
--    (3.00 secs, 1,050,991,880 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

import Data.List (genericLength)

import Data.Array

-- 1ª definición de descomposiciones (espacios de estado)

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

descomposiciones1 :: Integer -> [[Integer]]

descomposiciones1 n = busca [inicial]

where

busca [] = []

busca (e:es)

| esFinal n e = e : busca es

| otherwise = busca (es ++ sucesores n e)

-- Un estado es la lista de monedas usadas hasta ahora.

type Estado = [Integer]

-- inicial es el estado inicial del problema; es decir, cuando no se

-- ha usado ninguna moneda.

inicial :: Estado

inicial = []

-- (esFinal n e) es verifica si e es un estado final del problema n. Por

-- ejemplo,

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

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

esFinal :: Integer -> Estado -> Bool

esFinal n xs = sum xs == n

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

-- problema n. 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 :: Integer -> Estado -> [Estado]

sucesores n xs =

[1:xs | 1 + k <= n]

++ [3:xs | 3 + k <= n]

++ [4:xs | 4 + k <= n]

where k = sum xs

-- 2ª definición de descomposiciones (espacios de estado)

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

descomposiciones2 :: Integer -> [[Integer]]

descomposiciones2 n = busca [inicial2 n]

where

busca [] = []

busca (e:es)

| esFinal2 e = snd e : busca es

| otherwise = busca (es ++ sucesores2 n e)

-- Un estado es una par formado por la cantidad a conseguir y la lista

-- de monedas usadas hasta ahora.

type Estado2 = (Integer,[Integer])

-- (inicial2 n) es el estado inicial del problema; es decir, cuando no se

-- ha usado ninguna moneda.

inicial2 :: Integer -> Estado2

inicial2 n = (n,[])

-- (esFinal2 e) es verifica si e es un estado final del problema. Por

-- ejemplo,

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

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

esFinal2 :: Estado2 -> Bool

esFinal2 (k,_) = k == 0

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

-- problema n. 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)]

sucesores2 :: Integer -> Estado2 -> [Estado2]

sucesores2 n (k,xs) =

[(k-1, 1:xs) | k >= 1]

++ [(k-3, 3:xs) | k >= 3]

++ [(k-4, 4:xs) | k >= 4]

-- 3ª definición de descomposiciones

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

descomposiciones3 :: Integer -> [[Integer]]

descomposiciones3 0 = [[]]

descomposiciones3 1 = [[1]]

descomposiciones3 2 = [[1,1]]

descomposiciones3 3 = [[1,1,1],[3]]

descomposiciones3 n =

[1:xs | xs <- descomposiciones3 (n-1)]

++ [3:xs | xs <- descomposiciones3 (n-3)]

++ [4:xs | xs <- descomposiciones3 (n-4)]

-- 4ª definición de descomposiciones (dinámica)

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

descomposiciones4 :: Integer -> [[Integer]]

descomposiciones4 n = v!n

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

aux v 0 = [[]]

aux v 1 = [[1]]

aux v 2 = [[1,1]]

aux v 3 = [[1,1,1],[3]]

aux v k = map (1:) (v!(k-1))

++ map (3:) (v!(k-3))

++ map (4:) (v!(k-4))

-- 1ª definición de nDescomposiciones

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

nDescomposiciones1 :: Integer -> Integer

nDescomposiciones1 =

genericLength . descomposiciones1

-- 2ª definición de nDescomposiciones

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

nDescomposiciones2 :: Integer -> Integer

nDescomposiciones2 =

genericLength . descomposiciones2

-- 3ª definición de nDescomposiciones

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

nDescomposiciones3 :: Integer -> Integer

nDescomposiciones3 =

genericLength . descomposiciones3

-- 4ª definición de nDescomposiciones

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

nDescomposiciones4 :: Integer -> Integer

nDescomposiciones4 =

genericLength . descomposiciones4

-- 5ª definición de nDescomposiciones (dinámica)

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

nDescomposiciones5 :: Integer -> Integer

nDescomposiciones5 n = v!n

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

aux v 0 = 1

aux v 1 = 1

aux v 2 = 1

aux v 3 = 2

aux v k = v!(k-1) + v!(k-3) + v!(k-4)

-- Comparación de eficiencia

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

-- λ> nDescomposiciones1 20

-- 7921

-- (3.21 secs, 3,199,383,064 bytes)

-- λ> nDescomposiciones2 20

-- 7921

-- (3.17 secs, 3,176,666,880 bytes)

-- λ> nDescomposiciones3 20

-- 7921

-- (0.08 secs, 17,714,152 bytes)

-- λ> nDescomposiciones3 27

-- 229970

-- (3.73 secs, 628,730,968 bytes)

-- λ> nDescomposiciones4 27

-- 229970

-- (0.45 secs, 111,518,016 bytes)

-- λ> nDescomposiciones4 30

-- 974169

-- (2.02 secs, 454,484,992 bytes)

-- λ> nDescomposiciones5 30

-- 974169

-- (0.00 secs, 0 bytes)

-- λ> nDescomposiciones2 30

-- 974169

-- (2.10 secs, 441,965,208 bytes)

-- λ> nDescomposiciones3 30

-- 974169

-- (0.00 secs, 0 bytes)

-- λ> length (show (nDescomposiciones5 (10^5)))

-- 20899

-- (3.00 secs, 1,050,991,880 bytes)

[/schedule]

Caminos en un grafo

PorJosé A. Alonso 17-mayo-201726-marzo-2022

Definir las funciones

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

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

tales que

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

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

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

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

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

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

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

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

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

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

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

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

[]

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

109601

Nota: Este ejercicio debe realizarse usando únicamente las funciones de la librería de grafos (I1M.Grafo) que se describe aquí y se encuentra aquí.

Soluciones

[schedule expon=’2017-05-24′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-24′ at=»06:00″]

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

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

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

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

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

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

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

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

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

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

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

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

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

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

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

aux [] = []

aux ((x:xs):yss)

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

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

, z `notElem` (x:xs)]

++ yss)

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

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

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

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

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

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

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

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

-- 109601

-- (3.57 secs, 500533816 bytes)

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

-- 109601

-- (3.53 secs, 470814096 bytes)

[/schedule]

Problema del dominó

PorJosé A. Alonso 16-mayo-201726-marzo-2022

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

Definir la función

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

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

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

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

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

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

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

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

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

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

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

[]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

84480

Soluciones

[schedule expon=’2017-05-23′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-23′ at=»06:00″]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

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

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

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

type Ficha = (Int,Int)

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

type Problema = [Ficha]

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

-- colocadas.

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

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

inicial :: Problema -> Estado

inicial p = (p,[])

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

esFinal :: Estado -> Bool

esFinal (fs,_) = null fs

sucesores :: Estado -> [Estado]

sucesores (fs,[]) =

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

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

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

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

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

soluciones :: Problema -> [Estado]

soluciones p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]

domino ps = map snd (soluciones ps)

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

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

soluciones2 :: Problema -> [Estado]

soluciones2 p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]

domino2 ps = map snd (soluciones2 ps)

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

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

domino3 :: Problema -> [[Ficha]]

domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]

soluciones3 ps = buscaEE sucesores

esFinal

(inicial ps)

[/schedule]

El algoritmo de Damm

PorJosé A. Alonso 15-mayo-20172-agosto-2023

El algoritmo de Damm se usa en la detección de errores en códigos numéricos. Es un procedimiento para obtener un dígito de control, usando la siguiente matriz, como describimos en los ejemplos

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

| 0 1 2 3 4 5 6 7 8 9

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

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

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

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

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

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

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

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

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

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

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

Ejemplo 1: cálculo del dígito de control de 572

se comienza con la fila 0 y columna 5 de la matriz -> 9
a continuación, la fila 9 y columna 7 de la matriz -> 7
a continuación, la fila 7 y columna 2 de la matriz -> 4

con lo que se llega al final del proceso. Entonces, el dígito de control de 572 es 4.

Ejemplo 2: cálculo del dígito de control de 57260

se comienza con la fila 0 y columna 5 de la matriz -> 9
a continuación, la fila 9 y columna 7 de la matriz -> 7
a continuación, la fila 9 y columna 2 de la matriz -> 4
a continuación, la fila 6 y columna 4 de la matriz -> 5
a continuación, la fila 5 y columna 0 de la matriz -> 3

con lo que se llega al final del proceso. Entonces, el dígito de control de 57260 es 3.

Representamos las matrices como tablas cuyos índices son pares de números naturales.

   type Matriz a = Array (Int,Int) a

1	type Matriz a = Array (Int,Int) a

Definimos la matriz:

   mDamm :: Matriz Int
   mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,
                                    7,0,9,2,1,5,4,8,6,3,
                                    4,2,0,6,8,7,1,3,5,9,
                                    1,7,5,0,9,8,3,4,2,6,
                                    6,1,2,3,0,4,5,9,7,8,
                                    3,6,7,4,2,0,9,5,8,1,
                                    5,8,6,9,7,2,0,1,3,4,
                                    8,9,4,5,3,6,2,0,1,7,
                                    9,4,3,8,6,1,7,2,0,5,
                                    2,5,8,1,4,3,6,7,9,0]

mDamm :: Matriz Int

mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,

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

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

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

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

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

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

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

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

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

Definir la función

   digitoControl :: Int -> Int

1	digitoControl :: Int -> Int

tal que (digitoControl n) es el dígito de control de n. Por ejemplo:

   digitoControl 572          == 4
   digitoControl 57260        == 3
   digitoControl 12345689012  == 6
   digitoControl 5724         == 0
   digitoControl 572603       == 0
   digitoControl 123456890126 == 0

digitoControl 572 == 4

digitoControl 57260 == 3

digitoControl 12345689012 == 6

digitoControl 5724 == 0

digitoControl 572603 == 0

digitoControl 123456890126 == 0

Comprobar con QuickCheck que si añadimos al final de un número n su dígito de control, el dígito de control del número que resulta siempre es 0.

Soluciones

[schedule expon=’2017-05-22′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-22′ at=»06:00″]

import Data.Array
import Test.QuickCheck

type Matriz a = Array (Int,Int) a

mDamm :: Matriz Int
mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,
                                 7,0,9,2,1,5,4,8,6,3,
                                 4,2,0,6,8,7,1,3,5,9,
                                 1,7,5,0,9,8,3,4,2,6,
                                 6,1,2,3,0,4,5,9,7,8,
                                 3,6,7,4,2,0,9,5,8,1,
                                 5,8,6,9,7,2,0,1,3,4,
                                 8,9,4,5,3,6,2,0,1,7,
                                 9,4,3,8,6,1,7,2,0,5,
                                 2,5,8,1,4,3,6,7,9,0]

-- 1ª solución
digitoControl :: Int -> Int
digitoControl n = aux (digitos n) 0
    where aux [] d = d
          aux (x:xs) d = aux xs (mDamm ! (d,x))

digitos :: Int -> [Int]
digitos n = [read [x] | x <- show n]

-- 2ª solución:
digitoControl2 :: Int -> Int
digitoControl2 n = last (scanl f 0 (digitos n))
    where f d x = mDamm ! (d,x)

-- La propiedad es
prop_DC :: Int -> Property
prop_DC n = n >= 0 ==> digitoControl m == 0
    where m = read (show n ++ show (digitoControl n))

-- La comprobación es
--    ghci> quickCheck prop_DC
--    +++ OK, passed 100 tests.

-- 2ª expresión de la propiedad
prop_DC2 :: Int -> Bool
prop_DC2 n = digitoControl m == 0
    where m = read (show (abs n) ++ show (digitoControl (abs n)))

-- La comprobación es
--    ghci> quickCheck prop_DC2
--    +++ OK, passed 100 tests.

-- 3ª expresión de la propiedad
prop_DC3 :: Int -> Bool
prop_DC3 n = digitoControl (10 * n1 + digitoControl n1) == 0
    where n1 = abs n

-- La comprobación es
--    ghci> quickCheck prop_DC3
--    +++ OK, passed 100 tests.

-- 4ª expresión de la propiedad
prop_DC4 :: (Positive Int) -> Bool
prop_DC4 (Positive n) = 
    digitoControl2 (10 * n + digitoControl2 n) == 0

-- La comprobación es
--    ghci > quickCheck prop_DC4
--    +++ OK, passed 100 tests.

import Data.Array

import Test.QuickCheck

type Matriz a = Array (Int,Int) a

mDamm :: Matriz Int

mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,

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

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

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

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

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

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

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

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

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

-- 1ª solución

digitoControl :: Int -> Int

digitoControl n = aux (digitos n) 0

where aux [] d = d

aux (x:xs) d = aux xs (mDamm ! (d,x))

digitos :: Int -> [Int]

digitos n = [read [x] | x <- show n]

-- 2ª solución:

digitoControl2 :: Int -> Int

digitoControl2 n = last (scanl f 0 (digitos n))

where f d x = mDamm ! (d,x)

-- La propiedad es

prop_DC :: Int -> Property

prop_DC n = n >= 0 ==> digitoControl m == 0

where m = read (show n ++ show (digitoControl n))

-- La comprobación es

-- ghci> quickCheck prop_DC

-- +++ OK, passed 100 tests.

-- 2ª expresión de la propiedad

prop_DC2 :: Int -> Bool

prop_DC2 n = digitoControl m == 0

where m = read (show (abs n) ++ show (digitoControl (abs n)))

-- La comprobación es

-- ghci> quickCheck prop_DC2

-- +++ OK, passed 100 tests.

-- 3ª expresión de la propiedad

prop_DC3 :: Int -> Bool

prop_DC3 n = digitoControl (10 * n1 + digitoControl n1) == 0

where n1 = abs n

-- La comprobación es

-- ghci> quickCheck prop_DC3

-- +++ OK, passed 100 tests.

-- 4ª expresión de la propiedad

prop_DC4 :: (Positive Int) -> Bool

prop_DC4 (Positive n) =

digitoControl2 (10 * n + digitoControl2 n) == 0

-- La comprobación es

-- ghci > quickCheck prop_DC4

-- +++ OK, passed 100 tests.

[/schedule]

El problema de la bicicleta de Turing

PorJosé A. Alonso 12-mayo-201711-mayo-2017

Cuentan que Alan Turing tenía una bicicleta vieja, que tenía una cadena con un eslabón débil y además uno de los radios de la rueda estaba doblado. Cuando el radio doblado coincidía con el eslabón débil, entonces la cadena se rompía.

La bicicleta se identifica por los parámetros (i,d,n) donde

i es el número del eslabón que coincide con el radio doblado al empezar a andar,
d es el número de eslabones que se desplaza la cadena en cada vuelta de la rueda y
n es el número de eslabones de la cadena (el número n es el débil).

Si i = 2, d = 7 y n = 25, entonces la lista con el número de eslabón que toca el radio doblado en cada vuelta es

   [2,9,16,23,5,12,19,1,8,15,22,4,11,18,0,7,14,21,3,10,17,24,6,...

1	[2,9,16,23,5,12,19,1,8,15,22,4,11,18,0,7,14,21,3,10,17,24,6,...

Con lo que la cadena se rompe en la vuelta número 14.

Definir las funciones

   eslabones :: Int -> Int -> Int -> [Int]
   numeroVueltas :: Int -> Int -> Int -> Int

1 2	eslabones :: Int -> Int -> Int -> [Int] numeroVueltas :: Int -> Int -> Int -> Int

tales que

(eslabones i d n) es la lista con los números de eslabones que tocan el radio doblado en cada vuelta en una bicicleta de tipo (i,d,n). Por ejemplo,

     take 10 (eslabones 2 7 25)  ==  [2,9,16,23,5,12,19,1,8,15]

1	take 10 (eslabones 2 7 25) == [2,9,16,23,5,12,19,1,8,15]

(numeroVueltas i d n) es el número de vueltas que pasarán hasta que la cadena se rompa en una bicicleta de tipo (i,d,n). Por ejemplo,

     numeroVueltas 2 7 25  ==  14

1	numeroVueltas 2 7 25 == 14

Soluciones

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

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

[/schedule]

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

-- 1ª definición
eslabones :: Int -> Int -> Int -> [Int]
eslabones i d n = [(i+d*j) `mod` n | j <- [0..]]

-- 2ª definición (con iterate):
eslabones2 :: Int -> Int -> Int -> [Int]
eslabones2 i d n = map (\x-> mod x n) (iterate (+d) i)

numeroVueltas :: Int -> Int -> Int -> Int
numeroVueltas i d n = length (takeWhile (/=0) (eslabones i d n))

-- 1ª definición

eslabones :: Int -> Int -> Int -> [Int]

eslabones i d n = [(i+d*j) `mod` n | j <- [0..]]

-- 2ª definición (con iterate):

eslabones2 :: Int -> Int -> Int -> [Int]

eslabones2 i d n = map (\x-> mod x n) (iterate (+d) i)

numeroVueltas :: Int -> Int -> Int -> Int

numeroVueltas i d n = length (takeWhile (/=0) (eslabones i d n))

[/schedule]

Grafo de divisibilidad

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

El grafo de divisibilidad de orden n es el grafo cuyos nodos son los números naturales entre 1 y n, cuyas aristas son los pares (x,y) tales que x divide a y o y divide a x y el coste de cada arista es el cociente entre su mayos y menor elemento.

Definir las siguientes funciones:

   grafoDivisibilidad :: Int -> Grafo Int Int
   coste :: Int -> Int

1 2	grafoDivisibilidad :: Int -> Grafo Int Int coste :: Int -> Int

tales que

(grafoDivisibilidad n) es el grafo de divisibilidad de orden n. Por ejemplo,

      λ> grafoDivisibilidad 12
      G ND (array (1,12)
                  [(1,[(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),
                       (8,8),(9,9),(10,10),(11,11),(12,12)]),
                   (2,[(1,2),(4,2),(6,3),(8,4),(10,5),(12,6)]),
                   (3,[(1,3),(6,2),(9,3),(12,4)]),
                   (4,[(1,4),(2,2),(8,2),(12,3)]),
                   (5,[(1,5),(10,2)]),
                   (6,[(1,6),(2,3),(3,2),(12,2)]),
                   (7,[(1,7)]),
                   (8,[(1,8),(2,4),(4,2)]),
                   (9,[(1,9),(3,3)]),
                   (10,[(1,10),(2,5),(5,2)]),
                   (11,[(1,11)]),
                   (12,[(1,12),(2,6),(3,4),(4,3),(6,2)])])

λ> grafoDivisibilidad 12

G ND (array (1,12)

[(1,[(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),

(8,8),(9,9),(10,10),(11,11),(12,12)]),

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

(3,[(1,3),(6,2),(9,3),(12,4)]),

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

(5,[(1,5),(10,2)]),

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

(7,[(1,7)]),

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

(9,[(1,9),(3,3)]),

(10,[(1,10),(2,5),(5,2)]),

(11,[(1,11)]),

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

(coste n) es el coste del árbol de expansión mínimo del grafo de divisibilidad de orden n. Por ejemplo,

      coste 12    ==  41
      coste 3000  ==  605305

1 2	coste 12 == 41 coste 3000 == 605305

Soluciones

[schedule expon=’2017-05-18′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-18′ at=»06:00″]

import Data.Ix
import Data.List (delete, sort)
import qualified Data.Set as S
import I1M.Grafo
import I1M.Tabla

grafoDivisibilidad :: Int -> Grafo Int Int
grafoDivisibilidad n =
  creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]
                                      , x <- [1..y-1]
                                      , y `mod` x == 0]


-- 1ª solución (con el algoritmo de Kruskal)
-- =========================================

coste1 :: Int -> Int
coste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]

-- (kruskal g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Kruskal. Por ejemplo,
--    λ> kruskal (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),
--     (2,4,8),(2,3,6),(2,2,4),(2,1,2)]
kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
kruskal g = kruskal' cola                           -- Cola ordenada
                     (tabla [(x,x) | x <- nodos g]) -- Tabla de raices
                     []                             -- Árbol de expansión
                     ((length (nodos g)) - 1)       -- Aristas por
                                                    -- colocar
    where cola = sort [(p,x,y) | (x,y,p) <- aristas g]

kruskal' ((p,x,y):as) t ae n 
  | n==0        = ae
  | actualizado = kruskal' as t' ((p,x,y):ae) (n-1)
  | otherwise   = kruskal' as t  ae           n
  where (actualizado,t') = buscaActualiza (x,y) t

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,
--    raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5  == 1
--    raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2  == 6
raiz:: Eq n => Tabla n n -> n -> n
raiz t x | v == x    = v
         | otherwise = raiz t v
         where v = valor t x

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los
-- dos vértices de la arista a tienen la misma raíz en t y el par
-- formado por True y la tabla obtenida añadiéndole a t la arista
-- formada por el vértice de a de mayor raíz y la raíz del vértice de
-- a de menor raíz. Por ejemplo,
--    ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]
--    ghci> buscaActualiza (2,3) t
--    (True,Tbl [(1,1),(2,1),(3,1),(4,1)])
--    ghci> buscaActualiza (3,4) t
--    (False,Tbl [(1,1),(2,2),(3,1),(4,1)])
buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)
buscaActualiza (x,y) t 
  | x' == y'  = (False, t) 
  | y' <  x'  = (True, modifica (x,y') t)
  | otherwise = (True, modifica (y,x') t)
  where x' = raiz t x 
        y' = raiz t y

-- 2ª solución (con el algoritmo de Prim)
-- ======================================

coste2 :: Int -> Int
coste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]

-- (prim g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
--    λ> prim (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
--     (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim g = prim' [n]              -- Nodos colocados
               ns               -- Nodos por colocar 
               []               -- Árbol de expansión
               (aristas g)      -- Aristas del grafo
         where (n:ns) = nodos g

prim' t [] ae as = ae
prim' t r  ae as = prim' (v':t) (delete v' r) (e:ae) as
  where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
                                         elem u t, 
                                         elem v r]

-- 3ª solución (con el algoritmo de Prim con conjuntos)
-- ====================================================

coste3 :: Int -> Int
coste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]

-- (prim2 g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
--    λ> prim2 (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
--     (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim2 g = prim2' (S.singleton n)  -- Nodos colocados
                 (S.fromList ns)  -- Nodos por colocar 
                 []               -- Árbol de expansión
                 (aristas g)      -- Aristas del grafo
  where (n:ns) = nodos g

prim2' t r ae as
  | S.null r  = ae
  | otherwise = prim2' (S.insert v' t)
                       (S.delete v' r)
                       (e:ae)
                       as
  where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
                                         S.member u t, 
                                         S.member v r]

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

--    λ> coste1 400
--    14923
--    (0.08 secs, 31,336,440 bytes)
--    λ> coste2 400
--    14923
--    (4.54 secs, 220,745,608 bytes)
--    λ> coste3 400
--    14923
--    (0.69 secs, 217,031,144 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.Ix

import Data.List (delete, sort)

import qualified Data.Set as S

import I1M.Grafo

import I1M.Tabla

grafoDivisibilidad :: Int -> Grafo Int Int

grafoDivisibilidad n =

creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]

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

, y `mod` x == 0]

-- 1ª solución (con el algoritmo de Kruskal)

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

coste1 :: Int -> Int

coste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]

-- (kruskal g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Kruskal. Por ejemplo,

-- λ> kruskal (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),

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

kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

kruskal g = kruskal' cola -- Cola ordenada

(tabla [(x,x) | x <- nodos g]) -- Tabla de raices

[] -- Árbol de expansión

((length (nodos g)) - 1) -- Aristas por

-- colocar

where cola = sort [(p,x,y) | (x,y,p) <- aristas g]

kruskal' ((p,x,y):as) t ae n

| n==0 = ae

| actualizado = kruskal' as t' ((p,x,y):ae) (n-1)

| otherwise = kruskal' as t ae n

where (actualizado,t') = buscaActualiza (x,y) t

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,

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

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

raiz:: Eq n => Tabla n n -> n -> n

raiz t x | v == x = v

| otherwise = raiz t v

where v = valor t x

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los

-- dos vértices de la arista a tienen la misma raíz en t y el par

-- formado por True y la tabla obtenida añadiéndole a t la arista

-- formada por el vértice de a de mayor raíz y la raíz del vértice de

-- a de menor raíz. Por ejemplo,

-- ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]

-- ghci> buscaActualiza (2,3) t

-- (True,Tbl [(1,1),(2,1),(3,1),(4,1)])

-- ghci> buscaActualiza (3,4) t

-- (False,Tbl [(1,1),(2,2),(3,1),(4,1)])

buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)

buscaActualiza (x,y) t

| x' == y' = (False, t)

| y' < x' = (True, modifica (x,y') t)

| otherwise = (True, modifica (y,x') t)

where x' = raiz t x

y' = raiz t y

-- 2ª solución (con el algoritmo de Prim)

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

coste2 :: Int -> Int

coste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]

-- (prim g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Prim. Por ejemplo,

-- λ> prim (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),

-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]

prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

prim g = prim' [n] -- Nodos colocados

ns -- Nodos por colocar

[] -- Árbol de expansión

(aristas g) -- Aristas del grafo

where (n:ns) = nodos g

prim' t [] ae as = ae

prim' t r ae as = prim' (v':t) (delete v' r) (e:ae) as

where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,

elem u t,

elem v r]

-- 3ª solución (con el algoritmo de Prim con conjuntos)

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

coste3 :: Int -> Int

coste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]

-- (prim2 g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Prim. Por ejemplo,

-- λ> prim2 (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),

-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]

prim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

prim2 g = prim2' (S.singleton n) -- Nodos colocados

(S.fromList ns) -- Nodos por colocar

[] -- Árbol de expansión

(aristas g) -- Aristas del grafo

where (n:ns) = nodos g

prim2' t r ae as

| S.null r = ae

| otherwise = prim2' (S.insert v' t)

(S.delete v' r)

(e:ae)

where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,

S.member u t,

S.member v r]

-- Comparación de eficiencia

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

-- λ> coste1 400

-- 14923

-- (0.08 secs, 31,336,440 bytes)

-- λ> coste2 400

-- 14923

-- (4.54 secs, 220,745,608 bytes)

-- λ> coste3 400

-- 14923

-- (0.69 secs, 217,031,144 bytes)

[/schedule]

Grafo complemenario

PorJosé A. Alonso 10-mayo-201726-marzo-2022

El complementario del grafo G es un grafo G’ del mismo tipo que G (dirigido o no dirigido), con el mismo conjunto de nodos y tal que dos nodos de G’ son adyacentes si y sólo si no son adyacentes en G. Los pesos de todas las aristas del complementario es igual a 0.

Definir la función

   complementario :: Grafo Int Int -> Grafo Int Int

1	complementario :: Grafo Int Int -> Grafo Int Int

tal que (complementario g) es el complementario de g. Por ejemplo,

   λ> complementario (creaGrafo D (1,3) [(1,3,0),(3,2,0),(2,2,0),(2,1,0)])
   G D (array (1,3) [(1,[(1,0),(2,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])
   λ> complementario (creaGrafo D (1,3) [(3,2,0),(2,2,0),(2,1,0)])
   G D (array (1,3) [(1,[(1,0),(2,0),(3,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

λ> complementario (creaGrafo D (1,3) [(1,3,0),(3,2,0),(2,2,0),(2,1,0)])

G D (array (1,3) [(1,[(1,0),(2,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

λ> complementario (creaGrafo D (1,3) [(3,2,0),(2,2,0),(2,1,0)])

G D (array (1,3) [(1,[(1,0),(2,0),(3,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

Nota: Se usa el módulo Grafo de la librería de I1M o cualquiera de las implementaciones de grafos (GrafoConVectorDeAdyacencia o GrafoConMatrizDeAdyacencia).

Soluciones

[schedule expon=’2017-05-17′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-17′ at=»06:00″]

import I1M.Grafo

complementario :: Grafo Int Int -> Grafo Int Int
complementario g = 
    creaGrafo d (1,n) [(x,y,0) | x <- xs, y <- xs, not (aristaEn g (x,y))]
    where d  = if dirigido g then D else ND
          xs = nodos g
          n  = length xs

import I1M.Grafo

complementario :: Grafo Int Int -> Grafo Int Int

complementario g =

creaGrafo d (1,n) [(x,y,0) | x <- xs, y <- xs, not (aristaEn g (x,y))]

where d = if dirigido g then D else ND

xs = nodos g

n = length xs

[/schedule]

El problema de las celebridades

PorJosé A. Alonso 9-mayo-201725-abril-2021

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

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

Definir la función

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

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

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

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

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

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

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

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

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

Soluciones

[schedule expon=’2017-05-16′ expat=»06:00″]

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

[/schedule]

[schedule on=’2017-05-16′ at=»06:00″]

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List (delete, nub)

import Data.Maybe (listToMaybe)

import qualified Data.Set as S

-- 1ª solución

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

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

celebridad1 r =

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

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

personas r =

nub (map fst r ++ map snd r)

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

esCelebridad r x =

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

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

where ys = delete x (personas r)

-- 2ª solución

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

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

celebridad2 r =

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

where c = S.fromList r

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

-- [1,2,3]

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

personas2 c =

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

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

esCelebridad2 c x =

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

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

where ys = delete x (personas2 c)

-- 3ª definición

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

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

celebridad3 r

| S.null candidatos = Nothing

| esCelebridad = Just candidato

| otherwise = Nothing

where

conjunto = S.fromList r

dominio = S.map fst conjunto

rango = S.map snd conjunto

total = dominio `S.union` rango

candidatos = rango `S.difference` dominio

candidato = S.findMin candidatos

noCandidatos = S.delete candidato total

esCelebridad =

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

-- Comparación de eficiencia

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

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

-- Just 1

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

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

-- Just 1

-- (0.01 secs, 0 bytes)

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

-- Just 1000

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

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

-- Just 1000

-- (0.02 secs, 0 bytes)

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

-- Just 1000000

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

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

-- Just 1

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

[/schedule]

Pares a distancia dada

PorJosé A. Alonso 8-mayo-201715-mayo-2017

Definir la función

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

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

tal que (pares xs k) es la lista de pares de elementos de xs que están a distancia k (se supone que los elementos de xs son distintos). Por ejemplo,

   pares [1,5,3,4,2,8] 2       ==  [(1,3),(3,5),(2,4)]
   pares [1,2,7,9,6,5] 2       ==  [(5,7),(7,9)]
   length (pares [1..10^6] 3)  ==  999997

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

pares [1,2,7,9,6,5] 2 == [(5,7),(7,9)]

length (pares [1..10^6] 3) == 999997

Soluciones

import Data.List (sort, tails)
import Data.Set 

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

pares1 :: [Int] -> Int -> [(Int,Int)]
pares1 xs k =
  [(x,y) | x <- xs, y <- xs, y - x == k]

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

pares2 :: [Int] -> Int -> [(Int,Int)]
pares2 xs k =
  [(y,y+k) | (y:ys) <- init (tails (sort xs))
           , (y+k) `pertenece` ys]

pertenece :: Int -> [Int] -> Bool
pertenece _ [] = False
pertenece x (y:ys) | x < y     = False
                   | x == y    = True
                   | otherwise = pertenece x ys

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

pares3 :: [Int] -> Int -> [(Int,Int)]
pares3 xs k =
  [(x,x+k) | x <- xs
           , (x+k) `member` c]
  where c = fromList xs

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

--    λ> length (pares1 [1..2000] 3)
--    1997
--    (4.26 secs, 471,640,672 bytes)
--    λ> length (pares2 [1..2000] 3)
--    1997
--    (0.02 secs, 0 bytes)
--    λ> length (pares3 [1..2000] 3)
--    1997
--    (0.01 secs, 0 bytes)
--    
--    λ> length (pares2 [1..10^6] 3)
--    999997
--    (6.00 secs, 855,807,112 bytes)
--    λ> length (pares3 [1..10^6] 3)
--    999997
--    (3.67 secs, 390,934,904 bytes)

import Data.List (sort, tails)

import Data.Set

-- 1ª definición

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

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

pares1 xs k =

[(x,y) | x <- xs, y <- xs, y - x == k]

-- 2ª definición

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

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

pares2 xs k =

[(y,y+k) | (y:ys) <- init (tails (sort xs))

, (y+k) `pertenece` ys]

pertenece :: Int -> [Int] -> Bool

pertenece _ [] = False

pertenece x (y:ys) | x < y = False

| x == y = True

| otherwise = pertenece x ys

-- 3ª definición

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

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

pares3 xs k =

[(x,x+k) | x <- xs

, (x+k) `member` c]

where c = fromList xs

-- Comparación de eficiencia

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

-- λ> length (pares1 [1..2000] 3)

-- 1997

-- (4.26 secs, 471,640,672 bytes)

-- λ> length (pares2 [1..2000] 3)

-- 1997

-- (0.02 secs, 0 bytes)

-- λ> length (pares3 [1..2000] 3)

-- 1997

-- (0.01 secs, 0 bytes)

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

-- 999997

-- (6.00 secs, 855,807,112 bytes)

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

-- 999997

-- (3.67 secs, 390,934,904 bytes)

Problema de las 3 jarras

PorJosé A. Alonso 28-abril-201725-abril-2021

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)

Suma de árboles por niveles

PorJosé A. Alonso 27-abril-201711-mayo-2017

Los árboles binarios con valores enteros se pueden representar con el de tipo de dato algebraico

   data Arbol = H
              | N a Arbol Arbol

1 2	data Arbol = H \| N a Arbol Arbol

Por ejemplo, los árboles

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

3 7

/ \ / \

2 4 5 8

/ \ \ / \ \

1 3 5 6 4 10

/ /

9 1

se representan por

   ej1, ej2 :: Arbol 
   ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
   ej2 = N 7 (N 5 (N 6 H H) (N 4 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

ej1, ej2 :: Arbol

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

Definir la función

   suma :: Arbol -> Int

1	suma :: Arbol -> Int

tal que (suma a) es la suma de todos los nodos a una distancia par de la raíz del árbol a menos la suma de todos los nodos a una distancia impar de la raíz. Por ejemplo,

   suma ej1  ==  6
   suma ej2  ==  4

1 2	suma ej1 == 6 suma ej2 == 4

ya que

    (3 + 1+3+5) - (2+4)        = 6
    (7 + 6+4+10) - (5+8 + 9+1) = 4

1 2	(3 + 1+3+5) - (2+4) = 6 (7 + 6+4+10) - (5+8 + 9+1) = 4

Soluciones

data Arbol = H
           | N Int Arbol Arbol

ej1, ej2 :: Arbol 
ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))
ej2 = N 7 (N 5 (N 6 H H) (N 4 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

suma :: Arbol -> Int
suma H         = 0
suma (N x i d) = x - suma i - suma d

data Arbol = H

| N Int Arbol Arbol

ej1, ej2 :: Arbol

ej1 = N 3 (N 2 (N 1 H H) (N 3 H H)) (N 4 H (N 5 H H))

ej2 = N 7 (N 5 (N 6 H H) (N 4 (N 9 H H) H)) (N 8 H (N 10 (N 1 H H) H))

suma :: Arbol -> Int

suma H = 0

suma (N x i d) = x - suma i - suma d

Normalización de expresiones aritméticas

PorJosé A. Alonso 26-abril-201710-mayo-2017

El siguiente tipo de dato representa expresiones construidas con variables, sumas y productos

   data Expr = Var String
             | S Expr Expr
             | P Expr Expre
             deriving (Eq, Show)

data Expr = Var String

| S Expr Expr

| P Expr Expre

deriving (Eq, Show)

Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z")))

Una expresión es un término si es un producto de variables. Por ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.

Una expresión está en forma normal si es una suma de términos. Por ejemplo, x*(y*z) y x+(y*z) están en forma normal; pero x*(y+z) y (x+y)*(x+z) no lo están.

Definir la función

   esTermino :: Expr -> Bool
   esTermino :: Expr -> Bool
   normal    :: Expr -> Expr

esTermino :: Expr -> Bool

normal :: Expr -> Expr

tales que

(esTermino a) se verifica si a es un término. Por ejemplo,

     esTermino (V "x")                         == True
     esTermino (P (V "x") (P (V "y") (V "z"))) == True
     esTermino (P (V "x") (S (V "y") (V "z"))) == False
     esTermino (S (V "x") (P (V "y") (V "z"))) == False

esTermino (V "x") == True

esTermino (P (V "x") (P (V "y") (V "z"))) == True

esTermino (P (V "x") (S (V "y") (V "z"))) == False

esTermino (S (V "x") (P (V "y") (V "z"))) == False

(esNormal a) se verifica si a está en forma normal. Por ejemplo,

     esNormal (V "x")                                     == True
     esNormal (P (V "x") (P (V "y") (V "z")))             == True
     esNormal (S (V "x") (P (V "y") (V "z")))             == True
     esNormal (P (V "x") (S (V "y") (V "z")))             == False
     esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False
     esNormal (S (P (V "x") (V "y")) (S (V "z") (V "x"))) == True

esNormal (V "x") == True

esNormal (P (V "x") (P (V "y") (V "z"))) == True

esNormal (S (V "x") (P (V "y") (V "z"))) == True

esNormal (P (V "x") (S (V "y") (V "z"))) == False

esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

esNormal (S (P (V "x") (V "y")) (S (V "z") (V "x"))) == True

(normal e) es la forma normal de la expresión e obtenida aplicando, mientras que sea posible, las propiedades distributivas:

     (a+b)*c = a*c+b*c
     c*(a+b) = c*a+c*b

1 2	(a+b)c = ac+bc c(a+b) = ca+cb

Por ejemplo,

     λ> normal (P (S (V "x") (V "y")) (V "z"))
     S (P (V "x") (V "z")) (P (V "y") (V "z"))
     λ> normal (P (V "z") (S (V "x") (V "y")))
     S (P (V "z") (V "x")) (P (V "z") (V "y"))
     λ> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))
     S (S (P (V "x") (V "u")) (P (V "x") (V "v"))) 
       (S (P (V "y") (V "u")) (P (V "y") (V "v")))
     λ> normal (S (P (V "x") (V "y")) (V "z"))
     S (P (V "x") (V "y")) (V "z")
     λ> normal (V "x")
     V "x"

λ> normal (P (S (V "x") (V "y")) (V "z"))

S (P (V "x") (V "z")) (P (V "y") (V "z"))

λ> normal (P (V "z") (S (V "x") (V "y")))

S (P (V "z") (V "x")) (P (V "z") (V "y"))

λ> normal (P (S (V "x") (V "y")) (S (V "u") (V "v")))

S (S (P (V "x") (V "u")) (P (V "x") (V "v")))

(S (P (V "y") (V "u")) (P (V "y") (V "v")))

λ> normal (S (P (V "x") (V "y")) (V "z"))

S (P (V "x") (V "y")) (V "z")

λ> normal (V "x")

V "x"

Comprobar con QuickCheck que para cualquier expresión e, (normal e) está en forma normal y que (normal (normal e)) es igual a (normal e).

Nota. Para la comprobación se usará el siguiente generador de expresiones aritméticas

   import Test.QuickCheck
   import Control.Monad
   
   instance Arbitrary Expr where
     arbitrary = sized arb 
       where
         arb 0         = liftM V arbitrary
         arb n | n > 0 = oneof [liftM V arbitrary,
                                liftM2 S sub sub, 
                                liftM2 P sub sub] 
           where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

instance Arbitrary Expr where

arbitrary = sized arb

where

arb 0 = liftM V arbitrary

arb n | n > 0 = oneof [liftM V arbitrary,

liftM2 S sub sub,

liftM2 P sub sub]

where sub = arb (n `div` 2)

Soluciones

import Test.QuickCheck
import Control.Monad

data Expr = V String
          | S Expr Expr
          | P Expr Expr
          deriving (Eq, Show)

esTermino :: Expr -> Bool
esTermino (V _)   = True
esTermino (S _ _) = False
esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool
esNormal (S a b) = esNormal a && esNormal b
esNormal a       = esTermino a

normal :: Expr -> Expr
normal (V v)   = V v
normal (S a b) = S (normal a) (normal b)
normal (P a b) = p (normal a) (normal b)
  where p (S a b) c = S (p a c) (p b c)
        p a (S b c) = S (p a b) (p a c)
        p a b       = P a b

prop_normal :: Expr -> Bool
prop_normal e = 
     esNormal (normal e)
  && normal (normal e) == normal e

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

instance Arbitrary Expr where
  arbitrary = sized arb 
    where
      arb 0         = liftM V arbitrary
      arb n | n > 0 = oneof [liftM V arbitrary,
                             liftM2 S sub sub, 
                             liftM2 P sub sub] 
        where sub = arb (n `div` 2)

import Test.QuickCheck

import Control.Monad

data Expr = V String

| S Expr Expr

| P Expr Expr

deriving (Eq, Show)

esTermino :: Expr -> Bool

esTermino (V _) = True

esTermino (S _ _) = False

esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool

esNormal (S a b) = esNormal a && esNormal b

esNormal a = esTermino a

normal :: Expr -> Expr

normal (V v) = V v

normal (S a b) = S (normal a) (normal b)

normal (P a b) = p (normal a) (normal b)

where p (S a b) c = S (p a c) (p b c)

p a (S b c) = S (p a b) (p a c)

p a b = P a b

prop_normal :: Expr -> Bool

prop_normal e =

esNormal (normal e)

&& normal (normal e) == normal e

-- La comprobación es

-- λ> quickCheck prop_normal

-- +++ OK, passed 100 tests.

instance Arbitrary Expr where

arbitrary = sized arb

where

arb 0 = liftM V arbitrary

arb n | n > 0 = oneof [liftM V arbitrary,

liftM2 S sub sub,

liftM2 P sub sub]

where sub = arb (n `div` 2)

Recorrido en ZigZag

PorJosé A. Alonso 25-abril-201725-abril-2021

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

Sucesión de Recamán

PorJosé A. Alonso 24-abril-201726-marzo-2022

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

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

a(0) = 0

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

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

Definir las funciones

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

sucRecaman :: [Int]

invRecaman :: Int -> Int

graficaSucRecaman :: Int -> IO ()

graficaInvRecaman :: Int -> IO ()

tales que

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

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

λ> take 25 sucRecaman3

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

λ> sucRecaman !! 1000

3686

λ> sucRecaman !! 1000001

1057163

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

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

invRecaman 10 == 12

invRecaman 3686 == 1000

invRecaman 1057163 == 1000001

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

y (graficaInvRecaman 100) dibuja

Soluciones

import qualified Data.Set as S

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

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

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

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

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

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

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

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

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

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

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

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

import qualified Data.Set as S

-- 1ª solución

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

sucRecaman1 :: [Int]

sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int

suc1 0 = 0

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

| otherwise = y + n

where y = suc1 (n - 1)

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

-- 2ª solución

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

sucRecaman2 :: [Int]

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

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

| otherwise = y + n

-- 3ª solución

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

sucRecaman3 :: [Int]

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

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

recaman s n x

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

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

| otherwise =

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

-- Comparación de eficiencia:

-- λ> sucRecaman1 !! 25

-- 17

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

-- λ> sucRecaman2 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman3 !! 25

-- 17

-- (0.00 secs, 0 bytes)

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

-- 14358

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

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

-- 14358

-- (0.04 secs, 0 bytes)

-- Definición de invRecaman

invRecaman :: Int -> Int

invRecaman n =

length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()

graficaSucRecaman n =

plotList [Key Nothing]

(take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()

graficaInvRecaman n =

plotList [Key Nothing]

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

Operaciones con series de potencias

PorJosé A. Alonso 21-abril-201725-marzo-2022

Una serie de potencias es una serie de la forma

   a₀ + a₁x + a₂x² + a₃x³ + ...

1	a₀ + a₁x + a₂x² + a₃x³ + ...

Las series de potencias se pueden representar mediante listas infinitas. Por ejemplo, la serie de la función exponencial es

   e^x = 1 + x + x²/2! + x³/3! + ...

1	e^x = 1 + x + x²/2! + x³/3! + ...

y se puede representar por [1, 1, 1/2, 1/6, 1/24, 1/120, …]

Las operaciones con series se pueden ver como una generalización de las de los polinomios.

En lo que sigue, usaremos el tipo (Serie a) para representar las series de potencias con coeficientes en a y su definición es

   type Serie a = [a]

1	type Serie a = [a]

Definir las siguientes funciones

   opuesta      :: Num a => Serie a -> Serie a
   suma         :: Num a => Serie a -> Serie a -> Serie a
   resta        :: Num a => Serie a -> Serie a -> Serie a
   producto     :: Num a => Serie a -> Serie a -> Serie a
   cociente     :: Fractional a => Serie a -> Serie a -> Serie a
   derivada     :: (Num a, Enum a) => Serie a -> Serie a
   integral     :: (Fractional a, Enum a) => Serie a -> Serie a
   expx         :: Serie Rational

opuesta :: Num a => Serie a -> Serie a

suma :: Num a => Serie a -> Serie a -> Serie a

resta :: Num a => Serie a -> Serie a -> Serie a

producto :: Num a => Serie a -> Serie a -> Serie a

cociente :: Fractional a => Serie a -> Serie a -> Serie a

derivada :: (Num a, Enum a) => Serie a -> Serie a

integral :: (Fractional a, Enum a) => Serie a -> Serie a

expx :: Serie Rational

tales que

(opuesta xs) es la opuesta de la serie xs. Por ejemplo,

     λ> take 7 (opuesta [-6,-4..])
     [6,4,2,0,-2,-4,-6]

1 2	λ> take 7 (opuesta [-6,-4..]) [6,4,2,0,-2,-4,-6]

(suma xs ys) es la suma de las series xs e ys. Por ejemplo,

     λ> take 7 (suma [1,3..] [2,4..])
     [3,7,11,15,19,23,27]

1 2	λ> take 7 (suma [1,3..] [2,4..]) [3,7,11,15,19,23,27]

(resta xs ys) es la resta de las series xs es ys. Por ejemplo,

     λ> take 7 (resta [3,5..] [2,4..])
     [1,1,1,1,1,1,1]
     λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])
     [2,4,6,8,10,12,14]

λ> take 7 (resta [3,5..] [2,4..])

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

λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])

[2,4,6,8,10,12,14]

(producto xs ys) es el producto de las series xs e ys. Por ejemplo,

     λ> take 7 (producto [3,5..] [2,4..])
     [6,22,52,100,170,266,392]

1 2	λ> take 7 (producto [3,5..] [2,4..]) [6,22,52,100,170,266,392]

(cociente xs ys) es el cociente de las series xs e ys. Por ejemplo,

     λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..])
     [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..]) [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

(derivada xs) es la derivada de la serie xs. Por ejemplo,

     λ> take 7 (derivada [2,4..])
     [4,12,24,40,60,84,112]

1 2	λ> take 7 (derivada [2,4..]) [4,12,24,40,60,84,112]

(integral xs) es la integral de la serie xs. Por ejemplo,

     λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0))
     [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0)) [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

expx es la serie de la función exponencial. Por ejemplo,

     λ> take 8 expx
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (derivada expx)
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (integral expx)
     [0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 expx

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (derivada expx)

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (integral expx)

[0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

Soluciones

type Serie a = [a] 

opuesta :: Num a => Serie a -> Serie a
opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a
suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a
resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a
producto (x:xs) zs@(y:ys) = 
    x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a
cociente (x:xs) (y:ys) = zs 
    where zs = x/y : map (/y) (resta xs (producto zs ys))  

derivada :: (Num a, Enum a) => Serie a -> Serie a
derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a
integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational
expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    take 7 factoriales  ==  [1,1,2,6,24,120,720]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

type Serie a = [a]

opuesta :: Num a => Serie a -> Serie a

opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a

suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a

resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a

producto (x:xs) zs@(y:ys) =

x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a

cociente (x:xs) (y:ys) = zs

where zs = x/y : map (/y) (resta xs (producto zs ys))

derivada :: (Num a, Enum a) => Serie a -> Serie a

derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a

integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational

expx = map (1/) (map fromIntegral factoriales)

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

-- take 7 factoriales == [1,1,2,6,24,120,720]

factoriales :: [Integer]

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

Operaciones con polinomios como diccionarios

PorJosé A. Alonso 20-abril-201725-abril-2021

Los polinomios se pueden representar mediante diccionarios con los exponentes como claves y los coeficientes como valores.

El tipo de los polinomios con coeficientes de tipo a se define por

   type Polinomio a = M.Map Int a

1	type Polinomio a = M.Map Int a

Dos ejemplos de polinomios (que usaremos en los ejemplos) son

   3 + 7x - 5x^3
   4 + 5x^3 + x^5

1 2	3 + 7x - 5x^3 4 + 5x^3 + x^5

se definen por

  ejPol1, ejPol2 :: Polinomio Int
  ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]
  ejPol2 = M.fromList [(0,4),(3,5),(5,1)]

ejPol1, ejPol2 :: Polinomio Int

ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]

ejPol2 = M.fromList [(0,4),(3,5),(5,1)]

Definir las funciones

   sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
   multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a
   multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a

sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a

multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a

multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a

tales que

(sumaPol p q) es la suma de los polinomios p y q. Por ejemplo,

     ghci> sumaPol ejPol1 ejPol2
     fromList [(0,7),(1,7),(5,1)]
     ghci> sumaPol ejPol1 ejPol1
     fromList [(0,6),(1,14),(3,-10)]

ghci> sumaPol ejPol1 ejPol2

fromList [(0,7),(1,7),(5,1)]

ghci> sumaPol ejPol1 ejPol1

fromList [(0,6),(1,14),(3,-10)]

(multPorTerm (n,a) p) es el producto del término ax^n por p. Por ejemplo,

     ghci> multPorTerm (2,3) (M.fromList [(0,4),(2,1)])
     fromList [(2,12),(4,3)]

1 2	ghci> multPorTerm (2,3) (M.fromList [(0,4),(2,1)]) fromList [(2,12),(4,3)]

(multPol p q) es el producto de los polinomios p y q. Por ejemplo,

     ghci> multPol ejPol1 ejPol2
     fromList [(0,12),(1,28),(3,-5),(4,35),(5,3),(6,-18),(8,-5)]
     ghci> multPol ejPol1 ejPol1
     fromList [(0,9),(1,42),(2,49),(3,-30),(4,-70),(6,25)]
     ghci> multPol ejPol2 ejPol2
     fromList [(0,16),(3,40),(5,8),(6,25),(8,10),(10,1)]

ghci> multPol ejPol1 ejPol2

fromList [(0,12),(1,28),(3,-5),(4,35),(5,3),(6,-18),(8,-5)]

ghci> multPol ejPol1 ejPol1

fromList [(0,9),(1,42),(2,49),(3,-30),(4,-70),(6,25)]

ghci> multPol ejPol2 ejPol2

fromList [(0,16),(3,40),(5,8),(6,25),(8,10),(10,1)]

Soluciones

import qualified Data.Map as M

type Polinomio a = M.Map Int a 

ejPol1, ejPol2 :: Polinomio Int
ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]
ejPol2 = M.fromList [(0,4),(3,5),(5,1)]

sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
sumaPol p q = 
    M.filter (/=0) (M.unionWith (+) p q)

multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a
multPorTerm (n,a) p =
    M.map (*a) (M.mapKeys (+n) p)

multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a
multPol p q
    | M.null p  = M.empty
    | otherwise = sumaPol (multPorTerm t q) (multPol r q)
    where (t,r) = M.deleteFindMin p

import qualified Data.Map as M

type Polinomio a = M.Map Int a

ejPol1, ejPol2 :: Polinomio Int

ejPol1 = M.fromList [(0,3),(1,7),(3,-5)]

ejPol2 = M.fromList [(0,4),(3,5),(5,1)]

sumaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a

sumaPol p q =

M.filter (/=0) (M.unionWith (+) p q)

multPorTerm :: Num a => (Int,a) -> Polinomio a -> Polinomio a

multPorTerm (n,a) p =

M.map (*a) (M.mapKeys (+n) p)

multPol :: (Eq a, Num a) => Polinomio a -> Polinomio a -> Polinomio a

multPol p q

| M.null p = M.empty

| otherwise = sumaPol (multPorTerm t q) (multPol r q)

where (t,r) = M.deleteFindMin p

Números como sumas de primos consecutivos

PorJosé A. Alonso 19-abril-201725-abril-2021

El número 311 se puede escribir de 5 formas distintas como suma de 1 o más primos consecutivos

   311 =  11 +  13 +  17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47
   311 =  31 +  37 +  41 + 43 + 47 + 53 + 59
   311 =  53 +  59 +  61 + 67 + 71
   311 = 101 + 103 + 107
   311 = 311

311 = 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47

311 = 31 + 37 + 41 + 43 + 47 + 53 + 59

311 = 53 + 59 + 61 + 67 + 71

311 = 101 + 103 + 107

311 = 311

el número 41 se puede escribir de 4 formas

   41 =  2 +  3 +  5 + 7 + 11 + 13
   41 = 11 + 13 + 17
   41 = 41

41 = 2 + 3 + 5 + 7 + 11 + 13

41 = 11 + 13 + 17

41 = 41

y el número 14 no se puede escribir como suma de primos consecutivos.

Definir la función

   sumas :: Integer -> [[Integer]]

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

tal que (sumas x) es la lista de las formas de escribir x como suma de uno o más números primos consecutivos. Por ejemplo,

   λ> sumas 311
   [[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],
    [53,59,61,67,71],[101,103,107],[311]]
   λ> sumas 41
   [[2,3,5,7,11,13],[11,13,17],[41]]
   λ> sumas 14
   []
   λ> [length (sumas n) | n <- [0..20]]
   [0,0,1,1,0,2,0,1,1,0,1,1,1,1,0,1,0,2,1,1,0]
   λ> maximum [length (sumas n) | n <- [1..600]]
   5

λ> sumas 311

[[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],

[53,59,61,67,71],[101,103,107],[311]]

λ> sumas 41

[[2,3,5,7,11,13],[11,13,17],[41]]

λ> sumas 14

[]

λ> [length (sumas n) | n <- [0..20]]

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

λ> maximum [length (sumas n) | n <- [1..600]]

Soluciones

import Data.Numbers.Primes (primes)
import Data.List (span)

sumas :: Integer -> [[Integer]]
sumas x = [ys | n <- takeWhile (<= x) primes, 
                let ys = sumaDesde x n,
                not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos
-- consecutivos a partir del número primo n cuya suma es x, si existen y
-- la lista vacía en caso contrario. Por ejemplo,
--    sumaDesde 15 3  ==  [3,5,7]
--    sumaDesde  7 3  ==  []
sumaDesde :: Integer -> Integer -> [Integer]
sumaDesde x n | x == y    = take (1 + length us) ys
              | otherwise = []
    where ys       = dropWhile (<n) primes
          (us,y:_) = span (<x) (scanl1 (+) ys)

import Data.Numbers.Primes (primes)

import Data.List (span)

sumas :: Integer -> [[Integer]]

sumas x = [ys | n <- takeWhile (<= x) primes,

let ys = sumaDesde x n,

not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos

-- consecutivos a partir del número primo n cuya suma es x, si existen y

-- la lista vacía en caso contrario. Por ejemplo,

-- sumaDesde 15 3 == [3,5,7]

-- sumaDesde 7 3 == []

sumaDesde :: Integer -> Integer -> [Integer]

sumaDesde x n | x == y = take (1 + length us) ys

| otherwise = []

where ys = dropWhile (<n) primes

(us,y:_) = span (<x) (scanl1 (+) ys)

Subnúmeros pares

PorJosé A. Alonso 18-abril-201725-abril-2017

Los subnúmeros de un número x son los números que se pueden formar con dígitos de x en posiciones consecutivas. Por ejemplo, el número 254 tiene 6 subnúmeros: 2, 5, 4, 25, 54 y 254.

Definir las funciones

   subnumeros       :: Integer -> [Integer]
   nSubnumerosPares :: Integer -> Integer

1 2	subnumeros :: Integer -> [Integer] nSubnumerosPares :: Integer -> Integer

tales que

(subnumerosPares x) es la lista de los subnúmeros pares de x. Por ejemplo,

     subnumerosPares 254   ==  [2,254,54,4]
     subnumerosPares 154   ==  [154,54,4]
     subnumerosPares 15    ==  []

subnumerosPares 254 == [2,254,54,4]

subnumerosPares 154 == [154,54,4]

subnumerosPares 15 == []

(nSubnumerosPares x) es la cantidad de subnúmeros pares de x. Por ejemplo,

     nSubnumerosPares 254   ==  4
     nSubnumerosPares2 (4^(10^6))  ==  90625258498

1 2	nSubnumerosPares 254 == 4 nSubnumerosPares2 (4^(10^6)) == 90625258498

Soluciones

import Data.List ( genericLength
                 , inits
                 , tails
                 )

subnumerosPares :: Integer -> [Integer]
subnumerosPares n =
  filter even (subnumeros n)

-- (subnumeros n) es la lista de los subnúmeros de n. Por ejemplo,
--    subnumeros 254  ==  [2,25,5,254,54,4]
subnumeros :: Integer -> [Integer]
subnumeros n =
  [read x | x <- sublistas (show n)]

-- (sublistas xs) es la lista de las sublistas de xs. Por ejemplo, 
--    sublistas "abc"  ==  ["a","ab","b","abc","bc","c"]
sublistas :: [a] -> [[a]]
sublistas xs =
  concat [init (tails ys) | ys <- tail (inits xs)]

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

nSubnumerosPares :: Integer -> Integer
nSubnumerosPares =
  genericLength . subnumerosPares

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

nSubnumerosPares2 :: Integer -> Integer
nSubnumerosPares2 =
  sum . posicionesDigitosPares 

-- (posicionesDigitosPares x) es la lista de las posiciones de los
-- dígitos pares de x. Por ejemplo,
--    posicionesDigitosPares 254  ==  [1,3]
posicionesDigitosPares :: Integer -> [Integer]
posicionesDigitosPares x =
  [n | (n,y) <- zip [1..] (show x)
     , y `elem` "02468"]

-- Comparación de eficiencia
--    λ> nSubnumerosPares (2^(10^3))
--    22934
--    (2.83 secs, 3,413,414,872 bytes)
--    λ> nSubnumerosPares2 (2^(10^3))
--    22934
--    (0.01 secs, 0 bytes)

import Data.List ( genericLength

, inits

, tails

)

subnumerosPares :: Integer -> [Integer]

subnumerosPares n =

filter even (subnumeros n)

-- (subnumeros n) es la lista de los subnúmeros de n. Por ejemplo,

-- subnumeros 254 == [2,25,5,254,54,4]

subnumeros :: Integer -> [Integer]

subnumeros n =

[read x | x <- sublistas (show n)]

-- (sublistas xs) es la lista de las sublistas de xs. Por ejemplo,

-- sublistas "abc" == ["a","ab","b","abc","bc","c"]

sublistas :: [a] -> [[a]]

sublistas xs =

concat [init (tails ys) | ys <- tail (inits xs)]

-- 1ª definición

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

nSubnumerosPares :: Integer -> Integer

nSubnumerosPares =

genericLength . subnumerosPares

-- 2ª definición

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

nSubnumerosPares2 :: Integer -> Integer

nSubnumerosPares2 =

sum . posicionesDigitosPares

-- (posicionesDigitosPares x) es la lista de las posiciones de los

-- dígitos pares de x. Por ejemplo,

-- posicionesDigitosPares 254 == [1,3]

posicionesDigitosPares :: Integer -> [Integer]

posicionesDigitosPares x =

[n | (n,y) <- zip [1..] (show x)

, y `elem` "02468"]

-- Comparación de eficiencia

-- λ> nSubnumerosPares (2^(10^3))

-- 22934

-- (2.83 secs, 3,413,414,872 bytes)

-- λ> nSubnumerosPares2 (2^(10^3))

-- 22934

-- (0.01 secs, 0 bytes)

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico