max – Exercitium

Elementos de una matriz con algún vecino menor

PorJosé A. Alonso 7-abril-202215-abril-2022

Las matrices pueden representarse mediante tablas cuyos índices son pares de números naturales. Su tipo se define por

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Por ejemplo, la matriz

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

|9 4 6 5|

|8 1 7 3|

|4 2 5 4|

se define por

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

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

Los vecinos de un elemento son los que están a un paso en la misma fila, columna o diagonal. Por ejemplo, en la matriz anterior, el 1 tiene 8 vecinos (el 9, 4, 6, 8, 7, 4, 2 y 5) pero el 9 sólo tiene 3 vecinos (el 4, 8 y 1).

Definir la función

   algunoMenor :: Matriz -> [Int]

1	algunoMenor :: Matriz -> [Int]

tal que (algunoMenor p) es la lista de los elementos de p que tienen algún vecino menor que él. Por ejemplo,

   algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

1	algunoMenor ej == [9,4,6,5,8,7,4,2,5,4]

pues sólo el 1 y el 3 no tienen ningún vecino menor en la matriz.

Soluciones

import Data.Array (Array, (!), bounds, indices, inRange, listArray)
import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,
                        vectorOf)

type Matriz = Array (Int,Int) Int

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

type Pos = (Int,Int)

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

algunoMenor1 :: Matriz -> [Int]
algunoMenor1 a =
  [a!p| p <- indices a,
        any (< a!p) (vecinos1 a p)]

-- (vecinos q p) es la lista de los vecinos en la matriz a de la
-- posición p. Por ejemplo,
--    vecinos1 ej (2,2)  ==  [9,4,6,8,7,4,2,5]
--    vecinos1 ej (1,1)  ==  [4,8,1]
vecinos1 :: Matriz -> Pos -> [Int]
vecinos1 a p =
  [a!p' | p' <- posicionesVecinos1 a p]

-- (posicionesVecinos a p) es la lista de las posiciones de los
-- vecino de p en la matriz a. Por ejemplo,
--    λ> posicionesVecinos1 3 3 (2,2)
--    [(1,1),(1,2),(1,3),(2,1),(2,3),(3,1),(3,2),(3,3)]
--    λ> posicionesVecinos1 3 3 (1,1)
--    [(1,2),(2,1),(2,2)]
posicionesVecinos1 :: Matriz -> Pos -> [Pos]
posicionesVecinos1 a (i,j) =
  [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                             ( 0,-1),       ( 0,1),
                             ( 1,-1),( 1,0),( 1,1)],
                 inRange (bounds a) (i+di,j+dj)]

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

algunoMenor2 :: Matriz -> [Int]
algunoMenor2 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos2 p)]
  where
    vecinos2 p =
      [a!p' | p' <- posicionesVecinos2 p]
    posicionesVecinos2 (i,j) =
      [(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),
                                 ( 0,-1),       ( 0,1),
                                 ( 1,-1),( 1,0),( 1,1)],
                     inRange (bounds a) (i+di,j+dj)]

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

algunoMenor3 :: Matriz -> [Int]
algunoMenor3 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos3 p)]
  where
    vecinos3 p =
      [a!p' | p' <- posicionesVecinos3 p]
    posicionesVecinos3 (i,j) =
      [(i',j') | i' <- [i-1..i+1],
                 j' <- [j-1..j+1],
                 (i',j') /= (i,j),
                 inRange (bounds a) (i',j')]

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

algunoMenor4 :: Matriz -> [Int]
algunoMenor4 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos4 p)]
  where
    vecinos4 p =
      [a!p' | p' <- posicionesVecinos4 p]
    posicionesVecinos4 (i,j) =
      [(i',j') | i' <- [max 1 (i-1)..min m (i+1)],
                 j' <- [max 1 (j-1)..min n (j+1)],
                 (i',j') /= (i,j)]
      where (_,(m,n)) = bounds a


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

algunoMenor5 :: Matriz -> [Int]
algunoMenor5 a =
  [a!p | p <- indices a,
         any (<a!p) (vecinos5 p)]
  where
    vecinos5 p =
      [a!p' | p' <- posicionesVecinos5 p]
    posicionesVecinos5 (i,j) =
      [(i-1,j-1) | i > 1, j > 1] ++
      [(i-1,j)   | i > 1]        ++
      [(i-1,j+1) | i > 1, j < n] ++
      [(i,j-1)   | j > 1]        ++
      [(i,j+1)   | j < n]        ++
      [(i+1,j-1) | i < m, j > 1] ++
      [(i+1,j)   | i < m]        ++
      [(i+1,j+1) | i < m, j < n]
      where (_,(m,n)) = bounds a

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

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

newtype Matriz2 = M Matriz
  deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,
--    λ> generate matrizArbitraria
--    M (array ((1,1),(3,4))
--             [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),
--              ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),
--              ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])
matrizArbitraria :: Gen Matriz2
matrizArbitraria = do
  m  <- chooseInt (1,10)
  n  <- chooseInt (1,10)
  xs <- vectorOf (m*n) arbitrary
  return (M (listArray ((1,1),(m,n)) xs))

-- Matriz es una subclase de Arbitrary.
instance Arbitrary Matriz2 where
  arbitrary = matrizArbitraria

-- La propiedad es
prop_algunoMenor :: Matriz2 -> Bool
prop_algunoMenor (M p) =
  all (== algunoMenor1 p)
      [algunoMenor2 p,
       algunoMenor3 p,
       algunoMenor4 p,
       algunoMenor5 p]

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

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

-- La comparación es
--    λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.20 secs, 1,350,075,240 bytes)
--    λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.24 secs, 1,373,139,968 bytes)
--    λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.08 secs, 1,200,734,112 bytes)
--    λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (2.76 secs, 1,287,653,136 bytes)
--    λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))
--    479999
--    (1.67 secs, 953,937,600 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

import Data.Array (Array, (!), bounds, indices, inRange, listArray)

import Test.QuickCheck (Arbitrary, Gen, arbitrary, chooseInt, quickCheck,

vectorOf)

type Matriz = Array (Int,Int) Int

ej :: Matriz

ej = listArray ((1,1),(3,4)) [9,4,6,5,8,1,7,3,4,2,5,4]

type Pos = (Int,Int)

-- 1ª solución

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

algunoMenor1 :: Matriz -> [Int]

algunoMenor1 a =

[a!p| p <- indices a,

any (< a!p) (vecinos1 a p)]

-- (vecinos q p) es la lista de los vecinos en la matriz a de la

-- posición p. Por ejemplo,

-- vecinos1 ej (2,2) == [9,4,6,8,7,4,2,5]

-- vecinos1 ej (1,1) == [4,8,1]

vecinos1 :: Matriz -> Pos -> [Int]

vecinos1 a p =

[a!p' | p' <- posicionesVecinos1 a p]

-- (posicionesVecinos a p) es la lista de las posiciones de los

-- vecino de p en la matriz a. Por ejemplo,

-- λ> posicionesVecinos1 3 3 (2,2)

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

-- λ> posicionesVecinos1 3 3 (1,1)

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

posicionesVecinos1 :: Matriz -> Pos -> [Pos]

posicionesVecinos1 a (i,j) =

[(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),

( 0,-1), ( 0,1),

( 1,-1),( 1,0),( 1,1)],

inRange (bounds a) (i+di,j+dj)]

-- 2ª solución

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

algunoMenor2 :: Matriz -> [Int]

algunoMenor2 a =

[a!p | p <- indices a,

any (<a!p) (vecinos2 p)]

where

vecinos2 p =

[a!p' | p' <- posicionesVecinos2 p]

posicionesVecinos2 (i,j) =

[(i+di,j+dj) | (di,dj) <- [(-1,-1),(-1,0),(-1,1),

( 0,-1), ( 0,1),

( 1,-1),( 1,0),( 1,1)],

inRange (bounds a) (i+di,j+dj)]

-- 3ª solución

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

algunoMenor3 :: Matriz -> [Int]

algunoMenor3 a =

[a!p | p <- indices a,

any (<a!p) (vecinos3 p)]

where

vecinos3 p =

[a!p' | p' <- posicionesVecinos3 p]

posicionesVecinos3 (i,j) =

[(i',j') | i' <- [i-1..i+1],

j' <- [j-1..j+1],

(i',j') /= (i,j),

inRange (bounds a) (i',j')]

-- 4ª solución

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

algunoMenor4 :: Matriz -> [Int]

algunoMenor4 a =

[a!p | p <- indices a,

any (<a!p) (vecinos4 p)]

where

vecinos4 p =

[a!p' | p' <- posicionesVecinos4 p]

posicionesVecinos4 (i,j) =

[(i',j') | i' <- [max 1 (i-1)..min m (i+1)],

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

(i',j') /= (i,j)]

where (_,(m,n)) = bounds a

-- 5ª solución

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

algunoMenor5 :: Matriz -> [Int]

algunoMenor5 a =

[a!p | p <- indices a,

any (<a!p) (vecinos5 p)]

where

vecinos5 p =

[a!p' | p' <- posicionesVecinos5 p]

posicionesVecinos5 (i,j) =

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

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

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

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

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

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

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

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

where (_,(m,n)) = bounds a

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

-- Comprobación de equivalencia

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

newtype Matriz2 = M Matriz

deriving Show

-- Generador de matrices arbitrarias. Por ejemplo,

-- λ> generate matrizArbitraria

-- M (array ((1,1),(3,4))

-- [((1,1),18),((1,2),6), ((1,3),-23),((1,4),-13),

-- ((2,1),-2),((2,2),22),((2,3),-25),((2,4),-5),

-- ((3,1),2), ((3,2),16),((3,3),-15),((3,4),7)])

matrizArbitraria :: Gen Matriz2

matrizArbitraria = do

m <- chooseInt (1,10)

n <- chooseInt (1,10)

xs <- vectorOf (m*n) arbitrary

return (M (listArray ((1,1),(m,n)) xs))

-- Matriz es una subclase de Arbitrary.

instance Arbitrary Matriz2 where

arbitrary = matrizArbitraria

-- La propiedad es

prop_algunoMenor :: Matriz2 -> Bool

prop_algunoMenor (M p) =

all (== algunoMenor1 p)

[algunoMenor2 p,

algunoMenor3 p,

algunoMenor4 p,

algunoMenor5 p]

-- La comprobación es

-- λ> quickCheck prop_algunoMenor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (algunoMenor1 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.20 secs, 1,350,075,240 bytes)

-- λ> maximum (algunoMenor2 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.24 secs, 1,373,139,968 bytes)

-- λ> maximum (algunoMenor3 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.08 secs, 1,200,734,112 bytes)

-- λ> maximum (algunoMenor4 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (2.76 secs, 1,287,653,136 bytes)

-- λ> maximum (algunoMenor5 (listArray ((1,1),(600,800)) [0..]))

-- 479999

-- (1.67 secs, 953,937,600 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Suma de intervalos

PorJosé A. Alonso 25-marzo-20201-abril-2020

Los intervalos se pueden representar por pares de enteros (a,b) con a < b. Los elementos del intervalo (2,5) son 2, 3, 4 y 5; por tanto, su longitud es 4. Para calcular la suma de los longitudes de una lista de intervalos hay que tener en cuenta que si hay intervalos superpuestos sus elementos deben de contarse sólo una vez. Por ejemplo, la suma de los intervalos de [(1,4),(7,10),(3,5)] es 7 ya que, como los intervalos (1,4) y (3,5) se solapan, los podemos ver como el intervalo (1,5) que tiene una longitud de 4.

Definir la función

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

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

tal que (sumaIntervalos xs) es la suma de las longitudes de los intervalos de xs contando los superpuestos sólo una vez. Por ejemplo,

   sumaIntervalos [(1, 5)]                  == 4
   sumaIntervalos [(0,1), (-1,0)]           == 2
   sumaIntervalos [(0,1), (0,2), (1,2)]     == 2     
   sumaIntervalos [(1, 5), (6, 10)]         == 8
   sumaIntervalos [(1, 5), (5, 10)]         == 9
   sumaIntervalos [(1, 5), (1, 5)]          == 4
   sumaIntervalos [(1, 4), (7, 10), (3, 5)] == 7

sumaIntervalos [(1, 5)] == 4

sumaIntervalos [(0,1), (-1,0)] == 2

sumaIntervalos [(0,1), (0,2), (1,2)] == 2

sumaIntervalos [(1, 5), (6, 10)] == 8

sumaIntervalos [(1, 5), (5, 10)] == 9

sumaIntervalos [(1, 5), (1, 5)] == 4

sumaIntervalos [(1, 4), (7, 10), (3, 5)] == 7

Soluciones

import Data.List (nub, sort)

-- 1ª solución
sumaIntervalos :: [(Int, Int)] -> Int
sumaIntervalos = aux . sort
  where aux [] = 0
        aux [(a,b)] = b - a
        aux ((a,b):(c,d):xs) | b < c     = b - a + aux ((c,d):xs)
                             | otherwise = aux ((a,max b d):xs)

-- 2ª solución
sumaIntervalos2 :: [(Int, Int)] -> Int
sumaIntervalos2 = length . nub . concatMap f
  where f (a, b) = [a..b - 1]

import Data.List (nub, sort)

-- 1ª solución

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

sumaIntervalos = aux . sort

where aux [] = 0

aux [(a,b)] = b - a

aux ((a,b):(c,d):xs) | b < c = b - a + aux ((c,d):xs)

| otherwise = aux ((a,max b d):xs)

-- 2ª solución

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

sumaIntervalos2 = length . nub . concatMap f

where f (a, b) = [a..b - 1]

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«Si la gente no cree que las matemáticas son simples, es sólo porque no se dan cuenta de lo complicada que es la vida.»

John von Neumann.

Caminos minimales en un árbol numérico

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

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

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

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

Se pueden definir árboles. Por ejemplo,

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

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

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

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

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

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

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

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

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

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

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

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

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

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

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

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

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

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

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

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

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

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

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

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

λ> caminosMinimales 50

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

Soluciones

import Data.Tree
import Test.QuickCheck

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

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

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

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

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

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

import Data.Tree

import Test.QuickCheck

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

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

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

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

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

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

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

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

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

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

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

where yss = caminos x

m = minimum (map length yss)

Pensamiento

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

Antonio Machado

Notas de evaluación acumulada

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

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

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

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

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

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

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

juaruigar,3,7,9,3

evadialop,3,6,7,4

carrodmes,0,9,8,7

Definir las funciones

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

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

tales que

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

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

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

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

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

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

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

     notasAcumuladas "examenes.csv" "acumuladas.csv"

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

escribe en el fichero acumuladas.csv

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

juaruigar,3.0,7.0,9.0,5.4

evadialop,3.0,6.0,7.0,5.2

carrodmes,0.0,9.0,8.4,7.6

Soluciones

import Text.CSV
import Data.Either

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

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

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

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

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

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

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

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

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

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

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

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

import Text.CSV

import Data.Either

-- Definicioń de acumuladas

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

acumuladas :: [Double] -> [Double]

acumuladas = reverse . aux . reverse

where aux [] = []

aux [x] = [x]

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

where (y:ys) = aux xs

-- conUnDecimal 7.26 == 7.3

-- conUnDecimal 7.24 == 7.2

conUnDecimal :: Double -> Double

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

-- 1ª definición de notasAcumuladas

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

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

notasAcumuladas f1 f2 = do

cs <- readFile f1

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

. cadenaALista

)

(contenidoALineasDeNotas cs)))

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

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

contenidoALineasDeNotas :: String -> [String]

contenidoALineasDeNotas = filter esLineaDeNotas . lines

where esLineaDeNotas = elem ','

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

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

cadenaALista :: String -> [String]

cadenaALista cs

| tieneComas cs = d : cadenaALista ds

| otherwise = [cs]

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

tieneComas = elem ','

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

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

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

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

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

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

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

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

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

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

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

acumuladaACadena (x,xs) =

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

-- 2ª definición de notasAcumuladas

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

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

notasAcumuladas2 f1 f2 = do

cs <- readFile f1

let (Right csv) = parseCSV f1 cs

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

writeFile f2 (unlines (map ( acumuladaACadena

. notaAAcumuladas

. listaANota

)

notas))

Suma de las alturas de los nodos de un árbol

PorJosé A. Alonso 13-marzo-201820-marzo-2018

Las árboles binarios se pueden representar con el siguiente tipo

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

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

Por ejemplo, el árbol

/ \

2 3

/ \

4 5

se representa por

   ej1 :: Arbol Int
   ej1 = N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H)

1 2	ej1 :: Arbol Int ej1 = N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H)

La altura de cada elemento del árbol es la máxima distancia a las hojas en su rama. Por ejemplo, en el árbol anterior, la altura de 1 es 3, la de 2 es 2, la de 3 es 1, la de 4 es 1 y la de 5 es 1.

Definir la función

   sumaAlturas :: Arbol t -> Int

1	sumaAlturas :: Arbol t -> Int

tal que (sumaAlturas a) es la suma de las alturas de los elementos de a. Por ejemplo,

   λ> sumaAlturas (N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H))
   8
   λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 3 H H))
   7
   λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 2 (N 4 H H) (N 5 H H)))
   10

λ> sumaAlturas (N 1 (N 2 (N 4 H H) (N 5 H H)) (N 3 H H))

λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 3 H H))

λ> sumaAlturas (N 1 (N 2 (N 4 H H) H) (N 2 (N 4 H H) (N 5 H H)))

Soluciones

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

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

sumaAlturas :: Arbol t -> Int
sumaAlturas H = 0
sumaAlturas a@(N _ i d) = altura a + sumaAlturas i + sumaAlturas d 

-- (altura a) es la altura del árbol a. Por ejemplo,
--    altura H                          ==  0
--    altura (N 7 H H)                  ==  1
--    altura (N 7 (N 5 H H) H)          ==  2
--    altura (N 7 (N 5 H (N 6 H H)) H)  ==  3
altura :: Arbol t -> Int
altura H         = 0
altura (N _ i d) = 1 + max (altura i) (altura d)

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

sumaAlturas2 :: Arbol t -> Int
sumaAlturas2 = snd . alturaYsumaAlturas

-- (alturaYsumaAlturas a) es el par formado por la altura del árbol a y
-- la suma de las alturas de los nodos de a. Por ejemplo,
--    alturaYsumaAlturas H                          ==  (0,0)
--    alturaYsumaAlturas (N 7 H H)                  ==  (1,1)
--    alturaYsumaAlturas (N 7 (N 5 H H) H)          ==  (2,3)
--    alturaYsumaAlturas (N 7 (N 5 H (N 6 H H)) H)  ==  (3,6)
alturaYsumaAlturas :: Arbol t -> (Int,Int)
alturaYsumaAlturas H         = (0,0)
alturaYsumaAlturas (N _ i d) = (a,a + si + sd)
  where (ai,si) = alturaYsumaAlturas i
        (ad,sd) = alturaYsumaAlturas d
        a       = 1 + max ai ad

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

sumaAlturas3 :: Arbol t -> Int
sumaAlturas3 = sum . alturas
 
-- (alturas a) es la lista de las alturas de los nodos del árbol a. Por
-- ejemplo, 
--    alturas H                          ==  [0]
--    alturas (N 7 H H)                  ==  [1,0,0]
--    alturas (N 7 (N 5 H H) H)          ==  [2,1,0,0,0]
--    alturas (N 7 (N 5 H (N 6 H H)) H)  ==  [3,2,0,1,0,0,0]
alturas :: Arbol t -> [Int]
alturas H         = [0]
alturas (N _ a b) = (1 + max x y) : xs ++ ys
  where xs@(x : _) = alturas a
        ys@(y : _) = alturas b

data Arbol a = H

| N a (Arbol a) (Arbol a)

deriving Show

-- 1ª definición

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

sumaAlturas :: Arbol t -> Int

sumaAlturas H = 0

sumaAlturas a@(N _ i d) = altura a + sumaAlturas i + sumaAlturas d

-- (altura a) es la altura del árbol a. Por ejemplo,

-- altura H == 0

-- altura (N 7 H H) == 1

-- altura (N 7 (N 5 H H) H) == 2

-- altura (N 7 (N 5 H (N 6 H H)) H) == 3

altura :: Arbol t -> Int

altura H = 0

altura (N _ i d) = 1 + max (altura i) (altura d)

-- 2ª definición

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

sumaAlturas2 :: Arbol t -> Int

sumaAlturas2 = snd . alturaYsumaAlturas

-- (alturaYsumaAlturas a) es el par formado por la altura del árbol a y

-- la suma de las alturas de los nodos de a. Por ejemplo,

-- alturaYsumaAlturas H == (0,0)

-- alturaYsumaAlturas (N 7 H H) == (1,1)

-- alturaYsumaAlturas (N 7 (N 5 H H) H) == (2,3)

-- alturaYsumaAlturas (N 7 (N 5 H (N 6 H H)) H) == (3,6)

alturaYsumaAlturas :: Arbol t -> (Int,Int)

alturaYsumaAlturas H = (0,0)

alturaYsumaAlturas (N _ i d) = (a,a + si + sd)

where (ai,si) = alturaYsumaAlturas i

(ad,sd) = alturaYsumaAlturas d

a = 1 + max ai ad

-- 3ª definición

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

sumaAlturas3 :: Arbol t -> Int

sumaAlturas3 = sum . alturas

-- (alturas a) es la lista de las alturas de los nodos del árbol a. Por

-- ejemplo,

-- alturas H == [0]

-- alturas (N 7 H H) == [1,0,0]

-- alturas (N 7 (N 5 H H) H) == [2,1,0,0,0]

-- alturas (N 7 (N 5 H (N 6 H H)) H) == [3,2,0,1,0,0,0]

alturas :: Arbol t -> [Int]

alturas H = [0]

alturas (N _ a b) = (1 + max x y) : xs ++ ys

where xs@(x : _) = alturas a

ys@(y : _) = alturas b

Números cuyos factoriales son divisibles por x pero no por y

PorJosé A. Alonso 28-febrero-20187-marzo-2018

Hay 3 números (el 2, 3 y 4) cuyos factoriales son divisibles por 2 pero no por 5. Análogamente, hay números 5 (el 5, 6, 7, 8, 9) cuyos factoriales son divisibles por 15 pero no por 25.

Definir la función

   nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

1	nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

tal que (nNumerosConFactorialesDivisibles x y) es la cantidad de números cuyo factorial es divisible por x pero no por y. Por ejemplo,

  nNumerosConFactorialesDivisibles 2   5     ==  3
  nNumerosConFactorialesDivisibles 15  25    ==  5
  nNumerosConFactorialesDivisibles 100 2000  ==  5

nNumerosConFactorialesDivisibles 2 5 == 3

nNumerosConFactorialesDivisibles 15 25 == 5

nNumerosConFactorialesDivisibles 100 2000 == 5

Soluciones

import Data.List (genericLength)

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

nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer
nNumerosConFactorialesDivisibles x y =
  genericLength (numerosConFactorialesDivisibles x y)

-- (numerosConFactorialesDivisibles x y) es la lista de números
-- divisibles por el factorial de x pero no divisibles por el 
-- factorial de y. Por ejemplo,
--   numerosConFactorialesDivisibles 2  5   ==  [2,3,4]
--   numerosConFactorialesDivisibles 15 25  ==  [5,6,7,8,9]
numerosConFactorialesDivisibles :: Integer -> Integer -> [Integer]
numerosConFactorialesDivisibles x y =
  [z | z <- [0..y-1]
     , factorial z `mod` x == 0
     , factorial z `mod` y /= 0]

-- (factorial n) es el factorial de n. Por ejemplo, 
--   factorial 4  ==  24
factorial :: Integer -> Integer
factorial n = product [1..n]

-- 2ª solución (usando la función de Smarandache)
-- ==============================================

nNumerosConFactorialesDivisibles2 :: Integer -> Integer -> Integer
nNumerosConFactorialesDivisibles2 x y =
  max 0 (smarandache y - smarandache x)

--(smarandache n) es el menor número cuyo factorial es divisible por
-- n. Por ejemplo,   
--    smarandache 8   ==  4
--    smarandache 10  ==  5
--    smarandache 16  ==  6
smarandache :: Integer -> Integer
smarandache x =
  head [n | (n,y) <- zip [0..] factoriales
          , y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    λ> take 12 factoriales
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

-- Comparación de eficiencia
--    λ> nNumerosConFactorialesDivisibles 100 2000
--    5
--    (2.70 secs, 3,933,938,648 bytes)
--    λ> nNumerosConFactorialesDivisibles2 100 2000
--    5
--    (0.01 secs, 148,200 bytes)

import Data.List (genericLength)

-- 1ª solución

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

nNumerosConFactorialesDivisibles :: Integer -> Integer -> Integer

nNumerosConFactorialesDivisibles x y =

genericLength (numerosConFactorialesDivisibles x y)

-- (numerosConFactorialesDivisibles x y) es la lista de números

-- divisibles por el factorial de x pero no divisibles por el

-- factorial de y. Por ejemplo,

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

-- numerosConFactorialesDivisibles 15 25 == [5,6,7,8,9]

numerosConFactorialesDivisibles :: Integer -> Integer -> [Integer]

numerosConFactorialesDivisibles x y =

[z | z <- [0..y-1]

, factorial z `mod` x == 0

, factorial z `mod` y /= 0]

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

-- factorial 4 == 24

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 2ª solución (usando la función de Smarandache)

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

nNumerosConFactorialesDivisibles2 :: Integer -> Integer -> Integer

nNumerosConFactorialesDivisibles2 x y =

max 0 (smarandache y - smarandache x)

--(smarandache n) es el menor número cuyo factorial es divisible por

-- n. Por ejemplo,

-- smarandache 8 == 4

-- smarandache 10 == 5

-- smarandache 16 == 6

smarandache :: Integer -> Integer

smarandache x =

head [n | (n,y) <- zip [0..] factoriales

, y `mod` x == 0]

-- factoriales es la lista de los factoriales. Por ejemplo,

-- λ> take 12 factoriales

-- [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

-- Comparación de eficiencia

-- λ> nNumerosConFactorialesDivisibles 100 2000

-- 5

-- (2.70 secs, 3,933,938,648 bytes)

-- λ> nNumerosConFactorialesDivisibles2 100 2000

-- 5

-- (0.01 secs, 148,200 bytes)

Caminos minimales en un árbol numérico

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

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

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

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

Se pueden definir árboles. Por ejemplo,

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

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

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

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

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

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

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

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

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

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

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

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

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

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

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

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

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

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

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

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

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

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

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

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

λ> caminosMinimales 50

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

Soluciones

import Data.Tree

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

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

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

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

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

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

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

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

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

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

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

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

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

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

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

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

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

where yss = caminos x

m = minimum (map length yss)

Máximo de las rotaciones restringidas

PorJosé A. Alonso 6-diciembre-201713-diciembre-2017

Rotar un número a la iquierda significa pasar su primer dígito al final. Por ejemplo, rotando a la izquierda el 56789 se obtiene 67895.

Las rotaciones restringidas del número 56789 se obtienen como se indica a continución:

Se inicia con el propio número: 56789
El anterior se rota a la izquierda y se obtiene el 67895.
Del anterior se fija el primer dígito y se rota a la iquierda los otros. Se obtiene 68957.
Del anterior se fijan los 2 primeros dígito y se rota a la iquierda los otros. Se obtiene 68579.
Del anterior se fijan los 3 primeros dígito y se rota a la iquierda los otros. Se obtiene 68597.

El proceso ha terminado ya que conservando los cuatro primeros queda sólo un dígito que al girar es él mismo. Por tanto, la sucesión de las rotaciones restringidas de 56789 es

   56789 -> 67895 -> 68957 -> 68579 -> 68597

1	56789 -> 67895 -> 68957 -> 68579 -> 68597

y su mayor elemento es 68957.

Definir la función

   maxRotaciones :: Integer -> Integer

1	maxRotaciones :: Integer -> Integer

tal que (maxRotaciones n) es el máximo de las rotaciones restringidas del número n. Por ejemplo,

   maxRotaciones 56789       ==  68957
   maxRotaciones 1347902468  ==  3790246814
   maxRotaciones 6           ==  6
   maxRotaciones 2017        ==  2017

maxRotaciones 56789 == 68957

maxRotaciones 1347902468 == 3790246814

maxRotaciones 6 == 6

maxRotaciones 2017 == 2017

Soluciones

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

maxRotaciones :: Integer -> Integer
maxRotaciones = read . aux . show
  where aux n@[_]        = n
        aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

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

maxRotaciones2 :: Integer -> Integer
maxRotaciones2 n
  | n < 10    = n
  | otherwise = maximum [ read (us ++ vs)
                        | (us,vs) <- take m (iterate siguiente ("",xs)) ]
  where xs = show n
        m  = length xs

-- siguiente ("","56789")  ==  ("6","7895")
-- siguiente ("6","7895")  ==  ("68","957")
-- siguiente ("68","957")  ==  ("685","79")
-- siguiente ("685","79")  ==  ("6859","7")
-- siguiente ("6859","7")  ==  ("6859","7")
siguiente :: (String,String) -> (String,String)
siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])
siguiente (xs,[a])    = (xs,[a])

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

maxRotaciones3 :: Integer -> Integer
maxRotaciones3 = read . aux . show
  where aux (x:y:xs) | x > y     = x : y : xs
                     | otherwise = y : (aux $ xs ++ [x])
        aux [x]                  = [x]
        aux _                    = []

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

--    λ> length (show (maxRotaciones (n (5*10^3))))
--    5001
--    (2.74 secs, 802,282,616 bytes)
--    λ> length (show (maxRotaciones2 (n (5*10^3))))
--    5001
--    (18.23 secs, 12,375,579,216 bytes)
--    λ> length (show (maxRotaciones3 (n (5*10^3))))
--    5001
--    (0.67 secs, 729,155,056 bytes)

-- 1ª solución

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

maxRotaciones :: Integer -> Integer

maxRotaciones = read . aux . show

where aux n@[_] = n

aux n@(x1:x2:xs) = max n (x2:aux (xs ++ [x1]))

-- 2ª solución

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

maxRotaciones2 :: Integer -> Integer

maxRotaciones2 n

| n < 10 = n

| otherwise = maximum [ read (us ++ vs)

| (us,vs) <- take m (iterate siguiente ("",xs)) ]

where xs = show n

m = length xs

-- siguiente ("","56789") == ("6","7895")

-- siguiente ("6","7895") == ("68","957")

-- siguiente ("68","957") == ("685","79")

-- siguiente ("685","79") == ("6859","7")

-- siguiente ("6859","7") == ("6859","7")

siguiente :: (String,String) -> (String,String)

siguiente (xs,a:b:ys) = (xs ++ [b], ys ++ [a])

siguiente (xs,[a]) = (xs,[a])

-- 3ª solución

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

maxRotaciones3 :: Integer -> Integer

maxRotaciones3 = read . aux . show

where aux (x:y:xs) | x > y = x : y : xs

| otherwise = y : (aux $ xs ++ [x])

aux [x] = [x]

aux _ = []

-- Comparación de eficiencia

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

-- λ> length (show (maxRotaciones (n (5*10^3))))

-- 5001

-- (2.74 secs, 802,282,616 bytes)

-- λ> length (show (maxRotaciones2 (n (5*10^3))))

-- 5001

-- (18.23 secs, 12,375,579,216 bytes)

-- λ> length (show (maxRotaciones3 (n (5*10^3))))

-- 5001

-- (0.67 secs, 729,155,056 bytes)

Caminos minimales en un arbol numérico

PorJosé A. Alonso 10-marzo-201725-abril-2021

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

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

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

Se pueden definir árboles. Por ejemplo,

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

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

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

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

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

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

/ \

5 3

| |

4 2

/ \ |

3 2 1

| |

2 1

Definir las siguientes funciones

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

mayoresDivisores :: Int -> [Int]

arbol :: Int -> Tree Int

caminos :: Int -> [[Int]]

caminosMinimales :: Int -> [[Int]]

tales que

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

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

mayoresDivisores 24 == [12,8,6]

mayoresDivisores 16 == [8,4]

mayoresDivisores 10 == [5]

mayoresDivisores 17 == []

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

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

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

+- 5

| |

| `- 4

| |

| +- 3

| | |

| | `- 2

| | |

| | `- 1

| |

| `- 2

| |

| `- 1

`- 3

`- 2

`- 1

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

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

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

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

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

λ> caminosMinimales 6

[[6,3,2,1]]

λ> caminosMinimales 17

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

λ> caminosMinimales 50

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

Soluciones

import Data.Tree

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

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

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

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

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

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

import Data.Tree

mayoresDivisores :: Int -> [Int]

mayoresDivisores x =

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

, x `mod` u == 0

, let v = x `div` u]

arbol :: Int -> Tree Int

arbol 1 = Node 1 []

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

caminos :: Int -> [[Int]]

caminos = caminosArbol . arbol

-- λ> caminosArbol (arbol 6)

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

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

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

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

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

caminosBosque = concatMap caminosArbol

caminosMinimales :: Int -> [[Int]]

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

where yss = caminos x

m = minimum (map length yss)

Máxima ramificación

PorJosé A. Alonso 23-noviembre-201630-noviembre-2016

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          
    / \       / \           / \   
   2   3     2   3         2   3  
       |        /|\       /|\  |   
       4       4 5 6     4 5 6 7

1 1 1

/ \ / \ / \

2 3 2 3 2 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

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

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

En el primer ejemplo la máxima ramificación es 2 (en el nodo 1 que tiene 2 hijos), la del segundo es 3 (en el nodo 3 que tiene 3 hijos) y la del tercero es 3 (en el nodo 3 que tiene 3 hijos).

Definir la función

   maximaRamificacion :: Arbol a -> Int

1	maximaRamificacion :: Arbol a -> Int

tal que (maximaRamificacion a) es la máxima ramificación del árbol a. Por ejemplo,

   maximaRamificacion ej1  ==  2
   maximaRamificacion ej2  ==  3
   maximaRamificacion ej3  ==  3

maximaRamificacion ej1 == 2

maximaRamificacion ej2 == 3

maximaRamificacion ej3 == 3

Soluciones

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

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

maximaRamificacion :: Arbol a -> Int
maximaRamificacion (N _ []) = 0
maximaRamificacion (N x xs) =
  max (length xs) (maximum (map maximaRamificacion xs))

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

ej1 = N 1 [N 2 [],N 3 [N 4 []]]

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

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

maximaRamificacion :: Arbol a -> Int

maximaRamificacion (N _ []) = 0

maximaRamificacion (N x xs) =

max (length xs) (maximum (map maximaRamificacion xs))

Representación decimal de números racionales

PorJosé A. Alonso 1-abril-20168-abril-2016

Los números decimales se representan por ternas, donde el primer elemento es la parte entera, el segundo es el anteperíodo y el tercero es el período. Por ejemplo,

    6/2  = 3                  se representa por (3,[],[])
    1/2  = 0.5                se representa por (0,[5],[])
    1/3  = 0.333333...        se representa por (0,[],[3])  
   23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

6/2 = 3 se representa por (3,[],[])

1/2 = 0.5 se representa por (0,[5],[])

1/3 = 0.333333... se representa por (0,[],[3])

23/14 = 1.6428571428571... se representa por (1,[6],[4,2,8,5,7,1])

Su tipo es

   type Decimal = (Integer,[Integer],[Integer])

1	type Decimal = (Integer,[Integer],[Integer])

Los números racionales se representan por un par de enteros, donde el primer elemento es el numerador y el segundo el denominador. Por ejemplo, el número 2/3 se representa por (2,3). Su tipo es

   type Racional = (Integer,Integer)

1	type Racional = (Integer,Integer)

Definir las funciones

   decimal  :: Racional -> Decimal
   racional :: Decimal -> Racional

1 2	decimal :: Racional -> Decimal racional :: Decimal -> Racional

tales que

(decimal r) es la representación decimal del número racional r. Por ejemplo,

        decimal (1,4)    ==  (0,[2,5],[])
        decimal (1,3)    ==  (0,[],[3])
        decimal (23,14)  ==  (1,[6],[4,2,8,5,7,1])

decimal (1,4) == (0,[2,5],[])

decimal (1,3) == (0,[],[3])

decimal (23,14) == (1,[6],[4,2,8,5,7,1])

(racional d) es el número racional cuya representación decimal es d. Por ejemplo,

        racional (0,[2,5],[])           ==  (1,4)
        racional (0,[],[3])             ==  (1,3)
        racional (1,[6],[4,2,8,5,7,1])  ==  (23,14)

racional (0,[2,5],[]) == (1,4)

racional (0,[],[3]) == (1,3)

racional (1,[6],[4,2,8,5,7,1]) == (23,14)

Con la función decimal se puede calcular los períodos de los números racionales. Por ejemplo,

   ghci> let (_,_,p) = decimal (23,14) in concatMap show p
   "428571"
   ghci> let (_,_,p) = decimal (1,47) in concatMap show p
   "0212765957446808510638297872340425531914893617"
   ghci> let (_,_,p) = decimal (1,541) in length (concatMap show p)
   540

ghci> let (_,_,p) = decimal (23,14) in concatMap show p

"428571"

ghci> let (_,_,p) = decimal (1,47) in concatMap show p

"0212765957446808510638297872340425531914893617"

ghci> let (_,_,p) = decimal (1,541) in length (concatMap show p)

540

Comprobar con QuickCheck si las funciones decimal y racional son inversas.

Soluciones

-- ---------------------------------------------------------------------
-- § Librerías auxiliares                                             --
-- ---------------------------------------------------------------------

import Data.List
import Test.QuickCheck

-- ---------------------------------------------------------------------
-- § Tipos                                                            --
-- ---------------------------------------------------------------------

-- Un número racional se representa por un par de enteros, donde el
-- primer elemento es el numerador y el segundo el denominador.
type Racional = (Integer,Integer)

-- Un número decimal es una terna donde el primer elemento es la parte
-- entera, el segundo es el anteperíodo y el tercero es el período.
type Decimal = (Integer,[Integer],[Integer])

-- ---------------------------------------------------------------------
-- § De racional a decimal                                            --
-- ---------------------------------------------------------------------

-- (mayorExponente a x) es el mayor n tal que a^n divide a x. Por ejemplo,
--    mayorExponente 2 40  ==  3
--    mayorExponente 5 40  ==  1
--    mayorExponente 5 41  ==  0
mayorExponente :: Integer -> Integer -> Integer
mayorExponente a x = head [n | n <- [1..], mod x (a^n) /= 0] - 1

-- (longitudAnteperiodo n) es la longitud del anteperíodo de 1/n (y de
-- cualquier fracción irreducible de denominador n). Por ejemplo, 
--    longitudAnteperiodo 2   ==  1
--    longitudAnteperiodo 3   ==  0
--    longitudAnteperiodo 14  ==  1
longitudAnteperiodo :: Integer -> Integer
longitudAnteperiodo n = max (mayorExponente 2 n) (mayorExponente 5 n)

-- (longitudPeriodo n) es la longitud del período de 1/n (y de
-- cualquier fracción irreducible de denominador n). Por ejemplo, 
--    longitudPeriodo 2  ==  0
--    longitudPeriodo 3  ==  1
--    longitudPeriodo 7  ==  6
longitudPeriodo :: Integer -> Integer
longitudPeriodo n
    | m == 1    = 0 
    | otherwise = head [k | k <- [1..], (10^k) `mod` m == 1]
    where m = n `div` (2^(mayorExponente 2 n) * 5^(mayorExponente 5 n))

-- (expansionDec (x,y)) es la expansión decimal de x/y. Por ejemplo, 
--    take 10 (expansionDec (1,4))    ==  [0,2,5]
--    take 10 (expansionDec (1,7))    ==  [0,1,4,2,8,5,7,1,4,2]
--    take 12 (expansionDec (90,7))   ==  [12,8,5,7,1,4,2,8,5,7,1,4]
--    take 12 (expansionDec (23,14))  ==  [1,6,4,2,8,5,7,1,4,2,8,5]
expansionDec :: Racional -> [Integer]
expansionDec (x,y) 
    | r == 0    = [q] 
    | otherwise = q : expansionDec (r*10,y)
    where (q,r) = quotRem x y

-- (parteEntera (a,b)) es la parte entera de a/b. Por ejemplo,
--    parteEntera (125,3)  ==  41
parteEntera :: Racional -> Integer
parteEntera (a,b) = a `div` b

-- (antePeriodo (a,b)) es el anteperíodo de a/b; es decir, la lista de
-- cifras que se encuentran entre la parte entera y el primer período de
-- a/b. Por ejemplo,
--    antePeriodo (23,14)  ==  [6]
--    antePeriodo (1,5)    ==  [2]
antePeriodo :: Racional -> [Integer]
antePeriodo (a,b) = genericTake s (tail xs)
    where xs = expansionDec (a,b)
          s  = longitudAnteperiodo b

-- (periodo (a,b)) es el período de a/b; es decir, la lista de cifras que
-- se encuentran entre la parte entera y el primer período de a/b. Por
-- ejemplo, 
--    periodo (1,3)                   ==  [3]
--    periodo (1,5)                   ==  []
--    periodo (1,7)                   ==  [1,4,2,8,5,7]
--    periodo (23,14)                 ==  [4,2,8,5,7,1]
--    concatMap show $ periodo (1,29) == "0344827586206896551724137931"
periodo :: Racional -> [Integer]
periodo (a,b) = genericTake t (genericDrop (1+s) xs)
    where xs = expansionDec (a,b)
          s  = longitudAnteperiodo b
          t  = longitudPeriodo b

-- (reducido (a,b)) es la forma reducida del número racional a/b. Por
-- ejemplo, 
--    reducido (40,80)  ==  (1,2)
reducido :: Racional -> Racional
reducido (a,b) = (a `div` m, b `div` m) 
    where m = gcd a b

-- (decimal (x,y)) es la forma decimal de x/y; es decir, la terna
-- formada por la parte entera, la parte decimal pura y la parte decimal
-- periódica. Por ejemplo, 
--    decimal (1,4)    ==  (0,[2,5],[])
--    decimal (1,3)    ==  (0,[],[3])
--    decimal (23,14)  ==  (1,[6],[4,2,8,5,7,1])
decimal :: Racional -> Decimal
decimal (a,b) = (parteEntera r, antePeriodo r, periodo r)
    where r = reducido (a,b)

-- ---------------------------------------------------------------------
-- § De decimal a racional                                            --
-- ---------------------------------------------------------------------

-- (digitosAnumero xs) es el número correspondiente a la lista de
-- dígitos xs. Por ejemplo,
--    digitosAnumero [3,2,5]  ==  325
digitosAnumero :: [Integer] -> Integer
digitosAnumero = foldl (\a y -> 10*a+y) 0

-- 2ª definición de digitosAnumero (por comprensión)
digitosAnumero2 :: [Integer] -> Integer
digitosAnumero2 xs = sum [x*(10^i) | (x,i) <- zip xs [n-1,n-2..0]]
    where n = length xs

-- (racional (x,ys,zs)) es el número racional cuya representación
-- decimal es (x,ys,zs). Por ejemplo,
--    racional (0,[2,5],[])           ==  (1,4)
--    racional (0,[],[3])             ==  (1,3)
--    racional (1,[6],[4,2,8,5,7,1])  ==  (23,14)
racional :: Decimal -> Racional
racional (x,ys,[]) = reducido (a,b) where
    a = digitosAnumero (x:ys)
    b = 10^(length ys)
racional (x,ys,zs) = reducido (a,b) where 
    a = digitosAnumero (x:ys++zs) - digitosAnumero (x:ys)
    b = digitosAnumero (replicate (length zs) 9 ++ replicate (length ys) 0)

-- ---------------------------------------------------------------------
-- § Propiedades                                                      --
-- ---------------------------------------------------------------------

-- La 1ª propiedad es
prop_RacionalDecimal :: Racional -> Property
prop_RacionalDecimal (a,b) =
    a >= 0 && b > 0  ==>
    racional (decimal (a,b)) == reducido (a,b)

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

-- En lugar de reducido se puede usar un generador de números racionales
numeroRacional :: Gen Racional
numeroRacional = do a <- arbitrary
                    b <- arbitrary
                    return (reducido (abs a, 1+ abs b))

-- La propiedad es
prop_RacionalDecimal2 :: Property
prop_RacionalDecimal2 =
    forAll numeroRacional
           (\(a,b) -> racional (decimal (a,b)) == (a,b))

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

-- Para la 2ª propiedad se define un generador de números decimales
numeroDecimal :: Gen Decimal
numeroDecimal = do a <- arbitrary
                   b <- arbitrary
                   return (decimal (abs a, 1+ abs b))

-- La 2ª propiedad es
prop_DecimalRacional :: Property
prop_DecimalRacional =
    forAll numeroDecimal 
           (\(x,ys,zs) -> decimal (racional (x,ys,zs)) == (x,ys,zs))

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

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

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

-- § Librerías auxiliares --

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

import Data.List

import Test.QuickCheck

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

-- § Tipos --

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

-- Un número racional se representa por un par de enteros, donde el

-- primer elemento es el numerador y el segundo el denominador.

type Racional = (Integer,Integer)

-- Un número decimal es una terna donde el primer elemento es la parte

-- entera, el segundo es el anteperíodo y el tercero es el período.

type Decimal = (Integer,[Integer],[Integer])

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

-- § De racional a decimal --

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

-- (mayorExponente a x) es el mayor n tal que a^n divide a x. Por ejemplo,

-- mayorExponente 2 40 == 3

-- mayorExponente 5 40 == 1

-- mayorExponente 5 41 == 0

mayorExponente :: Integer -> Integer -> Integer

mayorExponente a x = head [n | n <- [1..], mod x (a^n) /= 0] - 1

-- (longitudAnteperiodo n) es la longitud del anteperíodo de 1/n (y de

-- cualquier fracción irreducible de denominador n). Por ejemplo,

-- longitudAnteperiodo 2 == 1

-- longitudAnteperiodo 3 == 0

-- longitudAnteperiodo 14 == 1

longitudAnteperiodo :: Integer -> Integer

longitudAnteperiodo n = max (mayorExponente 2 n) (mayorExponente 5 n)

-- (longitudPeriodo n) es la longitud del período de 1/n (y de

-- cualquier fracción irreducible de denominador n). Por ejemplo,

-- longitudPeriodo 2 == 0

-- longitudPeriodo 3 == 1

-- longitudPeriodo 7 == 6

longitudPeriodo :: Integer -> Integer

longitudPeriodo n

| m == 1 = 0

| otherwise = head [k | k <- [1..], (10^k) `mod` m == 1]

where m = n `div` (2^(mayorExponente 2 n) * 5^(mayorExponente 5 n))

-- (expansionDec (x,y)) es la expansión decimal de x/y. Por ejemplo,

-- take 10 (expansionDec (1,4)) == [0,2,5]

-- take 10 (expansionDec (1,7)) == [0,1,4,2,8,5,7,1,4,2]

-- take 12 (expansionDec (90,7)) == [12,8,5,7,1,4,2,8,5,7,1,4]

-- take 12 (expansionDec (23,14)) == [1,6,4,2,8,5,7,1,4,2,8,5]

expansionDec :: Racional -> [Integer]

expansionDec (x,y)

| r == 0 = [q]

| otherwise = q : expansionDec (r*10,y)

where (q,r) = quotRem x y

-- (parteEntera (a,b)) es la parte entera de a/b. Por ejemplo,

-- parteEntera (125,3) == 41

parteEntera :: Racional -> Integer

parteEntera (a,b) = a `div` b

-- (antePeriodo (a,b)) es el anteperíodo de a/b; es decir, la lista de

-- cifras que se encuentran entre la parte entera y el primer período de

-- a/b. Por ejemplo,

-- antePeriodo (23,14) == [6]

-- antePeriodo (1,5) == [2]

antePeriodo :: Racional -> [Integer]

antePeriodo (a,b) = genericTake s (tail xs)

where xs = expansionDec (a,b)

s = longitudAnteperiodo b

-- (periodo (a,b)) es el período de a/b; es decir, la lista de cifras que

-- se encuentran entre la parte entera y el primer período de a/b. Por

-- ejemplo,

-- periodo (1,3) == [3]

-- periodo (1,5) == []

-- periodo (1,7) == [1,4,2,8,5,7]

-- periodo (23,14) == [4,2,8,5,7,1]

-- concatMap show $ periodo (1,29) == "0344827586206896551724137931"

periodo :: Racional -> [Integer]

periodo (a,b) = genericTake t (genericDrop (1+s) xs)

where xs = expansionDec (a,b)

s = longitudAnteperiodo b

t = longitudPeriodo b

-- (reducido (a,b)) es la forma reducida del número racional a/b. Por

-- ejemplo,

-- reducido (40,80) == (1,2)

reducido :: Racional -> Racional

reducido (a,b) = (a `div` m, b `div` m)

where m = gcd a b

-- (decimal (x,y)) es la forma decimal de x/y; es decir, la terna

-- formada por la parte entera, la parte decimal pura y la parte decimal

-- periódica. Por ejemplo,

-- decimal (1,4) == (0,[2,5],[])

-- decimal (1,3) == (0,[],[3])

-- decimal (23,14) == (1,[6],[4,2,8,5,7,1])

decimal :: Racional -> Decimal

decimal (a,b) = (parteEntera r, antePeriodo r, periodo r)

where r = reducido (a,b)

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

-- § De decimal a racional --

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

-- (digitosAnumero xs) es el número correspondiente a la lista de

-- dígitos xs. Por ejemplo,

-- digitosAnumero [3,2,5] == 325

digitosAnumero :: [Integer] -> Integer

digitosAnumero = foldl (\a y -> 10*a+y) 0

-- 2ª definición de digitosAnumero (por comprensión)

digitosAnumero2 :: [Integer] -> Integer

digitosAnumero2 xs = sum [x*(10^i) | (x,i) <- zip xs [n-1,n-2..0]]

where n = length xs

-- (racional (x,ys,zs)) es el número racional cuya representación

-- decimal es (x,ys,zs). Por ejemplo,

-- racional (0,[2,5],[]) == (1,4)

-- racional (0,[],[3]) == (1,3)

-- racional (1,[6],[4,2,8,5,7,1]) == (23,14)

racional :: Decimal -> Racional

racional (x,ys,[]) = reducido (a,b) where

a = digitosAnumero (x:ys)

b = 10^(length ys)

racional (x,ys,zs) = reducido (a,b) where

a = digitosAnumero (x:ys++zs) - digitosAnumero (x:ys)

b = digitosAnumero (replicate (length zs) 9 ++ replicate (length ys) 0)

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

-- § Propiedades --

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

-- La 1ª propiedad es

prop_RacionalDecimal :: Racional -> Property

prop_RacionalDecimal (a,b) =

a >= 0 && b > 0 ==>

racional (decimal (a,b)) == reducido (a,b)

-- La comprobación es

-- ghci> quickCheck prop_RacionalDecimal

-- +++ OK, passed 100 tests.

-- En lugar de reducido se puede usar un generador de números racionales

numeroRacional :: Gen Racional

numeroRacional = do a <- arbitrary

b <- arbitrary

return (reducido (abs a, 1+ abs b))

-- La propiedad es

prop_RacionalDecimal2 :: Property

prop_RacionalDecimal2 =

forAll numeroRacional

(\(a,b) -> racional (decimal (a,b)) == (a,b))

-- La comprobación es

-- ghci> quickCheck prop_RacionalDecimal2

-- +++ OK, passed 100 tests.

-- Para la 2ª propiedad se define un generador de números decimales

numeroDecimal :: Gen Decimal

numeroDecimal = do a <- arbitrary

b <- arbitrary

return (decimal (abs a, 1+ abs b))

-- La 2ª propiedad es

prop_DecimalRacional :: Property

prop_DecimalRacional =

forAll numeroDecimal

(\(x,ys,zs) -> decimal (racional (x,ys,zs)) == (x,ys,zs))

-- La comprobación es

-- ghci> quickCheck prop_DecimalRacional

-- +++ OK, passed 100 tests.

Máxima suma de elementos consecutivos

PorJosé A. Alonso 17-marzo-20161-mayo-2016

Definir la función

   sumaMaxima :: [Integer] -> Integer

1	sumaMaxima :: [Integer] -> Integer

tal que (sumaMaxima xs) es el valor máximo de la suma de elementos consecutivos de la lista xs. Por ejemplo,

   sumaMaxima []             ==  0 
   sumaMaxima [2,-2,3,-3,4]  ==  4
   sumaMaxima [-1,-2,-3]     ==  0
   sumaMaxima [2,-1,3,-2,3]  ==  5
   sumaMaxima [1,-1,3,-2,4]  ==  5
   sumaMaxima [2,-1,3,-2,4]  ==  6
   sumaMaxima [1..10^6]      ==  500000500000

sumaMaxima [] == 0

sumaMaxima [2,-2,3,-3,4] == 4

sumaMaxima [-1,-2,-3] == 0

sumaMaxima [2,-1,3,-2,3] == 5

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

sumaMaxima [2,-1,3,-2,4] == 6

sumaMaxima [1..10^6] == 500000500000

Comprobar con QuickCheck que

   sumaMaxima xs == sumaMaxima (reverse xs)

1	sumaMaxima xs == sumaMaxima (reverse xs)

Soluciones

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

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

sumaMaxima1 :: [Integer] -> Integer
sumaMaxima1 [] = 0
sumaMaxima1 xs =
    maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],
                                            j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]
sublista xs i j =
    [xs!!k | k <- [i..j]]

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

sumaMaxima2 :: [Integer] -> Integer
sumaMaxima2 [] = 0
sumaMaxima2 xs = sumaMaximaAux 0 0 xs
    where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer
sumaMaximaAux m v [] = max m v
sumaMaximaAux m v (x:xs)
    | x >= 0    = sumaMaximaAux m (v+x) xs
    | v+x > 0   = sumaMaximaAux (max m v) (v+x) xs
    | otherwise = sumaMaximaAux (max m v) 0 xs

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

sumaMaxima3 :: [Integer] -> Integer
sumaMaxima3 [] = 0
sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo 
--    segmentos "abc"  ==  ["", "a","ab","abc","b","bc","c"]
segmentos :: [a] -> [[a]]
segmentos xs =
    [] : concat [tail (inits ys) | ys <- init (tails xs)]

-- 4ª definición
-- =============

sumaMaxima4 :: [Integer] -> Integer
sumaMaxima4 [] = 0
sumaMaxima4 xs = 
    maximum (concat [scanl (+) 0 ys | ys <- tails xs])

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

-- La propiedad es
prop_sumaMaxima :: [Integer] -> Bool
prop_sumaMaxima xs =
    sumaMaxima2 xs == n &&
    sumaMaxima3 xs == n &&
    sumaMaxima4 xs == n
    where n = sumaMaxima1 xs

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

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

--    λ> let n = 10^2 in sumaMaxima1 [-n..n] 
--    5050
--    (2.10 secs, 390,399,104 bytes)
--    λ> let n = 10^2 in sumaMaxima2 [-n..n] 
--    5050
--    (0.02 secs, 0 bytes)
--    λ> let n = 10^2 in sumaMaxima3 [-n..n] 
--    5050
--    (0.27 secs, 147,705,184 bytes)
--    λ> let n = 10^2 in sumaMaxima4 [-n..n] 
--    5050
--    (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool
prop_inversa xs =
    sumaMaxima2 xs == sumaMaxima2 (reverse xs)

import Data.List (inits, tails)

import Test.QuickCheck

-- 1ª definición

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

sumaMaxima1 :: [Integer] -> Integer

sumaMaxima1 [] = 0

sumaMaxima1 xs =

maximum (0 : map sum [sublista xs i j | i <- [0..length xs - 1],

j <- [i..length xs - 1]])

sublista :: [Integer] -> Int -> Int -> [Integer]

sublista xs i j =

[xs!!k | k <- [i..j]]

-- 2ª definición

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

sumaMaxima2 :: [Integer] -> Integer

sumaMaxima2 [] = 0

sumaMaxima2 xs = sumaMaximaAux 0 0 xs

where m = maximum xs

sumaMaximaAux :: Integer -> Integer -> [Integer] -> Integer

sumaMaximaAux m v [] = max m v

sumaMaximaAux m v (x:xs)

| x >= 0 = sumaMaximaAux m (v+x) xs

| v+x > 0 = sumaMaximaAux (max m v) (v+x) xs

| otherwise = sumaMaximaAux (max m v) 0 xs

-- 3ª definición

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

sumaMaxima3 :: [Integer] -> Integer

sumaMaxima3 [] = 0

sumaMaxima3 xs = maximum (map sum (segmentos xs))

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo

-- segmentos "abc" == ["", "a","ab","abc","b","bc","c"]

segmentos :: [a] -> [[a]]

segmentos xs =

[] : concat [tail (inits ys) | ys <- init (tails xs)]

-- 4ª definición

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

sumaMaxima4 :: [Integer] -> Integer

sumaMaxima4 [] = 0

sumaMaxima4 xs =

maximum (concat [scanl (+) 0 ys | ys <- tails xs])

-- Comprobación

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

-- La propiedad es

prop_sumaMaxima :: [Integer] -> Bool

prop_sumaMaxima xs =

sumaMaxima2 xs == n &&

sumaMaxima3 xs == n &&

sumaMaxima4 xs == n

where n = sumaMaxima1 xs

-- La comprobación es

-- λ> quickCheck prop_sumaMaxima

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- λ> let n = 10^2 in sumaMaxima1 [-n..n]

-- 5050

-- (2.10 secs, 390,399,104 bytes)

-- λ> let n = 10^2 in sumaMaxima2 [-n..n]

-- 5050

-- (0.02 secs, 0 bytes)

-- λ> let n = 10^2 in sumaMaxima3 [-n..n]

-- 5050

-- (0.27 secs, 147,705,184 bytes)

-- λ> let n = 10^2 in sumaMaxima4 [-n..n]

-- 5050

-- (0.04 secs, 11,582,520 bytes)

prop_inversa :: [Integer] -> Bool

prop_inversa xs =

sumaMaxima2 xs == sumaMaxima2 (reverse xs)

Siembra de listas

PorJosé A. Alonso 23-diciembre-201525-marzo-2022

Definir la función

   siembra :: [Int] -> [Int]

1	siembra :: [Int] -> [Int]

tal que (siembra xs) es la lista ys obtenida al repartir cada elemento x de la lista xs poniendo un 1 en las x siguientes posiciones de la lista ys. Por ejemplo,

   siembra [4]      ==  [0,1,1,1,1] 
   siembra [0,2]    ==  [0,0,1,1]
   siembra [4,2]    ==  [0,1,2,2,1]

siembra [4] == [0,1,1,1,1]

siembra [0,2] == [0,0,1,1]

siembra [4,2] == [0,1,2,2,1]

El tercer ejemplo se obtiene sumando la siembra de 4 en la posición 0 (como el ejemplo 1) y el 2 en la posición 1 (como el ejemplo 2). Otros ejemplos son

   siembra [0,4,2]          ==  [0,0,1,2,2,1]
   siembra [3]              ==  [0,1,1,1]
   siembra [3,4,2]          ==  [0,1,2,3,2,1]
   siembra [3,2,1]          ==  [0,1,2,3]
   sum $ siembra [1..2500]  ==  3126250

siembra [0,4,2] == [0,0,1,2,2,1]

siembra [3] == [0,1,1,1]

siembra [3,4,2] == [0,1,2,3,2,1]

siembra [3,2,1] == [0,1,2,3]

sum $ siembra [1..2500] == 3126250

Comprobar con QuickCheck que la suma de los elementos de (siembra xs) es igual que la suma de los de xs.

Nota 1: Se supone que el argumento es una lista de números no negativos y que se puede ampliar tanto como sea necesario para repartir los elementos.

Nota 2: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

import Test.QuickCheck

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

siembra1 :: [Int] -> [Int]
siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los
-- elementos de xs. Por ejemplo,
--    brotes [3,4,2]  ==  [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]
brotes :: [Int] -> [[Int]]
brotes xs = aux xs 1
    where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)
          aux _ _      = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al
-- final de cada elemento se continua con ceros). Por ejemplo,
--    suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]  ==  [0,1,2,3,2,1]
suma :: [[Int]] -> [Int]
suma = foldr1 aux
    where aux [] ys = ys
          aux xs [] = xs
          aux (x:xs) (y:ys) = (x+y) : aux xs ys

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

siembra2 :: [Int] -> [Int]
siembra2 [] = []
siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]
siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]
mezcla xs ys =
    take (max (length xs) (length ys))
         (zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

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

siembra3 :: [Int] -> [Int]
siembra3 [] = []
siembra3 xs = aux xs 0 (repeat 0) where
    aux []     _ ys = cosecha ys
    aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys) 
        where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los
-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,
--    cosecha [0,0,3,5,2,0,9]            ==  [0,0,3,5,2]
--    cosecha ([0,0,3,5,2] ++ repeat 0)  ==  [0,0,3,5,2]
cosecha :: [Int] -> [Int]              
cosecha xs = ys ++ takeWhile (>0) zs
    where (ys,zs) = span (==0) xs

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

siembra4 :: [Int] -> [Int]
siembra4 [] = []
siembra4 xs = aux xs [] (repeat 0) where
    aux []     ys zs     = reverse ys ++ takeWhile (>0) zs
    aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs) 
        where brotes = replicate x 1 ++ repeat 0

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

--    λ> sum $ siembra1 [1..2000]
--    2001000
--    (9.44 secs, 1,894,065,928 bytes)
--    ghci> sum $ siembra2 [1..2000]
--    2001000
--    (5.92 secs, 936900576 bytes)
--    ghci> sum $ siembra3 [1..2000]
--    2001000
--    (1.59 secs, 836847072 bytes)
--    ghci> sum $ siembra4 [1..2000]
--    2001000
--    (1.68 secs, 570492392 bytes)

-- En lo que sigue usaremos la 2ª definición
siembra :: [Int] -> [Int]
siembra = siembra2

-- Verificación
-- ============

-- La propiedad es
prop_siembra :: [Int] -> Bool
prop_siembra xs =
    sum (siembra1 ys) == sum ys
    where ys = map (\x -> 1 + abs x) xs

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

100

import Test.QuickCheck

-- 1ª solución

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

siembra1 :: [Int] -> [Int]

siembra1 = suma . brotes

-- (brotes xs) es la lista de los brotes obtenido sembrando los

-- elementos de xs. Por ejemplo,

-- brotes [3,4,2] == [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]]

brotes :: [Int] -> [[Int]]

brotes xs = aux xs 1

where aux (x:xs) n = (replicate n 0 ++ replicate x 1) : aux xs (n+1)

aux _ _ = []

-- (suma xss) es la suma de los elementos de xss (suponiendo que al

-- final de cada elemento se continua con ceros). Por ejemplo,

-- suma [[0,1,1,1],[0,0,1,1,1,1],[0,0,0,1,1]] == [0,1,2,3,2,1]

suma :: [[Int]] -> [Int]

suma = foldr1 aux

where aux [] ys = ys

aux xs [] = xs

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

-- 2ª solución

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

siembra2 :: [Int] -> [Int]

siembra2 [] = []

siembra2 (x:xs) = mezcla (siembraElemento x) (0 : siembra2 xs)

siembraElemento :: Int -> [Int]

siembraElemento x = 0 : replicate x 1

mezcla :: [Int] -> [Int] -> [Int]

mezcla xs ys =

take (max (length xs) (length ys))

(zipWith (+) (xs ++ repeat 0) (ys ++ repeat 0))

-- 3ª solución

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

siembra3 :: [Int] -> [Int]

siembra3 [] = []

siembra3 xs = aux xs 0 (repeat 0) where

aux [] _ ys = cosecha ys

aux (x:xs) n ys = aux xs (n+1) (zipWith (+) brotes ys)

where brotes = replicate (n+1) 0 ++ replicate x 1 ++ repeat 0

-- (cosecha xs) es la lista formada por los ceros iniciales de xs y los

-- elementos siguientes hasta que vuelve a aparecer el 0. Por ejemplo,

-- cosecha [0,0,3,5,2,0,9] == [0,0,3,5,2]

-- cosecha ([0,0,3,5,2] ++ repeat 0) == [0,0,3,5,2]

cosecha :: [Int] -> [Int]

cosecha xs = ys ++ takeWhile (>0) zs

where (ys,zs) = span (==0) xs

-- 4ª solución

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

siembra4 :: [Int] -> [Int]

siembra4 [] = []

siembra4 xs = aux xs [] (repeat 0) where

aux [] ys zs = reverse ys ++ takeWhile (>0) zs

aux (x:xs) ys (z:zs) = aux xs (z:ys) (zipWith (+) brotes zs)

where brotes = replicate x 1 ++ repeat 0

-- Comparación de eficiencia

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

-- λ> sum $ siembra1 [1..2000]

-- 2001000

-- (9.44 secs, 1,894,065,928 bytes)

-- ghci> sum $ siembra2 [1..2000]

-- 2001000

-- (5.92 secs, 936900576 bytes)

-- ghci> sum $ siembra3 [1..2000]

-- 2001000

-- (1.59 secs, 836847072 bytes)

-- ghci> sum $ siembra4 [1..2000]

-- 2001000

-- (1.68 secs, 570492392 bytes)

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

siembra :: [Int] -> [Int]

siembra = siembra2

-- Verificación

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

-- La propiedad es

prop_siembra :: [Int] -> Bool

prop_siembra xs =

sum (siembra1 ys) == sum ys

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

-- La comprobación es

-- λ> quickCheck prop_siembra

-- +++ OK, passed 100 tests.

Máximos locales de una matriz

PorJosé A. Alonso 20-marzo-20151-mayo-2015

Un elemento de una matriz es un máximo local si es mayor que todos sus vecinos. Por ejemplo, en la matriz

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

[[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]]

los máximos locales son 8 (en la posición (1,4)), 2 (en la posición (2,2)) y 7 (en la posición (4,3)).

Definimos el tipo de las matrices, mediante

   type Matriz a = Array (Int,Int) Int

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

y el ejemplo anterior por

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

ej1 :: Matriz Int

ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]])

Definir la función

   maximosLocales :: Matriz Int -> [((Int,Int),Int)]

1	maximosLocales :: Matriz Int -> [((Int,Int),Int)]

tal que (maximosLocales p) es la lista de las posiciones en las que hay un máximo local, con el valor correspondiente. Por ejemplo,

   maximosLocales ej1 == [((1,4),8),((2,2),2),((4,3),7)]

1	maximosLocales ej1 == [((1,4),8),((2,2),2),((4,3),7)]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

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

maximosLocales :: Matriz Int -> [((Int,Int),Int)]
maximosLocales p = 
    [((i,j),p!(i,j)) | (i,j) <- indices p,
               and [p!(a,b) < p!(i,j) | (a,b) <- vecinos (i,j)]] 
    where (_,(m,n)) = bounds p
          vecinos (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.Array

type Matriz a = Array (Int,Int) a

ej1 :: Matriz Int

ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]])

maximosLocales :: Matriz Int -> [((Int,Int),Int)]

maximosLocales p =

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

and [p!(a,b) < p!(i,j) | (a,b) <- vecinos (i,j)]]

where (_,(m,n)) = bounds p

vecinos (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)]

Mayor diferencia progresiva

PorJosé A. Alonso 26-febrero-20151-mayo-2016

La diferencia progresiva entre dos elementos de una lista es la resta entre el que ocupa la mayor posición y la menor. Por ejemplo, en la lista [1,5,8,2,9] la diferencia entre los elementos 5 y 8 es 3 y entre 5 y 2 es -3.

Definir la función

   mayorDiferencia :: [Int] -> Int

1	mayorDiferencia :: [Int] -> Int

tal que (mayorDiferencia xs) es la mayor diferencia progresiva entre los elementos de xs. Por ejemplo,

   mayorDiferencia [1,5,8,2,9]  ==  8
   mayorDiferencia [9,5,8,2,1]  ==  3
   mayorDiferencia [7,2,6]      ==  4
   mayorDiferencia [3,2,1]      ==  0
   mayorDiferencia [1..10^7]    ==  9999999

mayorDiferencia [1,5,8,2,9] == 8

mayorDiferencia [9,5,8,2,1] == 3

mayorDiferencia [7,2,6] == 4

mayorDiferencia [3,2,1] == 0

mayorDiferencia [1..10^7] == 9999999

Soluciones

import Data.List (inits)

-- 1ª definición (por recursión):
mayorDiferencia :: [Int] -> Int
mayorDiferencia ([_])  = 0
mayorDiferencia (x:xs) = 
    max (maximum [y-x | y <- xs]) (mayorDiferencia xs) 

-- 2ª definición (por comprensión)
mayorDiferencia2 :: [Int] -> Int
mayorDiferencia2 xs = 
    maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:
mayorDiferencia3 :: [Int] -> Int
mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:
mayorDiferencia4 :: [Int] -> Int
mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia
--    ghci> mayorDiferencia [1..3000]
--    2999
--    (3.43 secs, 943439560 bytes)
--    
--    ghci> mayorDiferencia2 [1..3000]
--    2999
--    (3.38 secs, 978359192 bytes)
--    
--    ghci> mayorDiferencia3 [1..3000]
--    2999
--    (0.01 secs, 2877960 bytes)
--    
--    ghci> mayorDiferencia4 [1..3000]
--    2999
--    (0.01 secs, 2062616 bytes)

import Data.List (inits)

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

mayorDiferencia :: [Int] -> Int

mayorDiferencia ([_]) = 0

mayorDiferencia (x:xs) =

max (maximum [y-x | y <- xs]) (mayorDiferencia xs)

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

mayorDiferencia2 :: [Int] -> Int

mayorDiferencia2 xs =

maximum [x-y | (x,y) <- zip xs (map minimum (tail (inits xs)))]

-- 3ª definición:

mayorDiferencia3 :: [Int] -> Int

mayorDiferencia3 xs = maximum (zipWith (-) xs (scanl1 min xs))

-- 4ª definición:

mayorDiferencia4 :: [Int] -> Int

mayorDiferencia4 xs = maximum . zipWith (-) xs $ scanl1 min xs

-- Comparación de eficiencia

-- ghci> mayorDiferencia [1..3000]

-- 2999

-- (3.43 secs, 943439560 bytes)

-- ghci> mayorDiferencia2 [1..3000]

-- 2999

-- (3.38 secs, 978359192 bytes)

-- ghci> mayorDiferencia3 [1..3000]

-- 2999

-- (0.01 secs, 2877960 bytes)

-- ghci> mayorDiferencia4 [1..3000]

-- 2999

-- (0.01 secs, 2062616 bytes)

Buscaminas

PorJosé A. Alonso 19-junio-201425-abril-2021

Enunciado

-- 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 4x4 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
-- 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
--
-- En el ejercicio se usará la librería Data.Matrix, cuyo manual se encuentra
-- en http://bit.ly/1hWVNJD
-- 
-- Los campos de minas se representan mediante matrices: 
--    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]]
-- 
-- Definir la función
--    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 )
-- 
-- Nota. Las funciones de la librería de matrices útiles para este ejercicio
-- son fromLists, matrix, nrows y ncols.

-- 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 4x4 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

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

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

-- en http://bit.ly/1hWVNJD

-- Los campos de minas se representan mediante matrices:

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

-- Definir la función

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

-- Nota. Las funciones de la librería de matrices útiles para este ejercicio

-- son fromLists, matrix, nrows y ncols.

Soluciones

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

Referencia

El ejercicio está basado en Minesweeper de UVa Online Judge.

Soluciones

Nuevas soluciones

Soluciones

Otras soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Referencia

Entradas recientes

Buscar

Correo electrónico