Ejercicio – Página 8

Árbol de subconjuntos

PorJosé A. Alonso 30-marzo-20187-abril-2018

Definir las siguientes funciones

   arbolSubconjuntos       :: [a] -> Tree [a]
   nNodosArbolSubconjuntos :: Integer -> Integer
   sumaNNodos              :: Integer -> Integer

arbolSubconjuntos :: [a] -> Tree [a]

nNodosArbolSubconjuntos :: Integer -> Integer

sumaNNodos :: Integer -> Integer

tales que

(arbolSubconjuntos xs) es el árbol de los subconjuntos de xs. Por ejemplo.

     λ> putStrLn (drawTree (arbolSubconjuntos "abc"))
     abc
     |
     +- bc
     |  |
     |  +- c
     |  |
     |  `- b
     |
     +- ac
     |  |
     |  +- c
     |  |
     |  `- a
     |
     `- ab
        |
        +- b
        |
        `- a

λ> putStrLn (drawTree (arbolSubconjuntos "abc"))

abc

+- bc

| |

| +- c

| |

| `- b

+- ac

| |

| +- c

| |

| `- a

`- ab

+- b

`- a

(nNodosArbolSubconjuntos xs) es el número de nodos del árbol de xs. Por ejemplo

     nNodosArbolSubconjuntos "abc"  ==  10
     nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960

1 2	nNodosArbolSubconjuntos "abc" == 10 nNodosArbolSubconjuntos [1..4*10^4] `mod` (7+10^9) == 546503960

(sumaNNodos n) es la suma del número de nodos de los árboles de los subconjuntos de [1..k] para 1 <= k <= n. Por ejemplo,

     λ> sumaNNodos 3  ==  14
     sumaNNodos (4*10^4) `mod` (7+10^9)  ==  249479844

1 2	λ> sumaNNodos 3 == 14 sumaNNodos (4*10^4) `mod` (7+10^9) == 249479844

Soluciones

import Data.List (genericLength, genericTake)
import Data.Tree (Tree (Node))

-- Definición de arbolSubconjuntos
-- ===============================

arbolSubconjuntos :: [a] -> Tree [a]
arbolSubconjuntos [x] = Node [x] []
arbolSubconjuntos xs =
  Node xs (map arbolSubconjuntos (sinUno xs))

-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por
-- ejemplo, 
--    sinUno "abcde"  ==  ["bcde","acde","abde","abce","abcd"]
sinUno :: [a] -> [[a]]
sinUno xs =
  [ys ++ zs | n <- [0..length xs - 1]
            , let (ys,_:zs) = splitAt n xs]       

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

nNodosArbolSubconjuntos :: [a] -> Integer
nNodosArbolSubconjuntos =
  fromIntegral . length . arbolSubconjuntos 

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

nNodosArbolSubconjuntos2 :: [a] -> Integer
nNodosArbolSubconjuntos2 = aux . genericLength
  where aux 1 = 1
        aux n = 1 + n * aux (n-1)

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

nNodosArbolSubconjuntos3 :: [a] -> Integer
nNodosArbolSubconjuntos3 xs =
  sucNNodos !! (n-1)
  where n = length xs

-- sucNNodos es la sucesión de los números de nodos de los árboles de
-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.
--    λ> take 10 sucNNodos
--    [1,3,10,41,206,1237,8660,69281,623530,6235301]
sucNNodos :: [Integer]
sucNNodos =
  1 : map (+ 1) (zipWith (*) [2..] sucNNodos)

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

--    λ> nNodosArbolSubconjuntos 10
--    6235301
--    (9.66 secs, 5,491,704,944 bytes)
--    λ> nNodosArbolSubconjuntos2 10
--    6235301
--    (0.00 secs, 145,976 bytes)
--
--    λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))
--    166714
--    (1.07 secs, 2,952,675,472 bytes)
--    λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))
--    166714
--    (1.53 secs, 2,959,020,680 bytes)

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

sumaNNodos :: Integer -> Integer
sumaNNodos n =
  sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]

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

sumaNNodos2 :: Integer -> Integer
sumaNNodos2 n =
  sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]

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

sumaNNodos3 :: Integer -> Integer
sumaNNodos3 n =
  sum (genericTake n sucNNodos)

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

--    λ> sumaNNodos 10 `mod` (7+10^9)
--    6938270
--    (16.00 secs, 9,552,410,688 bytes)
--    λ> sumaNNodos2 10 `mod` (7+10^9)
--    6938270
--    (0.00 secs, 177,632 bytes)
-- 
--    λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)
--    851467820
--    (2.62 secs, 4,622,117,976 bytes)
--    λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)
--    851467820
--    (0.01 secs, 8,645,336 bytes)

100

101

102

103

104

import Data.List (genericLength, genericTake)

import Data.Tree (Tree (Node))

-- Definición de arbolSubconjuntos

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

arbolSubconjuntos :: [a] -> Tree [a]

arbolSubconjuntos [x] = Node [x] []

arbolSubconjuntos xs =

Node xs (map arbolSubconjuntos (sinUno xs))

-- (sinUno xs) es la lista obtenidas eliminando un elemento de xs. Por

-- ejemplo,

-- sinUno "abcde" == ["bcde","acde","abde","abce","abcd"]

sinUno :: [a] -> [[a]]

sinUno xs =

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

, let (ys,_:zs) = splitAt n xs]

-- 1ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos :: [a] -> Integer

nNodosArbolSubconjuntos =

fromIntegral . length . arbolSubconjuntos

-- 2ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos2 :: [a] -> Integer

nNodosArbolSubconjuntos2 = aux . genericLength

where aux 1 = 1

aux n = 1 + n * aux (n-1)

-- 3ª definición de nNodosArbolSubconjuntos

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

nNodosArbolSubconjuntos3 :: [a] -> Integer

nNodosArbolSubconjuntos3 xs =

sucNNodos !! (n-1)

where n = length xs

-- sucNNodos es la sucesión de los números de nodos de los árboles de

-- los subconjuntos con 1, 2, ... elementos. Por ejemplo.

-- λ> take 10 sucNNodos

-- [1,3,10,41,206,1237,8660,69281,623530,6235301]

sucNNodos :: [Integer]

sucNNodos =

1 : map (+ 1) (zipWith (*) [2..] sucNNodos)

-- Comparación de eficiencia de nNodosArbolSubconjuntos

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

-- λ> nNodosArbolSubconjuntos 10

-- 6235301

-- (9.66 secs, 5,491,704,944 bytes)

-- λ> nNodosArbolSubconjuntos2 10

-- 6235301

-- (0.00 secs, 145,976 bytes)

-- λ> length (show (nNodosArbolSubconjuntos2 (4*10^4)))

-- 166714

-- (1.07 secs, 2,952,675,472 bytes)

-- λ> length (show (nNodosArbolSubconjuntos3 (4*10^4)))

-- 166714

-- (1.53 secs, 2,959,020,680 bytes)

-- 1ª definición de sumaNNodos

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

sumaNNodos :: Integer -> Integer

sumaNNodos n =

sum [nNodosArbolSubconjuntos [1..k] | k <- [1..n]]

-- 2ª definición de sumaNNodos

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

sumaNNodos2 :: Integer -> Integer

sumaNNodos2 n =

sum [nNodosArbolSubconjuntos2 [1..k] | k <- [1..n]]

-- 3ª definición de sumaNNodos

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

sumaNNodos3 :: Integer -> Integer

sumaNNodos3 n =

sum (genericTake n sucNNodos)

-- Comparación de eficiencia de sumaNNodos

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

-- λ> sumaNNodos 10 `mod` (7+10^9)

-- 6938270

-- (16.00 secs, 9,552,410,688 bytes)

-- λ> sumaNNodos2 10 `mod` (7+10^9)

-- 6938270

-- (0.00 secs, 177,632 bytes)

-- λ> sumaNNodos2 (2*10^3) `mod` (7+10^9)

-- 851467820

-- (2.62 secs, 4,622,117,976 bytes)

-- λ> sumaNNodos3 (2*10^3) `mod` (7+10^9)

-- 851467820

-- (0.01 secs, 8,645,336 bytes)

Múltiplos repitunos

PorJosé A. Alonso 26-marzo-201825-marzo-2022

El ejercicio 4 de la Olimpiada Matemáticas de 1993 es el siguiente:

Demostrar que para todo número primo p distinto de 2 y de 5, existen infinitos múltiplos de p de la forma 1111……1 (escrito sólo con unos).

Definir la función

   multiplosRepitunos :: Integer -> Integer -> [Integer]

1	multiplosRepitunos :: Integer -> Integer -> [Integer]

tal que (multiplosRepitunos p n) es la lista de los múltiplos repitunos de p (es decir, de la forma 1111…1 escrito sólo con unos), donde p es un número primo distinto de 2 y 5. Por ejemplo,

   head (multiplosRepitunos  7 10)       == 111111
   head (multiplosRepitunos  7 (10^10))  == 111111111111
   head (multiplosRepitunos  7 (10^20))  == 111111111111111111111111
   head (multiplosRepitunos 19 (10^10))  == 111111111111111111

head (multiplosRepitunos 7 10) == 111111

head (multiplosRepitunos 7 (10^10)) == 111111111111

head (multiplosRepitunos 7 (10^20)) == 111111111111111111111111

head (multiplosRepitunos 19 (10^10)) == 111111111111111111

Comprobar con QuickCheck que para todo primo p mayor que 5 y todo número entero positivo n, existe un mútiplo repituno de p mayor que n.

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

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

multiplosRepitunos :: Integer -> Integer -> [Integer]
multiplosRepitunos p n =
  [x | x <- dropWhile (<= n) repitunos
     , mod x p == 0]

-- repitunos es la lista de los números de la forma 111...1 (escrito sólo con
-- unos). Por ejemplo,
--    take 5 repitunos  ==  [1,11,111,1111,11111]
repitunos :: [Integer]
repitunos = 1 : [10*x+1 | x <- repitunos]

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

multiplosRepitunos2 :: Integer -> Integer -> [Integer]
multiplosRepitunos2 p n =
  [x | x <- dropWhile (<= n) repitunos2
     , mod x p == 0]

repitunos2 :: [Integer]
repitunos2 = [div (10^n-1) 9 | n <- [1..]]

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

-- La propiedad es
prop_multiplosRepitunos :: Int -> Integer -> Property
prop_multiplosRepitunos k n =
  k > 2 && n > 0 ==>
  not (null (multiplosRepitunos (primes !! k) n))

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

import Data.Numbers.Primes

import Test.QuickCheck

-- 1ª solución

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

multiplosRepitunos :: Integer -> Integer -> [Integer]

multiplosRepitunos p n =

[x | x <- dropWhile (<= n) repitunos

, mod x p == 0]

-- repitunos es la lista de los números de la forma 111...1 (escrito sólo con

-- unos). Por ejemplo,

-- take 5 repitunos == [1,11,111,1111,11111]

repitunos :: [Integer]

repitunos = 1 : [10*x+1 | x <- repitunos]

-- 2ª solución

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

multiplosRepitunos2 :: Integer -> Integer -> [Integer]

multiplosRepitunos2 p n =

[x | x <- dropWhile (<= n) repitunos2

, mod x p == 0]

repitunos2 :: [Integer]

repitunos2 = [div (10^n-1) 9 | n <- [1..]]

-- Comprobación

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

-- La propiedad es

prop_multiplosRepitunos :: Int -> Integer -> Property

prop_multiplosRepitunos k n =

k > 2 && n > 0 ==>

not (null (multiplosRepitunos (primes !! k) n))

-- La comprobación es

-- λ> quickCheck prop_multiplosRepitunos

-- +++ OK, passed 100 tests.

Máxima longitud de sublistas crecientes

PorJosé A. Alonso 23-marzo-201825-abril-2021

Definir la función

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

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

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

   λ> longitudMayorSublistaCreciente [3,2,6,4,5,1]
   3
   λ> longitudMayorSublistaCreciente [10,22,9,33,21,50,41,60,80]
   6
   λ> longitudMayorSublistaCreciente [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
   6
   λ> longitudMayorSublistaCreciente [1..2000]
   2000
   λ> longitudMayorSublistaCreciente [2000,1999..1]
   1
   λ> import System.Random
   λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
   λ> longitudMayorSublistaCreciente xs
   61

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

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

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

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

λ> import System.Random

λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

λ> longitudMayorSublistaCreciente xs

Soluciones

import Data.List  (nub, sort)
import Data.Array (Array, (!), array, elems, listArray)

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

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

-- (mayoresCrecientes xs) es la lista de las sublistas crecientes de xs
-- de mayor longitud. Por ejemplo, 
--    λ> mayoresCrecientes [3,2,6,4,5,1]
--    [[3,4,5],[2,4,5]]
--    λ> mayoresCrecientes [3,2,3,2,3,1]
--    [[2,3],[2,3],[2,3]]
--    λ> mayoresCrecientes [10,22,9,33,21,50,41,60,80]
--    [[10,22,33,50,60,80],[10,22,33,41,60,80]]
--    λ> mayoresCrecientes [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
--    [[0,4,6,9,13,15],[0,2,6,9,13,15],[0,4,6,9,11,15],[0,2,6,9,11,15]]
mayoresCrecientes :: Ord a => [a] -> [[a]]
mayoresCrecientes xs =
  [ys | ys <- xss
      , length ys == m]
  where xss = sublistasCrecientes xs
        m   = maximum (map length xss)

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

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

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

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

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

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

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

--    λ> longitudMayorSublistaCreciente1 [1..20]
--    20
--    (4.60 secs, 597,014,240 bytes)
--    λ> longitudMayorSublistaCreciente2 [1..20]
--    20
--    (0.03 secs, 361,384 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..20]
--    20
--    (0.03 secs, 253,944 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 [1..2000]
--    2000
--    (8.00 secs, 1,796,495,488 bytes)
--    λ> longitudMayorSublistaCreciente3 [1..2000]
--    2000
--    (5.12 secs, 1,137,667,496 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 [1000,999..1]
--    1
--    (0.95 secs, 97,029,328 bytes)
--    λ> longitudMayorSublistaCreciente2 [1000,999..1]
--    1
--    (7.48 secs, 1,540,857,208 bytes)
--    λ> longitudMayorSublistaCreciente3 [1000,999..1]
--    1
--    (0.86 secs, 160,859,128 bytes)
--    
--    λ> longitudMayorSublistaCreciente1 (show (2^300))
--    10
--    (7.90 secs, 887,495,368 bytes)
--    λ> longitudMayorSublistaCreciente2 (show (2^300))
--    10
--    (0.04 secs, 899,152 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^300))
--    10
--    (0.04 secs, 1,907,936 bytes)
--    
--    λ> longitudMayorSublistaCreciente2 (show (2^6000))
--    10
--    (0.06 secs, 9,950,592 bytes)
--    λ> longitudMayorSublistaCreciente3 (show (2^6000))
--    10
--    (3.46 secs, 686,929,744 bytes)
--    
--    λ> import System.Random
--    (0.00 secs, 0 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.02 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    61
--    (7.73 secs, 1,538,771,392 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    61
--    (1.04 secs, 212,538,648 bytes)
--    λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]
--    (0.03 secs, 1,993,032 bytes)
--    λ> longitudMayorSublistaCreciente2 xs
--    57
--    (7.56 secs, 1,538,573,680 bytes)
--    λ> longitudMayorSublistaCreciente3 xs
--    57
--    (1.05 secs, 212,293,984 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

import Data.List (nub, sort)

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

-- 1ª solución

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

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

longitudMayorSublistaCreciente1 =

length . head . mayoresCrecientes

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

-- de mayor longitud. Por ejemplo,

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

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

-- λ> mayoresCrecientes [3,2,3,2,3,1]

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

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

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

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

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

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

mayoresCrecientes xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

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

-- xs. Por ejemplo,

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

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

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

sublistasCrecientes [] = [[]]

sublistasCrecientes (x:xs) =

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

where yss = sublistasCrecientes xs

-- 2ª solución

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

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

longitudMayorSublistaCreciente2 xs =

longitudSCM xs (sort (nub xs))

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

-- ys. Por ejemplo,

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

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

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

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

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

where n = length xs

m = length ys

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

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

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

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

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

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

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

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

-- Gráficamente,

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

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

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

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

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

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

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

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

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

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

matrizLongitudSCM xs ys = q

where

n = length xs

m = length ys

v = listArray (1,n) xs

w = listArray (1,m) ys

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

where f 0 _ = 0

f _ 0 = 0

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

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

-- 3ª solución

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

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

longitudMayorSublistaCreciente3 xs =

maximum (elems (vectorlongitudMayorSublistaCreciente xs))

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

-- (donde n es el tamaño de xs) tal que el valor i-ésimo es la longitud

-- de la sucesión más larga que termina en el elemento i-ésimo de

-- xs. Por ejemplo,

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

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

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

vectorlongitudMayorSublistaCreciente xs = v

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

n = length xs

w = listArray (1,n) xs

f 1 = 1

f i | null ls = 1

| otherwise = 1 + maximum ls

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

-- Comparación de eficiencia

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

-- λ> longitudMayorSublistaCreciente1 [1..20]

-- 20

-- (4.60 secs, 597,014,240 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..20]

-- 20

-- (0.03 secs, 361,384 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..20]

-- 20

-- (0.03 secs, 253,944 bytes)

-- λ> longitudMayorSublistaCreciente2 [1..2000]

-- 2000

-- (8.00 secs, 1,796,495,488 bytes)

-- λ> longitudMayorSublistaCreciente3 [1..2000]

-- 2000

-- (5.12 secs, 1,137,667,496 bytes)

-- λ> longitudMayorSublistaCreciente1 [1000,999..1]

-- 1

-- (0.95 secs, 97,029,328 bytes)

-- λ> longitudMayorSublistaCreciente2 [1000,999..1]

-- 1

-- (7.48 secs, 1,540,857,208 bytes)

-- λ> longitudMayorSublistaCreciente3 [1000,999..1]

-- 1

-- (0.86 secs, 160,859,128 bytes)

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

-- 10

-- (7.90 secs, 887,495,368 bytes)

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

-- 10

-- (0.04 secs, 899,152 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^300))

-- 10

-- (0.04 secs, 1,907,936 bytes)

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

-- 10

-- (0.06 secs, 9,950,592 bytes)

-- λ> longitudMayorSublistaCreciente3 (show (2^6000))

-- 10

-- (3.46 secs, 686,929,744 bytes)

-- λ> import System.Random

-- (0.00 secs, 0 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.02 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 61

-- (7.73 secs, 1,538,771,392 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 61

-- (1.04 secs, 212,538,648 bytes)

-- λ> xs <- sequence [randomRIO (0,10^6) | _ <- [1..10^3]]

-- (0.03 secs, 1,993,032 bytes)

-- λ> longitudMayorSublistaCreciente2 xs

-- 57

-- (7.56 secs, 1,538,573,680 bytes)

-- λ> longitudMayorSublistaCreciente3 xs

-- 57

-- (1.05 secs, 212,293,984 bytes)

Mayores sublistas crecientes

PorJosé A. Alonso 22-marzo-201830-marzo-2018

Definir la función

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

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

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

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

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

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

λ> mayoresCrecientes [3,2,3,2,3,1]

[[2,3],[2,3],[2,3]]

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

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

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

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

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

Soluciones

import Data.List (subsequences)

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

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

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

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

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

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

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

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

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

import Data.List (subsequences)

-- 1ª solución

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

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

mayoresCrecientes1 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes xs

m = maximum (map length xss)

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

-- xs. Por ejemplo,

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

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

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

sublistasCrecientes xs =

[ys | ys <- subsequences xs

, esCreciente ys]

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

-- ejemplo,

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

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

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

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

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

esCreciente _ = True

-- 2ª solución

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

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

mayoresCrecientes2 xs =

[ys | ys <- xss

, length ys == m]

where xss = sublistasCrecientes2 xs

m = maximum (map length xss)

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

-- xs. Por ejemplo,

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

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

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

sublistasCrecientes2 [] = [[]]

sublistasCrecientes2 (x:xs) =

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

where yss = sublistasCrecientes2 xs

-- Comparación de eficiencia

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

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

-- 5

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

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

-- 5

-- (0.02 secs, 0 bytes)

Recorrido de árboles en espiral

PorJosé A. Alonso 8-febrero-201825-abril-2021

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

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

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

/ \ 8 3 8 3

2 3 /|\ /|\ |

/ \ / \ 4 5 6 4 5 6 7

4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

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

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

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

Definir la función

   espiral :: Arbol a -> [a]

1	espiral :: Arbol a -> [a]

tal que (espiral x) es la lista de los nodos del árbol x recorridos en espiral; es decir, la raíz de x, los nodos del primer nivel de izquierda a derecha, los nodos del segundo nivel de derecha a izquierda y así sucesivamente. Por ejemplo,

   espiral ej1  ==  [1,2,3,7,6,5,4]
   espiral ej2  ==  [1,8,3,6,5,4]
   espiral ej3  ==  [1,8,3,7,6,5,4]

espiral ej1 == [1,2,3,7,6,5,4]

espiral ej2 == [1,8,3,6,5,4]

espiral ej3 == [1,8,3,7,6,5,4]

Soluciones

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

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

espiral :: Arbol a -> [a]
espiral x =
  concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

-- (niveles x) es la lista de los niveles del árbol x. Por ejemplo, 
--    niveles ej1 == [[1],[8,3],[4]]
--    niveles ej2 == [[1],[8,3],[4,5,6]]
--    niveles ej3 == [[1],[8,3],[4,5,6,7]]
niveles :: Arbol a -> [[a]]
niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,
--    nivel 0 ej1  ==  [1]
--    nivel 1 ej1  ==  [8,3]
--    nivel 2 ej1  ==  [4]
--    nivel 4 ej1  ==  []
nivel :: Int -> Arbol a ->  [a]
nivel 0 (N x _)  = [x]
nivel n (N _ xs) = concatMap (nivel (n-1)) xs

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

espiral2 :: Arbol a -> [a]
espiral2 = 
  concat . zipWith ($) (cycle [reverse,id]) . niveles

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

espiral3 :: Arbol a -> [a]
espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]
niveles3 t = map (map raiz)
           . takeWhile (not . null)
           . iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a
raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]
subBosque (N _ ts) = ts

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

espiral4 :: Arbol a -> [a]
espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]
niveles4 = map (map raiz)
         . takeWhile (not . null)
         . iterate (concatMap subBosque)
         . return  

-- 5ª definición
-- =============

espiral5 :: Arbol a -> [a]
espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]
niveles5 [] = []
niveles5 xs = a : niveles5 (concat b)
  where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición
-- =============

espiral6 :: Arbol a -> [a]
espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2, ej3 :: Arbol Int

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

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

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

-- 1ª solución

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

espiral :: Arbol a -> [a]

espiral x =

concat [f xs | (f,xs) <- zip (cycle [reverse,id]) (niveles x)]

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

-- niveles ej1 == [[1],[8,3],[4]]

-- niveles ej2 == [[1],[8,3],[4,5,6]]

-- niveles ej3 == [[1],[8,3],[4,5,6,7]]

niveles :: Arbol a -> [[a]]

niveles x = takeWhile (not . null) [nivel n x | n <- [0..]]

-- (nivel n x) es el nivel de nivel n del árbol x. Por ejemplo,

-- nivel 0 ej1 == [1]

-- nivel 1 ej1 == [8,3]

-- nivel 2 ej1 == [4]

-- nivel 4 ej1 == []

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

nivel 0 (N x _) = [x]

nivel n (N _ xs) = concatMap (nivel (n-1)) xs

-- 2ª solución

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

espiral2 :: Arbol a -> [a]

espiral2 =

concat . zipWith ($) (cycle [reverse,id]) . niveles

-- 3ª solución

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

espiral3 :: Arbol a -> [a]

espiral3 = concat . zipWith ($) (cycle [reverse,id]) . niveles3

niveles3 :: Arbol a -> [[a]]

niveles3 t = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque) $ [t]

raiz :: Arbol a -> a

raiz (N x _) = x

subBosque :: Arbol a -> [Arbol a]

subBosque (N _ ts) = ts

-- 4ª solución

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

espiral4 :: Arbol a -> [a]

espiral4 = concat . zipWith ($) (cycle [reverse,id]) . niveles4

niveles4 :: Arbol a -> [[a]]

niveles4 = map (map raiz)

. takeWhile (not . null)

. iterate (concatMap subBosque)

. return

-- 5ª definición

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

espiral5 :: Arbol a -> [a]

espiral5 x = concat $ zipWith ($) (cycle [reverse,id]) $ niveles5 [x]

niveles5 :: [Arbol a] -> [[a]]

niveles5 [] = []

niveles5 xs = a : niveles5 (concat b)

where (a,b) = unzip $ map (\(N x y) -> (x,y)) xs

-- 6ª definición

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

espiral6 :: Arbol a -> [a]

espiral6 = concat . zipWith ($) (cycle [reverse,id]) . niveles5 . return

Ancestro común más bajo

PorJosé A. Alonso 9-junio-201725-abril-2021

El tipo de los árboles binarios se define por

   data Arbol = H Int
              | N Int Arbol Arbol

1 2	data Arbol = H Int \| N Int Arbol Arbol

Por ejemplo, el árbol

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

/ \

3 7

/ \ / \

1 4 6 9

se define por

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

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

Un árbol ordenado es un árbol binario tal que para cada nodo, los elementos de su subárbol izquierdo son menores y los de su subárbol derecho son mayores. El árbol anterior es un árbol ordenado.

Los ancestros de un nodo x son los nodos y tales que x está en alguna de las ramas de x. Por ejemplo, en el árbol anterior los ancestros de 9 son 5 y 7.

El ancestro común más bajo de dos elementos x e y de un árbol a es el ancestro de x e y de menor profundidad. Por ejemplo, en el árbol anterior el ancestro común más bajo de 6 y 9 es 7.

Definir la función

   ancestroComunMasBajo :: Arbol -> Int -> Int -> Int

1	ancestroComunMasBajo :: Arbol -> Int -> Int -> Int

tal que (ancestroComunMasBajo a x y) es el ancestro de menor profundidad de los nodos x e y en el árbol ordenado a, donde x e y son dos elementos distintos del árbol a. Por ejemplo,

   ancestroComunMasBajo ejArbol 4 1  ==  3
   ancestroComunMasBajo ejArbol 1 6  ==  5
   ancestroComunMasBajo ejArbol 6 9  ==  7

ancestroComunMasBajo ejArbol 4 1 == 3

ancestroComunMasBajo ejArbol 1 6 == 5

ancestroComunMasBajo ejArbol 6 9 == 7

Soluciones

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

Las soluciones se pueden escribir en los comentarios hasta el 16 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-16′ at=»06:00″]

data Arbol = H Int
           | N Int Arbol Arbol

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

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

ancestroComunMasBajo1 :: Arbol -> Int -> Int -> Int
ancestroComunMasBajo1 a x y =
  head [u | u <- xs, u `elem` ys]
  where xs = ancestros a x
        ys = ancestros a y

-- (ancestros a x) es la lista de los ancestros de x en el árbol
-- ordenado a, ordenada por profundidad. Por ejemplo,
--    ancestros ejArbol 1 ==  [3,5]
--    ancestros ejArbol 3 ==  [5]
--    ancestros ejArbol 5 ==  []
--    ancestros ejArbol 9 ==  [7,5]
ancestros :: Arbol -> Int -> [Int]
ancestros a y = aux a y []
  where aux (H _)     _ zs = zs
        aux (N x i d) y zs 
          | x == y    = zs
          | y < x     = aux i y (x:zs)
          | otherwise = aux d y (x:zs)

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

ancestroComunMasBajo2 :: Arbol -> Int -> Int -> Int
ancestroComunMasBajo2 (N z i d) x y 
  | x < z && y < z = ancestroComunMasBajo2 i x y 
  | x > z && y > z = ancestroComunMasBajo2 d x y 
  | otherwise      = z

data Arbol = H Int

| N Int Arbol Arbol

ejArbol :: Arbol

ejArbol = N 5 (N 3 (H 1) (H 4)) (N 7 (H 6) (H 9))

-- 1ª definición

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

ancestroComunMasBajo1 :: Arbol -> Int -> Int -> Int

ancestroComunMasBajo1 a x y =

head [u | u <- xs, u `elem` ys]

where xs = ancestros a x

ys = ancestros a y

-- (ancestros a x) es la lista de los ancestros de x en el árbol

-- ordenado a, ordenada por profundidad. Por ejemplo,

-- ancestros ejArbol 1 == [3,5]

-- ancestros ejArbol 3 == [5]

-- ancestros ejArbol 5 == []

-- ancestros ejArbol 9 == [7,5]

ancestros :: Arbol -> Int -> [Int]

ancestros a y = aux a y []

where aux (H _) _ zs = zs

aux (N x i d) y zs

| x == y = zs

| y < x = aux i y (x:zs)

| otherwise = aux d y (x:zs)

-- 2ª definición

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

ancestroComunMasBajo2 :: Arbol -> Int -> Int -> Int

ancestroComunMasBajo2 (N z i d) x y

| x < z && y < z = ancestroComunMasBajo2 i x y

| x > z && y > z = ancestroComunMasBajo2 d x y

| otherwise = z

[/schedule]

La regla de los signos de Descartes

PorJosé A. Alonso 8-junio-201725-abril-2021

Los polinomios pueden representarse mediante listas. Por ejemplo, el polinomio x^5+3x^4-5x^2+x-7 se representa por [1,3,0,-5,1,-7]. En dicha lista, obviando el cero, se producen tres cambios de signo: del 3 al -5, del -5 al 1 y del 1 al -7. Llamando C(p) al número de cambios de signo en la lista de coeficientes del polinomio p(x), tendríamos entonces que en este caso C(p)=3.

La regla de los signos de Descartes dice que el número de raíces reales positivas de una ecuación polinómica con coeficientes reales igualada a cero es, como mucho, igual al número de cambios de signo que se produzcan entre sus coeficientes (obviando los ceros). Por ejemplo, en el caso anterior la ecuación tendría como mucho tres soluciones reales positivas, ya que C(p)=3.

Además, si la cota C(p) no se alcanza, entonces el número de raíces positivas de la ecuación difiere de ella un múltiplo de dos. En el ejemplo anterior esto significa que la ecuación puede tener tres raíces positivas o tener solamente una, pero no podría ocurrir que tuviera dos o que no tuviera ninguna.

Definir las funciones

   cambios :: [Int] -> [(Int,Int)]
   nRaicesPositivas :: [Int] -> [Int]

1 2	cambios :: [Int] -> [(Int,Int)] nRaicesPositivas :: [Int] -> [Int]

tales que

(cambios xs) es la lista de los pares de elementos de xs con signos distintos, obviando los ceros. Por ejemplo,

     cambios [1,3,0,-5,1,-7]  ==  [(3,-5),(-5,1),(1,-7)]

1	cambios [1,3,0,-5,1,-7] == [(3,-5),(-5,1),(1,-7)]

(nRaicesPositivas p) es la lista de los posibles números de raíces positivas del polinomio p (representado mediante una lista) según la regla de los signos de Descartes. Por ejemplo,

     nRaicesPositivas [1,3,0,-5,1,-7]  ==  [3,1]

1	nRaicesPositivas [1,3,0,-5,1,-7] == [3,1]

que significa que la ecuación x^5+3x^4-5x^2+x-7=0 puede tener 3 ó 1 raíz positiva.

Soluciones

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

Las soluciones se pueden escribir en los comentarios hasta el 15 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-15′ at=»06:00″]

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

cambios1 :: [Int] -> [(Int,Int)]
cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]
  where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero. 
-- Por ejemplo,  
--    noCeros [1,3,0,-5,1,-7]  ==  [1,3,-5,1,-7]
noCeros :: [Int] -> [Int]
noCeros = filter (/=0)

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

cambios2 :: [Int] -> [(Int,Int)]
cambios2 xs = cambios2' (noCeros xs)
  where cambios2' (x:y:xs)
          | x*y < 0   = (x,y) : cambios2' (y:xs)
          | otherwise = cambios2' (y:xs)
        cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]
nRaicesPositivas xs = [n,n-2..0]
  where n = length (cambios1 xs)

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

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

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

cambios1 xs = [(x,y) | (x,y) <- consecutivos (noCeros xs), x*y < 0]

where consecutivos xs = zip xs (tail xs)

-- (noCeros xs) es la lista de los elementos de xs distintos de cero.

-- Por ejemplo,

-- noCeros [1,3,0,-5,1,-7] == [1,3,-5,1,-7]

noCeros :: [Int] -> [Int]

noCeros = filter (/=0)

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

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

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

cambios2 xs = cambios2' (noCeros xs)

where cambios2' (x:y:xs)

| x*y < 0 = (x,y) : cambios2' (y:xs)

| otherwise = cambios2' (y:xs)

cambios2' _ = []

nRaicesPositivas :: [Int] -> [Int]

nRaicesPositivas xs = [n,n-2..0]

where n = length (cambios1 xs)

[/schedule]

Valores de polinomios y de expresiones

PorJosé A. Alonso 7-junio-201725-abril-2021

Las expresiones aritméticas construidas con una variables, los números enteros y las operaciones de sumar y multiplicar se pueden representar mediante el tipo de datos Exp definido por

   data Exp = Var | Const Int | Sum Exp Exp | Mul Exp  Exp
              deriving Show

1 2	data Exp = Var \| Const Int \| Sum Exp Exp \| Mul Exp Exp deriving Show

Por ejemplo, la expresión 3+5x^2 se puede representar por

   exp1 :: Exp
   exp1 = Sum (Const 3) (Mul Var (Mul Var (Const 5)))

1 2	exp1 :: Exp exp1 = Sum (Const 3) (Mul Var (Mul Var (Const 5)))

Por su parte, los polinomios se pueden representar por la lista de sus coeficientes. Por ejemplo, el polinomio 3+5x^2 se puede representar por [3,0,5].

Definir las funciones

   valorE :: Exp -> Int -> Int
   expresion :: [Int] -> Exp
   valorP :: [Int] -> Int -> Int

valorE :: Exp -> Int -> Int

expresion :: [Int] -> Exp

valorP :: [Int] -> Int -> Int

tales que

(valorE e n) es el valor de la expresión e cuando se sustituye su variable por n. Por ejemplo,

     λ> valorE (Sum (Const 3) (Mul Var (Mul Var (Const 5)))) 2
     23

1 2	λ> valorE (Sum (Const 3) (Mul Var (Mul Var (Const 5)))) 2 23

(expresion p) es una expresión aritmética equivalente al polinomio p. Por ejemplo,

     λ> expresion [3,0,5]
     Sum (Const 3) (Mul Var (Sum (Const 0) (Mul Var (Const 5))))

1 2	λ> expresion [3,0,5] Sum (Const 3) (Mul Var (Sum (Const 0) (Mul Var (Const 5))))

(valorP p n) es el valor del polinomio p cuando se sustituye su variable por n. Por ejemplo,

     λ> valorP [3,0,5] 2
     23

1 2	λ> valorP [3,0,5] 2 23

Comprobar con QuickCheck que, para todo polinomio p y todo entero n,

   valorP p n == valorE (expresion p) n

1	valorP p n == valorE (expresion p) n

Soluciones

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

Las soluciones se pueden escribir en los comentarios hasta el 14 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-14′ at=»06:00″]

import Test.QuickCheck

data Exp = Var | Const Int | Sum Exp Exp | Mul Exp  Exp
           deriving Show
 
exp1 :: Exp
exp1 = Sum (Const 3) (Mul Var (Mul Var (Const 5)))
 
valorE :: Exp -> Int -> Int
valorE Var         n = n
valorE (Const a)   n = a
valorE (Sum e1 e2) n = valorE e1 n + valorE e2 n
valorE (Mul e1 e2) n = valorE e1 n * valorE e2 n
 
expresion :: [Int] -> Exp
expresion [a]   = Const a
expresion (a:p) = Sum (Const a) (Mul Var (expresion p))
 
valorP :: [Int] -> Int -> Int
valorP [a] _ = a
valorP (a:p) n = a + n * valorP p n
 
-- La propiedad es
prop_valor :: [Int] -> Int -> Property
prop_valor p n =
    not (null p) ==> 
    valorP p n == valorE (expresion p) n
 
-- La comprobación es
--    λ> quickCheck prop_valor
--    +++ OK, passed 100 tests.

import Test.QuickCheck

data Exp = Var | Const Int | Sum Exp Exp | Mul Exp Exp

deriving Show

exp1 :: Exp

exp1 = Sum (Const 3) (Mul Var (Mul Var (Const 5)))

valorE :: Exp -> Int -> Int

valorE Var n = n

valorE (Const a) n = a

valorE (Sum e1 e2) n = valorE e1 n + valorE e2 n

valorE (Mul e1 e2) n = valorE e1 n * valorE e2 n

expresion :: [Int] -> Exp

expresion [a] = Const a

expresion (a:p) = Sum (Const a) (Mul Var (expresion p))

valorP :: [Int] -> Int -> Int

valorP [a] _ = a

valorP (a:p) n = a + n * valorP p n

-- La propiedad es

prop_valor :: [Int] -> Int -> Property

prop_valor p n =

not (null p) ==>

valorP p n == valorE (expresion p) n

-- La comprobación es

-- λ> quickCheck prop_valor

-- +++ OK, passed 100 tests.

[/schedule]

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]

Extremos locales

PorJosé A. Alonso 29-mayo-2017

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]

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]

Buscaminas

PorJosé A. Alonso 14-abril-201726-marzo-2022

El buscaminas es un juego cuyo objetivo es despejar un campo de minas sin detonar ninguna.

El campo de minas se representa mediante un cuadrado con NxN casillas. Algunas casillas tienen un número, este número indica las minas que hay en todas las casillas vecinas. Cada casilla tiene como máximo 8 vecinas. Por ejemplo, el campo 4×4 de la izquierda contiene dos minas, cada una representada por el número 9, y a la derecha se muestra el campo obtenido anotando las minas vecinas de cada casilla

   9 0 0 0       9 1 0 0
   0 0 0 0       2 2 1 0
   0 9 0 0       1 9 1 0
   0 0 0 0       1 1 1 0

9 0 0 0 9 1 0 0

0 0 0 0 2 2 1 0

0 9 0 0 1 9 1 0

0 0 0 0 1 1 1 0

de la misma forma, la anotación del siguiente a la izquierda es el de la derecha

   9 9 0 0 0     9 9 1 0 0
   0 0 0 0 0     3 3 2 0 0
   0 9 0 0 0     1 9 1 0 0

9 9 0 0 0 9 9 1 0 0

0 0 0 0 0 3 3 2 0 0

0 9 0 0 0 1 9 1 0 0

En el ejercicio se usará la librería Data.Matrix, cuyo manual se encuentra en aquí.

Los campos de minas se representan mediante matrices:

   type Campo = Matrix Int

1	type Campo = Matrix Int

Por ejemplo, los anteriores campos de la izquierda se definen por

   ejCampo1, ejCampo2 :: Campo
   ejCampo1 = fromLists [[9,0,0,0],
                         [0,0,0,0], 
                         [0,9,0,0], 
                         [0,0,0,0]]
   ejCampo2 = fromLists [[9,9,0,0,0],
                         [0,0,0,0,0],
                         [0,9,0,0,0]]

ejCampo1, ejCampo2 :: Campo

ejCampo1 = fromLists [[9,0,0,0],

[0,0,0,0],

[0,9,0,0],

[0,0,0,0]]

ejCampo2 = fromLists [[9,9,0,0,0],

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

[0,9,0,0,0]]

Definir la función

   buscaminas :: Campo -> Campo

1	buscaminas :: Campo -> Campo

tal que (buscaminas c) es el campo obtenido anotando las minas vecinas de cada casilla. Por ejemplo,

   ghci> buscaminas ejCampo1
   ( 9 1 0 0 )
   ( 2 2 1 0 )
   ( 1 9 1 0 )
   ( 1 1 1 0 )

   ghci> buscaminas ejCampo2
   ( 9 9 1 0 0 )
   ( 3 3 2 0 0 )
   ( 1 9 1 0 0 )

ghci> buscaminas ejCampo1

( 9 1 0 0 )

( 2 2 1 0 )

( 1 9 1 0 )

( 1 1 1 0 )

ghci> buscaminas ejCampo2

( 9 9 1 0 0 )

( 3 3 2 0 0 )

( 1 9 1 0 0 )

Soluciones

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

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

[/schedule]

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

import Data.Matrix

type Campo   = Matrix Int
type Casilla = (Int,Int)

ejCampo1, ejCampo2 :: Campo
ejCampo1 = fromLists [[9,0,0,0],
                      [0,0,0,0], 
                      [0,9,0,0], 
                      [0,0,0,0]]
ejCampo2 = fromLists [[9,9,0,0,0],
                      [0,0,0,0,0],
                      [0,9,0,0,0]]

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

buscaminas1 :: Campo -> Campo
buscaminas1 c = matrix m n (\(i,j) -> minas c (i,j))
    where m = nrows c
          n = ncols c

-- (minas c (i,j)) es el número de minas en las casillas vecinas de la
-- (i,j) en el campo de mina c y es 9 si en (i,j) hay una mina. Por
-- ejemplo,
--    minas ejCampo (1,1)  ==  9
--    minas ejCampo (1,2)  ==  1
--    minas ejCampo (1,3)  ==  0
--    minas ejCampo (2,1)  ==  2
minas :: Campo -> Casilla -> Int
minas c (i,j) 
    | c!(i,j) == 9 = 9
    | otherwise    = length (filter (==9) [c!(x,y) | (x,y) <- vecinas m n (i,j)])
                     where m = nrows c
                           n = ncols c

-- (vecinas m n (i,j)) es la lista de las casillas vecinas de la (i,j) en
-- un campo de dimensiones mxn. Por ejemplo,
--    vecinas 4 (1,1)  ==  [(1,2),(2,1),(2,2)]
--    vecinas 4 (1,2)  ==  [(1,1),(1,3),(2,1),(2,2),(2,3)]
--    vecinas 4 (2,3)  ==  [(1,2),(1,3),(1,4),(2,2),(2,4),(3,2),(3,3),(3,4)]
vecinas :: Int -> Int -> Casilla -> [Casilla]
vecinas m n (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],
                             b <- [max 1 (j-1)..min n (j+1)],
                             (a,b) /= (i,j)]

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

buscaminas2 :: Campo -> Campo
buscaminas2 c = matrix m n (\(i,j) -> minas (i,j))
    where m = nrows c
          n = ncols c
          minas :: Casilla -> Int
          minas (i,j) 
              | c!(i,j) == 9 = 9
              | otherwise    = 
                  length (filter (==9) [c!(x,y) | (x,y) <- vecinas (i,j)])
          vecinas :: Casilla -> [Casilla]
          vecinas (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],
                                   b <- [max 1 (j-1)..min n (j+1)],
                                   (a,b) /= (i,j)]

import Data.Matrix

type Campo = Matrix Int

type Casilla = (Int,Int)

ejCampo1, ejCampo2 :: Campo

ejCampo1 = fromLists [[9,0,0,0],

[0,0,0,0],

[0,9,0,0],

[0,0,0,0]]

ejCampo2 = fromLists [[9,9,0,0,0],

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

[0,9,0,0,0]]

-- 1ª solución

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

buscaminas1 :: Campo -> Campo

buscaminas1 c = matrix m n (\(i,j) -> minas c (i,j))

where m = nrows c

n = ncols c

-- (minas c (i,j)) es el número de minas en las casillas vecinas de la

-- (i,j) en el campo de mina c y es 9 si en (i,j) hay una mina. Por

-- ejemplo,

-- minas ejCampo (1,1) == 9

-- minas ejCampo (1,2) == 1

-- minas ejCampo (1,3) == 0

-- minas ejCampo (2,1) == 2

minas :: Campo -> Casilla -> Int

minas c (i,j)

| c!(i,j) == 9 = 9

| otherwise = length (filter (==9) [c!(x,y) | (x,y) <- vecinas m n (i,j)])

where m = nrows c

n = ncols c

-- (vecinas m n (i,j)) es la lista de las casillas vecinas de la (i,j) en

-- un campo de dimensiones mxn. Por ejemplo,

-- vecinas 4 (1,1) == [(1,2),(2,1),(2,2)]

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

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

vecinas :: Int -> Int -> Casilla -> [Casilla]

vecinas m n (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],

b <- [max 1 (j-1)..min n (j+1)],

(a,b) /= (i,j)]

-- 2ª solución

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

buscaminas2 :: Campo -> Campo

buscaminas2 c = matrix m n (\(i,j) -> minas (i,j))

where m = nrows c

n = ncols c

minas :: Casilla -> Int

minas (i,j)

| c!(i,j) == 9 = 9

| otherwise =

length (filter (==9) [c!(x,y) | (x,y) <- vecinas (i,j)])

vecinas :: Casilla -> [Casilla]

vecinas (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],

b <- [max 1 (j-1)..min n (j+1)],

(a,b) /= (i,j)]

[/schedule]

Número de islas rectangulares de una matriz

PorJosé A. Alonso 8-marzo-20178-marzo-2017

En este problema se consideran matrices cuyos elementos son 0 y 1. Los valores 1 aparecen en forma de islas rectangulares separadas por 0 de forma que como máximo las islas son diagonalmente adyacentes. Por ejemplo,

   ej1, ej2 :: Array (Int,Int) Int
   ej1 = listArray ((1,1),(6,3))
                   [0,0,0,
                    1,1,0,
                    1,1,0,
                    0,0,1,
                    0,0,1,
                    1,1,0]
   ej2 = listArray ((1,1),(6,6))
                   [1,0,0,0,0,0,
                    1,0,1,1,1,1,
                    0,0,0,0,0,0,
                    1,1,1,0,1,1,
                    1,1,1,0,1,1,
                    0,0,0,0,1,1]

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(6,3))

[0,0,0,

1,1,0,

0,0,1,

1,1,0]

ej2 = listArray ((1,1),(6,6))

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

1,0,1,1,1,1,

0,0,0,0,0,0,

1,1,1,0,1,1,

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

Definir la función

   numeroDeIslas :: Array (Int,Int) Int -> Int

1	numeroDeIslas :: Array (Int,Int) Int -> Int

tal que (numeroDeIslas p) es el número de islas de la matriz p. Por ejemplo,

   numeroDeIslas ej1  ==  3
   numeroDeIslas ej2  ==  4

1 2	numeroDeIslas ej1 == 3 numeroDeIslas ej2 == 4

Soluciones

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

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

[/schedule]

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

import Data.Array

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Array (Int,Int) Int
ej1 = listArray ((1,1),(6,3))
                [0,0,0,
                 1,1,0,
                 1,1,0,
                 0,0,1,
                 0,0,1,
                 1,1,0]
ej2 = listArray ((1,1),(6,6))
                [1,0,0,0,0,0,
                 1,0,1,1,1,1,
                 0,0,0,0,0,0,
                 1,1,1,0,1,1,
                 1,1,1,0,1,1,
                 0,0,0,0,1,1]

numeroDeIslas :: Array (Int,Int) Int -> Int
numeroDeIslas p = 
    length [(i,j) | (i,j) <- indices p, 
                     verticeSuperiorIzquierdo p (i,j)]

-- (verticeSuperiorIzquierdo p (i,j)) se verifica si (i,j) es el
-- vértice superior izquierdo de algunas de las islas de la matriz p,
-- Por ejemplo, 
--    ghci> [(i,j) | (i,j) <- indices ej1, verticeSuperiorIzquierdo ej1 (i,j)]
--    [(2,1),(4,3),(6,1)]
--    ghci> [(i,j) | (i,j) <- indices ej2, verticeSuperiorIzquierdo ej2 (i,j)]
--    [(1,1),(2,3),(4,1),(4,5)]
verticeSuperiorIzquierdo :: Matriz -> (Int,Int) -> Bool
verticeSuperiorIzquierdo p (i,j) =
    enLadoSuperior p (i,j) && enLadoIzquierdo p (i,j) 

-- (enLadoSuperior p (i,j)) se verifica si (i,j) está en el lado
-- superior de algunas de las islas de la matriz p, Por ejemplo,
--    ghci> [(i,j) | (i,j) <- indices ej1, enLadoSuperior ej1 (i,j)]
--    [(2,1),(2,2),(4,3),(6,1),(6,2)]
--    ghci> [(i,j) | (i,j) <- indices ej2, enLadoSuperior ej2 (i,j)]
--    [(1,1),(2,3),(2,4),(2,5),(2,6),(4,1),(4,2),(4,3),(4,5),(4,6)]
enLadoSuperior :: Matriz -> (Int,Int) -> Bool
enLadoSuperior p (1,j) = p!(1,j) == 1
enLadoSuperior p (i,j) = p!(i,j) == 1 && p!(i-1,j) == 0

-- (enLadoIzquierdo p (i,j)) se verifica si (i,j) está en el lado
-- izquierdo de algunas de las islas de la matriz p, Por ejemplo,
--    ghci> [(i,j) | (i,j) <- indices ej1, enLadoIzquierdo ej1 (i,j)]
--    [(2,1),(3,1),(4,3),(5,3),(6,1)]
--    ghci> [(i,j) | (i,j) <- indices ej2, enLadoIzquierdo ej2 (i,j)]
--    [(1,1),(2,1),(2,3),(4,1),(4,5),(5,1),(5,5),(6,5)]
enLadoIzquierdo :: Matriz -> (Int,Int) -> Bool
enLadoIzquierdo p (i,1) = p!(i,1) == 1
enLadoIzquierdo p (i,j) = p!(i,j) == 1 && p!(i,j-1) == 0

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

numeroDeIslas2 :: Array (Int,Int) Int -> Int
numeroDeIslas2 p = 
    length [(i,j) | (i,j) <- indices p, 
                    p!(i,j) == 1,
                    i == 1 || p!(i-1,j) == 0,
                    j == 1 || p!(i,j-1) == 0]

import Data.Array

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Array (Int,Int) Int

ej1 = listArray ((1,1),(6,3))

[0,0,0,

1,1,0,

0,0,1,

1,1,0]

ej2 = listArray ((1,1),(6,6))

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

1,0,1,1,1,1,

0,0,0,0,0,0,

1,1,1,0,1,1,

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

numeroDeIslas :: Array (Int,Int) Int -> Int

numeroDeIslas p =

length [(i,j) | (i,j) <- indices p,

verticeSuperiorIzquierdo p (i,j)]

-- (verticeSuperiorIzquierdo p (i,j)) se verifica si (i,j) es el

-- vértice superior izquierdo de algunas de las islas de la matriz p,

-- Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, verticeSuperiorIzquierdo ej1 (i,j)]

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

-- ghci> [(i,j) | (i,j) <- indices ej2, verticeSuperiorIzquierdo ej2 (i,j)]

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

verticeSuperiorIzquierdo :: Matriz -> (Int,Int) -> Bool

verticeSuperiorIzquierdo p (i,j) =

enLadoSuperior p (i,j) && enLadoIzquierdo p (i,j)

-- (enLadoSuperior p (i,j)) se verifica si (i,j) está en el lado

-- superior de algunas de las islas de la matriz p, Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, enLadoSuperior ej1 (i,j)]

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

-- ghci> [(i,j) | (i,j) <- indices ej2, enLadoSuperior ej2 (i,j)]

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

enLadoSuperior :: Matriz -> (Int,Int) -> Bool

enLadoSuperior p (1,j) = p!(1,j) == 1

enLadoSuperior p (i,j) = p!(i,j) == 1 && p!(i-1,j) == 0

-- (enLadoIzquierdo p (i,j)) se verifica si (i,j) está en el lado

-- izquierdo de algunas de las islas de la matriz p, Por ejemplo,

-- ghci> [(i,j) | (i,j) <- indices ej1, enLadoIzquierdo ej1 (i,j)]

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

-- ghci> [(i,j) | (i,j) <- indices ej2, enLadoIzquierdo ej2 (i,j)]

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

enLadoIzquierdo :: Matriz -> (Int,Int) -> Bool

enLadoIzquierdo p (i,1) = p!(i,1) == 1

enLadoIzquierdo p (i,j) = p!(i,j) == 1 && p!(i,j-1) == 0

-- 2ª solución

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

numeroDeIslas2 :: Array (Int,Int) Int -> Int

numeroDeIslas2 p =

length [(i,j) | (i,j) <- indices p,

p!(i,j) == 1,

i == 1 || p!(i-1,j) == 0,

j == 1 || p!(i,j-1) == 0]

[/schedule]

Elementos que respetan la ordenación

PorJosé A. Alonso 7-diciembre-201614-diciembre-2016

Se dice que un elemento x de una lista xs respeta la ordenación si x es mayor o igual que todos lo que tiene delante en xs y es menor o igual que todos lo que tiene detrás en xs. Por ejemplo, en la lista lista [3,2,1,4,6,5,7,9,8] el número 4 respeta la ordenación pero el número 5 no la respeta (porque es mayor que el 6 que está delante).

Definir la función

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

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

tal que (respetuosos xs) es la lista de los elementos de xs que respetan la ordenación. Por ejemplo,

   respetuosos [3,2,1,4,6,4,7,9,8]  ==  [4,7]
   respetuosos [2,1,3,4,6,4,7,8,9]  ==  [3,4,7,8,9]
   respetuosos "abaco"              ==  "aco"
   respetuosos "amor"               ==  "amor"
   respetuosos "romanos"            ==  "s"
   respetuosos [1..9]               ==  [1,2,3,4,5,6,7,8,9]
   respetuosos [9,8..1]             ==  []

respetuosos [3,2,1,4,6,4,7,9,8] == [4,7]

respetuosos [2,1,3,4,6,4,7,8,9] == [3,4,7,8,9]

respetuosos "abaco" == "aco"

respetuosos "amor" == "amor"

respetuosos "romanos" == "s"

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

respetuosos [9,8..1] == []

Comprobar con QuickCheck que para cualquier lista de enteros xs se verifican las siguientes propiedades:

todos los elementos de (sort xs) respetan la ordenación y
en la lista (nub (reverse (sort xs))) hay como máximo un elemento que respeta la ordenación.

Soluciones

import Data.List (inits, nub, sort, tails)
import Test.QuickCheck

-- 1ª definición (por comprensión):
respetuosos :: Ord a => [a] -> [a]
respetuosos xs =
  [z | k <- [0..n-1]
     , let (ys,z:zs) = splitAt k xs
     , all (<=z) ys
     , all (>=z) zs]
  where n = length xs

-- 2ª definición (por recursión):
respetuosos2 :: Ord a => [a] -> [a]
respetuosos2 xs = aux [] [] xs
  where aux zs _  []      = reverse zs
        aux zs ys (x:xs)
          | all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs
          | otherwise                    = aux zs     (x:ys) xs

-- 3ª definición
respetuosos3 :: Ord a => [a] -> [a]
respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)
                      , all (<=x) ys
                      , all (x<=) zs ]

-- 4ª solución
respetuosos4 :: Ord a =>[a] ->[a]
respetuosos4 xs =
  [x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)
     , a <= x && x <= b]

-- Comparación de eficiencia
--    λ> length (respetuosos [1..3000])
--    3000
--    (3.31 secs, 1,140,407,224 bytes)
--    λ> length (respetuosos2 [1..3000])
--    3000
--    (2.85 secs, 587,082,160 bytes)
--    λ> length (respetuosos3 [1..3000])
--    3000
--    (2.12 secs, 785,446,880 bytes)
--    λ> length (respetuosos4 [1..3000])
--    3000
--    (0.02 secs, 0 bytes)

-- 1ª propiedad
prop_respetuosos1 :: [Int] -> Bool
prop_respetuosos1 xs =
  respetuosos (sort xs) == sort xs

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

-- La 2ª propiedad
prop_respetuosos2 :: [Int] -> Bool
prop_respetuosos2 xs =
  length (respetuosos (nub (reverse (sort xs)))) <= 1

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

import Data.List (inits, nub, sort, tails)

import Test.QuickCheck

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

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

respetuosos xs =

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

, let (ys,z:zs) = splitAt k xs

, all (<=z) ys

, all (>=z) zs]

where n = length xs

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

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

respetuosos2 xs = aux [] [] xs

where aux zs _ [] = reverse zs

aux zs ys (x:xs)

| all (<=x) ys && all (>=x) xs = aux (x:zs) (x:ys) xs

| otherwise = aux zs (x:ys) xs

-- 3ª definición

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

respetuosos3 xs = [ x | (ys,x,zs) <- zip3 (inits xs) xs (tails xs)

, all (<=x) ys

, all (x<=) zs ]

-- 4ª solución

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

respetuosos4 xs =

[x | (a, x, b) <- zip3 (scanl1 max xs) xs (scanr1 min xs)

, a <= x && x <= b]

-- Comparación de eficiencia

-- λ> length (respetuosos [1..3000])

-- 3000

-- (3.31 secs, 1,140,407,224 bytes)

-- λ> length (respetuosos2 [1..3000])

-- 3000

-- (2.85 secs, 587,082,160 bytes)

-- λ> length (respetuosos3 [1..3000])

-- 3000

-- (2.12 secs, 785,446,880 bytes)

-- λ> length (respetuosos4 [1..3000])

-- 3000

-- (0.02 secs, 0 bytes)

-- 1ª propiedad

prop_respetuosos1 :: [Int] -> Bool

prop_respetuosos1 xs =

respetuosos (sort xs) == sort xs

-- La comprobación es

-- λ> quickCheck prop_respetuosos1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad

prop_respetuosos2 :: [Int] -> Bool

prop_respetuosos2 xs =

length (respetuosos (nub (reverse (sort xs)))) <= 1

-- La comprobación es

-- λ> quickCheck prop_respetuosos2

-- +++ OK, passed 100 tests.

Sucesión de sumas de dígitos

PorJosé A. Alonso 2-junio-20162-junio-2016

Definir la lista

   sucSumaDigitos :: [Integer]

1	sucSumaDigitos :: [Integer]

cuyos elementos son los términos de la sucesión a(n) definidos por a(0) = 1 y, para n ≥ 1, a(n) es la suma de los dígitos de todos los términos precedentes. Por ejemplo,

   λ> take 20 sucSumaDigitos
   [1,1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107,115,122,127]
   λ> sucSumaDigitos !! 1000000
   31054319

λ> take 20 sucSumaDigitos

[1,1,2,4,8,16,23,28,38,49,62,70,77,91,101,103,107,115,122,127]

λ> sucSumaDigitos !! 1000000

31054319

Soluciones

[schedule expon=’2016-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=’2016-06-09′ at=»06:00″]

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

sucSumaDigitos1:: [Integer]
sucSumaDigitos1 = 1 : iterate f 1
    where f x = x + sum (digitos x)

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

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

sucSumaDigitos2:: [Integer]
sucSumaDigitos2 = 1 : iterate f 1
    where f x = x + sumaDigitos x

sumaDigitos n
    | n < 10    = n
    | otherwise = sumaDigitos q + r
    where (q,r) = divMod n 10 

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

--    λ> sucSumaDigitos1 !! 1000000
--    31054319
--    (24.04 secs, 52,022,125,016 bytes)
--    λ> sucSumaDigitos2 !! 1000000
--    31054319
--    (10.86 secs, 5,267,144,472 bytes)

-- 1ª definición

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

sucSumaDigitos1:: [Integer]

sucSumaDigitos1 = 1 : iterate f 1

where f x = x + sum (digitos x)

digitos:: Integer -> [Integer]

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

-- 2ª definición

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

sucSumaDigitos2:: [Integer]

sucSumaDigitos2 = 1 : iterate f 1

where f x = x + sumaDigitos x

sumaDigitos n

| n < 10 = n

| otherwise = sumaDigitos q + r

where (q,r) = divMod n 10

-- Comparación de eficiencia

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

-- λ> sucSumaDigitos1 !! 1000000

-- 31054319

-- (24.04 secs, 52,022,125,016 bytes)

-- λ> sucSumaDigitos2 !! 1000000

-- 31054319

-- (10.86 secs, 5,267,144,472 bytes)

[/schedule]

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