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

Ampliación de matrices por columnas

PorJosé A. Alonso 22-marzo-202215-abril-2022

Las matrices enteras se pueden representar mediante tablas con índices enteros:

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Definir la función

   ampliaColumnas :: Matriz -> Matriz -> Matriz

1	ampliaColumnas :: Matriz -> Matriz -> Matriz

tal que (ampliaColumnas p q) es la matriz construida añadiendo las columnas de la matriz q a continuación de las de p (se supone que tienen el mismo número de filas). Por ejemplo, si p y q representa las dos primeras matrices, entonces (ampliaColumnas p q) es la tercera

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

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

En Haskell, se definen las dos primeras matrices se definen por

   ej1 = listArray ((1,1),(2,2)) [0..3]
   ej2 = listArray ((1,1),(2,3)) [4..9]

1 2	ej1 = listArray ((1,1),(2,2)) [0..3] ej2 = listArray ((1,1),(2,3)) [4..9]

y el cálculo de la tercera es

   λ> ampliaColumnas ej1 ej2
   array ((1,1),(2,5)) [((1,1),0),((1,2),1),((1,3),4),((1,4),5),((1,5),6),
                        ((2,1),2),((2,2),3),((2,3),7),((2,4),8),((2,5),9)]
   λ> elems (ampliaColumnas ej1 ej2)
   [0,1,4,5,6,2,3,7,8,9]

λ> ampliaColumnas ej1 ej2

array ((1,1),(2,5)) [((1,1),0),((1,2),1),((1,3),4),((1,4),5),((1,5),6),

((2,1),2),((2,2),3),((2,3),7),((2,4),8),((2,5),9)]

λ> elems (ampliaColumnas ej1 ej2)

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

Soluciones

import Data.Array (Array, (!), array, bounds, elems, listArray)
import Data.Matrix (Matrix, (<|>), fromList, ncols, nrows, toList)
import Test.QuickCheck

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Matriz
ej1 = listArray ((1,1),(2,2)) [0..3]
ej2 = listArray ((1,1),(2,3)) [4..9]

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

ampliaColumnas1 :: Matriz -> Matriz -> Matriz
ampliaColumnas1 p1 p2 =
  array ((1,1),(m,n1+n2)) [((i,j), f i j) | i <- [1..m], j <- [1..n1+n2]]
    where ((_,_),(m,n1)) = bounds p1
          ((_,_),(_,n2)) = bounds p2
          f i j | j <= n1   = p1!(i,j)
                | otherwise = p2!(i,j-n1)

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

ampliaColumnas2 :: Matriz -> Matriz -> Matriz
ampliaColumnas2 p1 p2 =
  matriz (matrix p1 <|> matrix p2)

-- (matrix p) es la matriz p en el formatao de Data.Matrix. Por ejemplo,
--    λ> ej1
--    array ((1,1),(2,2)) [((1,1),0),((1,2),1),((2,1),2),((2,2),3)]
--    λ> matrix ej1
--    ┌     ┐
--    │ 0 1 │
--    │ 2 3 │
--    └     ┘
--    λ> matrix (ampliaColumnas1 ej1 ej2)
--    ┌           ┐
--    │ 0 1 4 5 6 │
--    │ 2 3 7 8 9 │
--    └           ┘
matrix :: Matriz -> Matrix Int
matrix p = fromList m n (elems p)
  where (_,(m,n)) = bounds p

-- (matriz p) es la matriz p en el formato de Data.Array. Por ejemplo,
--    λ> matriz (fromList 2 3 [1..])
--    array ((1,1),(2,3)) [((1,1),1),((1,2),2),((1,3),3),((2,1),4),((2,2),5),((2,3),6)]
matriz :: Matrix Int -> Matriz
matriz p = listArray ((1,1),(nrows p,ncols p)) (toList p)

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

data ParMatrices = P Matriz Matriz
  deriving Show

-- parMatricesArbitrario es un generador de pares de matrices con el
-- mismo número de filas.
parMatricesArbitrario :: Gen ParMatrices
parMatricesArbitrario = do
  m  <- arbitrary `suchThat` (> 0)
  n1 <- arbitrary `suchThat` (> 0)
  n2 <- arbitrary `suchThat` (> 0)
  xs <- vector (m * n1)
  ys <- vector (m * n2)
  return (P (listArray ((1,1),(m,n1)) xs)
            (listArray ((1,1),(m,n2)) ys))

-- ParMatrices es una subclase de Arbitrary
instance Arbitrary ParMatrices where
  arbitrary = parMatricesArbitrario

-- La propiedad es
prop_ampliaColumna :: ParMatrices -> Bool
prop_ampliaColumna (P p q) =
  ampliaColumnas1 p q == ampliaColumnas2 p q

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

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

-- La comparación es
--    λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas1 p p)
--    1000000
--    (2.04 secs, 1,562,652,704 bytes)
--    λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas2 p p)
--    1000000
--    (0.69 secs, 738,508,624 bytes)

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

import Data.Matrix (Matrix, (<|>), fromList, ncols, nrows, toList)

import Test.QuickCheck

type Matriz = Array (Int,Int) Int

ej1, ej2 :: Matriz

ej1 = listArray ((1,1),(2,2)) [0..3]

ej2 = listArray ((1,1),(2,3)) [4..9]

-- 1ª solución

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

ampliaColumnas1 :: Matriz -> Matriz -> Matriz

ampliaColumnas1 p1 p2 =

array ((1,1),(m,n1+n2)) [((i,j), f i j) | i <- [1..m], j <- [1..n1+n2]]

where ((_,_),(m,n1)) = bounds p1

((_,_),(_,n2)) = bounds p2

f i j | j <= n1 = p1!(i,j)

| otherwise = p2!(i,j-n1)

-- 2ª solución

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

ampliaColumnas2 :: Matriz -> Matriz -> Matriz

ampliaColumnas2 p1 p2 =

matriz (matrix p1 <|> matrix p2)

-- (matrix p) es la matriz p en el formatao de Data.Matrix. Por ejemplo,

-- λ> ej1

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

-- λ> matrix ej1

-- ┌ ┐

-- │ 0 1 │

-- │ 2 3 │

-- └ ┘

-- λ> matrix (ampliaColumnas1 ej1 ej2)

-- ┌ ┐

-- │ 0 1 4 5 6 │

-- │ 2 3 7 8 9 │

-- └ ┘

matrix :: Matriz -> Matrix Int

matrix p = fromList m n (elems p)

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

-- (matriz p) es la matriz p en el formato de Data.Array. Por ejemplo,

-- λ> matriz (fromList 2 3 [1..])

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

matriz :: Matrix Int -> Matriz

matriz p = listArray ((1,1),(nrows p,ncols p)) (toList p)

-- Comprobación de equivalencia

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

data ParMatrices = P Matriz Matriz

deriving Show

-- parMatricesArbitrario es un generador de pares de matrices con el

-- mismo número de filas.

parMatricesArbitrario :: Gen ParMatrices

parMatricesArbitrario = do

m <- arbitrary `suchThat` (> 0)

n1 <- arbitrary `suchThat` (> 0)

n2 <- arbitrary `suchThat` (> 0)

xs <- vector (m * n1)

ys <- vector (m * n2)

return (P (listArray ((1,1),(m,n1)) xs)

(listArray ((1,1),(m,n2)) ys))

-- ParMatrices es una subclase de Arbitrary

instance Arbitrary ParMatrices where

arbitrary = parMatricesArbitrario

-- La propiedad es

prop_ampliaColumna :: ParMatrices -> Bool

prop_ampliaColumna (P p q) =

ampliaColumnas1 p q == ampliaColumnas2 p q

-- La comprobación es

-- λ> quickCheck prop_ampliaColumna

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas1 p p)

-- 1000000

-- (2.04 secs, 1,562,652,704 bytes)

-- λ> let p = listArray ((1,1),(10^3,10^3)) [1..] in maximum (ampliaColumnas2 p p)

-- 1000000

-- (0.69 secs, 738,508,624 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>

Matrices de Toepliz

PorJosé A. Alonso 8-marzo-202215-abril-2022

Una matriz de Toeplitz es una matriz cuadrada que es constante a lo largo de las diagonales paralelas a la diagonal principal. Por ejemplo,

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

|2 5 1 6| |2 5 1 6|

|4 2 5 1| |4 2 6 1|

|7 4 2 5| |7 4 2 5|

|9 7 4 2| |9 7 4 2|

la primera es una matriz de Toeplitz y la segunda no lo es.

Las anteriores matrices se pueden definir por

   ej1, ej2 :: Array (Int,Int) Int
   ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]
   ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

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

ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]

ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

Definir la función

   esToeplitz :: Eq a => Array (Int,Int) a -> Bool

1	esToeplitz :: Eq a => Array (Int,Int) a -> Bool

tal que (esToeplitz p) se verifica si la matriz p es de Toeplitz. Por ejemplo,

   esToeplitz ej1  ==  True
   esToeplitz ej2  ==  False

1 2	esToeplitz ej1 == True esToeplitz ej2 == False

Soluciones

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

ej1, ej2 :: Array (Int,Int) Int
ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]
ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

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

esToeplitz1 :: Eq a => Array (Int,Int) a -> Bool
esToeplitz1 p =
  esCuadrada p &&
  all todosIguales (diagonalesPrincipales p)

-- (esCuadrada p) se verifica si la matriz p es cuadrada. Por ejemplo,
--    esCuadrada (listArray ((1,1),(4,4)) [1..])  ==  True
--    esCuadrada (listArray ((1,1),(3,4)) [1..])  ==  False
esCuadrada :: Eq a => Array (Int,Int) a -> Bool
esCuadrada p = m == n
  where (_,(m,n)) = bounds p

-- (diagonalesPrincipales p) es la lista de las diagonales principales
-- de p. Por ejemplo,
--    λ> diagonalesPrincipales ej1
--    [[2,2,2,2],[5,5,5],[1,1],[6],[2,2,2,2],[4,4,4],[7,7],[9]]
--    λ> diagonalesPrincipales ej2
--    [[2,2,2,2],[5,6,5],[1,1],[6],[2,2,2,2],[4,4,4],[7,7],[9]]
diagonalesPrincipales :: Array (Int,Int) a -> [[a]]
diagonalesPrincipales p =
  [[p ! i |i <- is] | is <- posicionesDiagonalesPrincipales m n]
  where (_,(m,n)) = bounds p

-- (posicionesDiagonalesPrincipales m n) es la lista de las
-- posiciones de las diagonales principales de una matriz con m filas y
-- n columnas. Por ejemplo,
--   λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)
--   [(3,1)]
--   [(2,1),(3,2)]
--   [(1,1),(2,2),(3,3)]
--   [(1,2),(2,3),(3,4)]
--   [(1,3),(2,4)]
--   [(1,4)]
--   λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)
--   [(4,1)]
--   [(3,1),(4,2)]
--   [(2,1),(3,2),(4,3)]
--   [(1,1),(2,2),(3,3),(4,4)]
--   [(1,2),(2,3),(3,4)]
--   [(1,3),(2,4)]
--   [(1,4)]
--   λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)
--   [(4,1)]
--   [(3,1),(4,2)]
--   [(2,1),(3,2),(4,3)]
--   [(1,1),(2,2),(3,3)]
--   [(1,2),(2,3)]
--   [(1,3)]
posicionesDiagonalesPrincipales :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales m n =
  [zip [i..m] [1..n] | i <- [m,m-1..1]] ++
  [zip [1..m] [j..n] | j <- [2..n]]

-- (todosIguales xs) se verifica si todos los elementos de xs son
-- iguales. Por ejemplo,
--    todosIguales [5,5,5]  ==  True
--    todosIguales [5,4,5]  ==  False
todosIguales :: Eq a => [a] -> Bool
todosIguales []     = True
todosIguales (x:xs) = all (== x) xs

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

esToeplitz2 :: Eq a => Array (Int,Int) a -> Bool
esToeplitz2 p = m == n &&
               and [p!(i,j) == p!(i+1,j+1) |
                    i <- [1..n-1], j <- [1..n-1]]
  where (_,(m,n)) = bounds p

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

-- La comparación es
--    λ> esToeplitz1 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))
--    True
--    (2.26 secs, 2,211,553,888 bytes)
--    λ> esToeplitz2 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))
--    True
--    (4.26 secs, 3,421,651,032 bytes)

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

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

ej1 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,5,1,7,4,2,5,9,7,4,2]

ej2 = listArray ((1,1),(4,4)) [2,5,1,6,4,2,6,1,7,4,2,5,9,7,4,2]

-- 1ª solución

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

esToeplitz1 :: Eq a => Array (Int,Int) a -> Bool

esToeplitz1 p =

esCuadrada p &&

all todosIguales (diagonalesPrincipales p)

-- (esCuadrada p) se verifica si la matriz p es cuadrada. Por ejemplo,

-- esCuadrada (listArray ((1,1),(4,4)) [1..]) == True

-- esCuadrada (listArray ((1,1),(3,4)) [1..]) == False

esCuadrada :: Eq a => Array (Int,Int) a -> Bool

esCuadrada p = m == n

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

-- (diagonalesPrincipales p) es la lista de las diagonales principales

-- de p. Por ejemplo,

-- λ> diagonalesPrincipales ej1

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

-- λ> diagonalesPrincipales ej2

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

diagonalesPrincipales :: Array (Int,Int) a -> [[a]]

diagonalesPrincipales p =

[[p ! i |i <- is] | is <- posicionesDiagonalesPrincipales m n]

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

-- (posicionesDiagonalesPrincipales m n) es la lista de las

-- posiciones de las diagonales principales de una matriz con m filas y

-- n columnas. Por ejemplo,

-- λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)

-- [(3,1)]

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

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

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

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

-- [(1,4)]

-- λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)

-- [(4,1)]

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

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

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

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

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

-- [(1,4)]

-- λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)

-- [(4,1)]

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

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

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

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

-- [(1,3)]

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

posicionesDiagonalesPrincipales m n =

[zip [i..m] [1..n] | i <- [m,m-1..1]] ++

[zip [1..m] [j..n] | j <- [2..n]]

-- (todosIguales xs) se verifica si todos los elementos de xs son

-- iguales. Por ejemplo,

-- todosIguales [5,5,5] == True

-- todosIguales [5,4,5] == False

todosIguales :: Eq a => [a] -> Bool

todosIguales [] = True

todosIguales (x:xs) = all (== x) xs

-- 2ª solución

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

esToeplitz2 :: Eq a => Array (Int,Int) a -> Bool

esToeplitz2 p = m == n &&

and [p!(i,j) == p!(i+1,j+1) |

i <- [1..n-1], j <- [1..n-1]]

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

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esToeplitz1 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))

-- True

-- (2.26 secs, 2,211,553,888 bytes)

-- λ> esToeplitz2 (listArray ((1,1),(2*10^3,2*10^3)) (repeat 1))

-- True

-- (4.26 secs, 3,421,651,032 bytes)

El código se encuentra en GitHub.

Diagonales principales de una matriz

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

La lista de las diagonales principales de la matriz

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

1 2 3 4

5 6 7 8

9 10 11 12

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

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

Definir la función

   diagonalesPrincipales :: Array (Int,Int) a -> [[a]]

1	diagonalesPrincipales :: Array (Int,Int) a -> [[a]]

tal que (diagonalesPrincipales p) es la lista de las diagonales principales de p. Por ejemplo,

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

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

Soluciones

import Data.Array (Array, (!), bounds, listArray)
import Test.QuickCheck

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

diagonalesPrincipales1 :: Array (Int,Int) a -> [[a]]
diagonalesPrincipales1 p =
  [[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales1 m n]
  where (_,(m,n)) = bounds p

posicionesDiagonalesPrincipales1 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales1 m n =
  [extension ij | ij <- iniciales]
  where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]
        extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

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

diagonalesPrincipales2 :: Array (Int,Int) a -> [[a]]
diagonalesPrincipales2 p =
  [[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales2 m n]
  where (_,(m,n)) = bounds p

posicionesDiagonalesPrincipales2 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales2 m n =
  [zip [i..m] [1..n] | i <- [m,m-1..1]] ++
  [zip [1..m] [j..n] | j <- [2..n]]

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

-- La propiedad es
prop_diagonalesPrincipales :: Positive Int -> Positive Int -> Bool
prop_diagonalesPrincipales (Positive m) (Positive n) =
  diagonalesPrincipales1 p == diagonalesPrincipales2 p
  where p = listArray ((1,1),(m,n)) [1..]

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

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

-- La comparación es
--    λ> length (diagonalesPrincipales1 (listArray ((1,1),(10^4,10^4)) [1..]))
--    19999
--    (6.90 secs, 8,010,369,224 bytes)
--    λ> length (diagonalesPrincipales2 (listArray ((1,1),(10^4,10^4)) [1..]))
--    19999
--    (6.78 secs, 8,008,289,224 bytes)

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

import Test.QuickCheck

-- 1ª solución

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

diagonalesPrincipales1 :: Array (Int,Int) a -> [[a]]

diagonalesPrincipales1 p =

[[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales1 m n]

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

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

posicionesDiagonalesPrincipales1 m n =

[extension ij | ij <- iniciales]

where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]

extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

-- 2ª solución

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

diagonalesPrincipales2 :: Array (Int,Int) a -> [[a]]

diagonalesPrincipales2 p =

[[p ! ij | ij <- ijs] | ijs <- posicionesDiagonalesPrincipales2 m n]

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

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

posicionesDiagonalesPrincipales2 m n =

[zip [i..m] [1..n] | i <- [m,m-1..1]] ++

[zip [1..m] [j..n] | j <- [2..n]]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_diagonalesPrincipales :: Positive Int -> Positive Int -> Bool

prop_diagonalesPrincipales (Positive m) (Positive n) =

diagonalesPrincipales1 p == diagonalesPrincipales2 p

where p = listArray ((1,1),(m,n)) [1..]

-- La comprobación es

-- λ> quickCheck prop_diagonalesPrincipales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (diagonalesPrincipales1 (listArray ((1,1),(10^4,10^4)) [1..]))

-- 19999

-- (6.90 secs, 8,010,369,224 bytes)

-- λ> length (diagonalesPrincipales2 (listArray ((1,1),(10^4,10^4)) [1..]))

-- 19999

-- (6.78 secs, 8,008,289,224 bytes)

El código se encuentra en GitHub

Posiciones de las diagonales principales

PorJosé A. Alonso 4-marzo-202215-abril-2022

Las posiciones de una matriz con 3 filas y 4 columnas son

   (1,1) (1,2) (1,3) (1,4)
   (2,1) (2,2) (2,3) (2,4)
   (3,1) (3,2) (3,3) (3,4)

(1,1) (1,2) (1,3) (1,4)

(2,1) (2,2) (2,3) (2,4)

(3,1) (3,2) (3,3) (3,4)

La posiciones de sus 6 diagonales principales son

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

[(3,1)]

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

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

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

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

[(1,4)]

Definir la función

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

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

tal que (posicionesdiagonalesprincipales m n) es la lista de las posiciones de las diagonales principales de una matriz con m filas y n columnas. Por ejemplo,

  λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)
  [(3,1)]
  [(2,1),(3,2)]
  [(1,1),(2,2),(3,3)]
  [(1,2),(2,3),(3,4)]
  [(1,3),(2,4)]
  [(1,4)]
  λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)
  [(4,1)]
  [(3,1),(4,2)]
  [(2,1),(3,2),(4,3)]
  [(1,1),(2,2),(3,3),(4,4)]
  [(1,2),(2,3),(3,4)]
  [(1,3),(2,4)]
  [(1,4)]
  λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)
  [(4,1)]
  [(3,1),(4,2)]
  [(2,1),(3,2),(4,3)]
  [(1,1),(2,2),(3,3)]
  [(1,2),(2,3)]
  [(1,3)]

λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)

[(3,1)]

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

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

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

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

[(1,4)]

λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)

[(4,1)]

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

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

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

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

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

[(1,4)]

λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)

[(4,1)]

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

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

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

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

[(1,3)]

Soluciones

import Test.QuickCheck

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

posicionesDiagonalesPrincipales1 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales1 m n =
  [extension ij | ij <- iniciales]
  where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]
        extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

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

posicionesDiagonalesPrincipales2 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales2 m n =
  [zip [i..m] [1..n] | i <- [m,m-1..1]] ++
  [zip [1..m] [j..n] | j <- [2..n]]

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

-- La propiedad es
prop_posicionesDiagonalesPrincipales :: Positive Int -> Positive Int -> Bool
prop_posicionesDiagonalesPrincipales (Positive m) (Positive n) =
  posicionesDiagonalesPrincipales1 m n ==
  posicionesDiagonalesPrincipales2 m n

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

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

-- La comparación es
--   λ> length (posicionesDiagonalesPrincipales1 (10^7) (10^6))
--   10999999
--   (6.14 secs, 3,984,469,440 bytes)
--   λ> length (posicionesDiagonalesPrincipales2 (10^7) (10^6))
--   10999999
--   (3.07 secs, 2,840,469,440 bytes)

import Test.QuickCheck

-- 1ª solución

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

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

posicionesDiagonalesPrincipales1 m n =

[extension ij | ij <- iniciales]

where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]

extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

-- 2ª solución

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

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

posicionesDiagonalesPrincipales2 m n =

[zip [i..m] [1..n] | i <- [m,m-1..1]] ++

[zip [1..m] [j..n] | j <- [2..n]]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_posicionesDiagonalesPrincipales :: Positive Int -> Positive Int -> Bool

prop_posicionesDiagonalesPrincipales (Positive m) (Positive n) =

posicionesDiagonalesPrincipales1 m n ==

posicionesDiagonalesPrincipales2 m n

-- La comprobación es

-- λ> quickCheck prop_posicionesDiagonalesPrincipales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (posicionesDiagonalesPrincipales1 (10^7) (10^6))

-- 10999999

-- (6.14 secs, 3,984,469,440 bytes)

-- λ> length (posicionesDiagonalesPrincipales2 (10^7) (10^6))

-- 10999999

-- (3.07 secs, 2,840,469,440 bytes)

El código se encuentra en GitHub

Producto de los elementos de la diagonal principal

PorJosé A. Alonso 3-febrero-202215-abril-2022

Las matrices se pueden representar como lista de listas de la misma longitud, donde cada uno de sus elementos representa una fila de la matriz.

Definir la función

   productoDiagonalPrincipal :: Num a => [[a]] -> a

1	productoDiagonalPrincipal :: Num a => [[a]] -> a

tal que (productoDiagonalPrincipal xss) es el producto de los elementos de la diagonal principal de la matriz cuadrada xss. Por ejemplo,

   productoDiagonal1 [[3,5,2],[4,7,1],[6,9,8]]  ==  168
   productoDiagonal1 (replicate 5 [1..5])       ==  120
   length (show (productoDiagonal3 (replicate 30000 [1..30000])))  ==  121288

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

productoDiagonal1 (replicate 5 [1..5]) == 120

length (show (productoDiagonal3 (replicate 30000 [1..30000]))) == 121288

Soluciones

import Data.List (genericReplicate)

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

productoDiagonal1 :: Num a => [[a]] -> a
productoDiagonal1 xss = product (diagonal1 xss)

-- (diagonal1 xss) es la diagonal de la matriz xss. Por ejemplo,
--    diagonal1 [[3,5,2],[4,7,1],[6,9,0]]  ==  [3,7,0]
--    diagonal1 [[3,5],[4,7],[6,9]]        ==  [3,7]
--    diagonal1 [[3,5,2],[4,7,1]]          ==  [3,7]
diagonal1 :: [[a]] -> [a]
diagonal1 ((x:_):xss) = x : diagonal1 (map tail xss)
diagonal1 _           = []

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

productoDiagonal2 :: Num a => [[a]] -> a
productoDiagonal2 = product . diagonal1

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

productoDiagonal3 :: Num a => [[a]] -> a
productoDiagonal3 = product . diagonal3

diagonal3 :: [[a]] -> [a]
diagonal3 xss = [xs !! k | (xs,k) <- zip xss [0..n]]
  where n = length (head xss) - 1

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

productoDiagonal4 :: Num a => [[a]] -> a
productoDiagonal4 []          = 1
productoDiagonal4 [[]]        = 1
productoDiagonal4 ((x:_):xss) = x * productoDiagonal4 (map tail xss)

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

productoDiagonal5 :: Num a => [[a]] -> a
productoDiagonal5 xss = product (zipWith (!!) xss [0..k])
  where m = length xss
        n = length (head xss)
        k = min m n - 1

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

ejemplo :: Integer -> [[Integer]]
ejemplo n = genericReplicate n [1..n]

-- La comparación es
--    λ> length (show (productoDiagonal1 (ejemplo 7000)))
--    23878
--    (1.23 secs, 3,396,129,424 bytes)
--    λ> length (show (productoDiagonal2 (ejemplo 7000)))
--    23878
--    (0.94 secs, 3,396,127,680 bytes)
--    λ> length (show (productoDiagonal3 (ejemplo 7000)))
--    23878
--    (0.09 secs, 44,841,864 bytes)
--    λ> length (show (productoDiagonal4 (ejemplo 7000)))
--    23878
--    (0.96 secs, 3,614,137,840 bytes)
--    λ> length (show (productoDiagonal5 (ejemplo 7000)))
--    23878
--    (0.07 secs, 44,168,984 bytes)
--
--    λ> length (show (productoDiagonal3 (ejemplo 70000)))
--    308760
--    (8.26 secs, 5,359,752,408 bytes)
--    λ> length (show (productoDiagonal5 (ejemplo 70000)))
--    308760
--    (9.34 secs, 5,353,035,656 bytes)

import Data.List (genericReplicate)

-- 1ª solución

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

productoDiagonal1 :: Num a => [[a]] -> a

productoDiagonal1 xss = product (diagonal1 xss)

-- (diagonal1 xss) es la diagonal de la matriz xss. Por ejemplo,

-- diagonal1 [[3,5,2],[4,7,1],[6,9,0]] == [3,7,0]

-- diagonal1 [[3,5],[4,7],[6,9]] == [3,7]

-- diagonal1 [[3,5,2],[4,7,1]] == [3,7]

diagonal1 :: [[a]] -> [a]

diagonal1 ((x:_):xss) = x : diagonal1 (map tail xss)

diagonal1 _ = []

-- 2ª solución

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

productoDiagonal2 :: Num a => [[a]] -> a

productoDiagonal2 = product . diagonal1

-- 3ª solución

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

productoDiagonal3 :: Num a => [[a]] -> a

productoDiagonal3 = product . diagonal3

diagonal3 :: [[a]] -> [a]

diagonal3 xss = [xs !! k | (xs,k) <- zip xss [0..n]]

where n = length (head xss) - 1

-- 4ª solución

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

productoDiagonal4 :: Num a => [[a]] -> a

productoDiagonal4 [] = 1

productoDiagonal4 [[]] = 1

productoDiagonal4 ((x:_):xss) = x * productoDiagonal4 (map tail xss)

-- 5ª solución

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

productoDiagonal5 :: Num a => [[a]] -> a

productoDiagonal5 xss = product (zipWith (!!) xss [0..k])

where m = length xss

n = length (head xss)

k = min m n - 1

-- Comparación de eficiencia

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

ejemplo :: Integer -> [[Integer]]

ejemplo n = genericReplicate n [1..n]

-- La comparación es

-- λ> length (show (productoDiagonal1 (ejemplo 7000)))

-- 23878

-- (1.23 secs, 3,396,129,424 bytes)

-- λ> length (show (productoDiagonal2 (ejemplo 7000)))

-- 23878

-- (0.94 secs, 3,396,127,680 bytes)

-- λ> length (show (productoDiagonal3 (ejemplo 7000)))

-- 23878

-- (0.09 secs, 44,841,864 bytes)

-- λ> length (show (productoDiagonal4 (ejemplo 7000)))

-- 23878

-- (0.96 secs, 3,614,137,840 bytes)

-- λ> length (show (productoDiagonal5 (ejemplo 7000)))

-- 23878

-- (0.07 secs, 44,168,984 bytes)

-- λ> length (show (productoDiagonal3 (ejemplo 70000)))

-- 308760

-- (8.26 secs, 5,359,752,408 bytes)

-- λ> length (show (productoDiagonal5 (ejemplo 70000)))

-- 308760

-- (9.34 secs, 5,353,035,656 bytes)

El código se encuentra en GitHub.

Camino de máxima suma en una matriz

PorJosé A. Alonso 12-mayo-202019-mayo-2020

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El camino de máxima suma es el segundo (1, 7, 12, 8, 4, 9) que tiene una suma de 41.

Definir la función

   caminoMaxSuma :: Matrix Int -> [Int]

1	caminoMaxSuma :: Matrix Int -> [Int]

tal que (caminoMaxSuma m) es un camino de máxima suma en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> caminoMaxSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [1,7,12,8,4,9]
   λ> sum (caminoMaxSuma (fromList 800 800 [1..]))
   766721999

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

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

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

766721999

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

Soluciones

import Data.Matrix

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

caminoMaxSuma1 :: Matrix Int -> [Int]
caminoMaxSuma1 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos1 m
        k  = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]

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

caminoMaxSuma2 :: Matrix Int -> [Int]
caminoMaxSuma2 m =
  head [c | c <- cs, sum c == k] 
  where cs = caminos2 m
        k  = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  

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

caminoMaxSuma3 :: Matrix Int -> [Int]
caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))
  where nf = nrows m
        nc = ncols m
        q  = caminoMaxSumaAux m

caminoMaxSumaAux :: Matrix Int -> Matrix (Int,[Int])
caminoMaxSumaAux m = q 
  where
    nf = nrows m
    nc = ncols m
    q  = matrix nf nc f
      where
        f (1,1) = (m!(1,1),[m!(1,1)])
        f (1,j) = (k + m!(1,j), m!(1,j):xs)
          where (k,xs) = q!(1,j-1)
        f (i,1) = (k + m!(i,1), m!(i,1):xs)
          where (k,xs) = q!(i-1,1)        
        f (i,j) | k1 > k2   = (k1 + m!(i,j), m!(i,j):xs)
                | otherwise = (k2 + m!(i,j), m!(i,j):ys)
          where (k1,xs) = q!(i,j-1)
                (k2,ys) = q!(i-1,j)

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

--    λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))
--    21
--    (10.00 secs, 1,510,120,328 bytes)
--    λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))
--    21
--    (3.84 secs, 745,918,544 bytes)
--    λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))
--    21
--    (0.01 secs, 0 bytes)

import Data.Matrix

-- 1ª definición

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

caminoMaxSuma1 :: Matrix Int -> [Int]

caminoMaxSuma1 m =

head [c | c <- cs, sum c == k]

where cs = caminos1 m

k = maximum (map sum cs)

caminos1 :: Matrix Int -> [[Int]]

caminos1 m =

map reverse (caminos1Aux m (nf,nc))

where nf = nrows m

nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p

-- desde la posición (1,1) hasta la posición x. Por ejemplo,

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

caminos1Aux m (1,1) = [[m!(1,1)]]

caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]

caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]

caminos1Aux m (i,j) = [m!(i,j) : xs

| xs <- caminos1Aux m (i,j-1) ++

caminos1Aux m (i-1,j)]

-- 2ª definición

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

caminoMaxSuma2 :: Matrix Int -> [Int]

caminoMaxSuma2 m =

head [c | c <- cs, sum c == k]

where cs = caminos2 m

k = maximum (map sum cs)

caminos2 :: Matrix Int -> [[Int]]

caminos2 m =

map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]

matrizCaminos m = q

where

q = matrix (nrows m) (ncols m) f

f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]

f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]

f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]

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

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

caminoMaxSuma3 :: Matrix Int -> [Int]

caminoMaxSuma3 m = reverse (snd (q ! (nf,nc)))

where nf = nrows m

nc = ncols m

q = caminoMaxSumaAux m

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

caminoMaxSumaAux m = q

where

nf = nrows m

nc = ncols m

q = matrix nf nc f

where

f (1,1) = (m!(1,1),[m!(1,1)])

f (1,j) = (k + m!(1,j), m!(1,j):xs)

where (k,xs) = q!(1,j-1)

f (i,1) = (k + m!(i,1), m!(i,1):xs)

where (k,xs) = q!(i-1,1)

f (i,j) | k1 > k2 = (k1 + m!(i,j), m!(i,j):xs)

| otherwise = (k2 + m!(i,j), m!(i,j):ys)

where (k1,xs) = q!(i,j-1)

(k2,ys) = q!(i-1,j)

-- Comparación de eficiencia

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

-- λ> length (caminoMaxSuma1 (fromList 11 11 [1..]))

-- 21

-- (10.00 secs, 1,510,120,328 bytes)

-- λ> length (caminoMaxSuma2 (fromList 11 11 [1..]))

-- 21

-- (3.84 secs, 745,918,544 bytes)

-- λ> length (caminoMaxSuma3 (fromList 11 11 [1..]))

-- 21

-- (0.01 secs, 0 bytes)

Máximo de las sumas de los caminos en una matriz

PorJosé A. Alonso 11-mayo-202018-mayo-2020

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Las sumas de los caminos son 32, 41, 36, 40, 40, 35, 39, 34, 38 y 37, respectivamente. El máximo de las suma de los caminos es 41.

Definir la función

   maximaSuma :: Matrix Int -> Int

1	maximaSuma :: Matrix Int -> Int

tal que (maximaSuma m) es el máximo de las sumas de los caminos en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> maximaSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   41
   λ> maximaSuma (fromList 800 800 [1..])
   766721999

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

λ> maximaSuma (fromList 800 800 [1..])

766721999

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

Soluciones

import Data.Matrix

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

maximaSuma1 :: Matrix Int -> Int
maximaSuma1 =
  maximum . map sum . caminos1

caminos1 :: Matrix Int -> [[Int]]
caminos1 m =
  map reverse (caminos1Aux m (nf,nc))
  where nf = nrows m
        nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p
-- desde la posición (1,1) hasta la posición x. Por ejemplo,
caminos1Aux :: Matrix Int -> (Int,Int) -> [[Int]]
caminos1Aux m (1,1) = [[m!(1,1)]]
caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]
caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]
caminos1Aux m (i,j) = [m!(i,j) : xs
                      | xs <- caminos1Aux m (i,j-1) ++
                              caminos1Aux m (i-1,j)]

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

maximaSuma2 :: Matrix Int -> Int
maximaSuma2 =
  maximum . map sum . caminos2

caminos2 :: Matrix Int -> [[Int]]
caminos2 m =
  map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]
matrizCaminos m = q
  where
    q = matrix (nrows m) (ncols m) f
    f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]
    f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]
    f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]  

-- 3ª definicion (por recursión, sin calcular el camino)
-- =====================================================

maximaSuma3 :: Matrix Int -> Int
maximaSuma3 m = maximaSuma3Aux m (nf,nc)
  where nf = nrows m
        nc = ncols m

-- (maximaSuma3Aux m p) calcula la suma máxima de un camino hasta la
-- posición p. Por ejemplo,
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (3,4)
--    41
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (3,3)
--    32
--    λ> maximaSuma3Aux (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) (2,4)
--    31
maximaSuma3Aux :: Matrix Int -> (Int,Int) -> Int
maximaSuma3Aux m (1,1) = m ! (1,1)
maximaSuma3Aux m (1,j) = maximaSuma3Aux m (1,j-1) + m ! (1,j)
maximaSuma3Aux m (i,1) = maximaSuma3Aux m (i-1,1) + m ! (i,1)
maximaSuma3Aux m (i,j) =
  max (maximaSuma3Aux m (i,j-1)) (maximaSuma3Aux m (i-1,j)) + m ! (i,j)

-- 4ª solución (mediante programación dinámica)
-- ============================================

maximaSuma4 :: Matrix Int -> Int
maximaSuma4 m = q ! (nf,nc)
  where nf = nrows m
        nc = ncols m
        q  = matrizMaximaSuma m

-- (matrizMaximaSuma m) es la matriz donde en cada posición p se
-- encuentra el máxima de las sumas de los caminos desde (1,1) a p en la
-- matriz m. Por ejemplo,   
--    λ> matrizMaximaSuma (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]]) 
--    (  1  7 18 20 )
--    (  8 20 23 31 )
--    ( 11 28 32 41 )
matrizMaximaSuma :: Matrix Int -> Matrix Int
matrizMaximaSuma m = q 
  where nf = nrows m
        nc = ncols m
        q  = matrix nf nc f
          where  f (1,1) = m ! (1,1)
                 f (1,j) = q ! (1,j-1) + m ! (1,j)
                 f (i,1) = q ! (i-1,1) + m ! (i,1)
                 f (i,j) = max (q ! (i,j-1)) (q ! (i-1,j)) + m ! (i,j)

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

--    λ> maximaSuma1 (fromList 8 8 [1..])
--    659
--    (0.11 secs, 31,853,136 bytes)
--    λ> maximaSuma1a (fromList 8 8 [1..])
--    659
--    (0.09 secs, 19,952,640 bytes)
-- 
--    λ> maximaSuma1 (fromList 10 10 [1..])
--    1324
--    (2.25 secs, 349,722,744 bytes)
--    λ> maximaSuma2 (fromList 10 10 [1..])
--    1324
--    (0.76 secs, 151,019,296 bytes)
--    
--    λ> maximaSuma2 (fromList 11 11 [1..])
--    1781
--    (3.02 secs, 545,659,632 bytes)
--    λ> maximaSuma3 (fromList 11 11 [1..])
--    1781
--    (1.57 secs, 210,124,912 bytes)
--    
--    λ> maximaSuma3 (fromList 12 12 [1..])
--    2333
--    (5.60 secs, 810,739,032 bytes)
--    λ> maximaSuma4 (fromList 12 12 [1..])
--    2333
--    (0.01 secs, 23,154,776 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

import Data.Matrix

-- 1ª definición

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

maximaSuma1 :: Matrix Int -> Int

maximaSuma1 =

maximum . map sum . caminos1

caminos1 :: Matrix Int -> [[Int]]

caminos1 m =

map reverse (caminos1Aux m (nf,nc))

where nf = nrows m

nc = ncols m

-- (caminos1Aux p x) es la lista de los caminos invertidos en la matriz p

-- desde la posición (1,1) hasta la posición x. Por ejemplo,

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

caminos1Aux m (1,1) = [[m!(1,1)]]

caminos1Aux m (1,j) = [[m!(1,k) | k <- [j,j-1..1]]]

caminos1Aux m (i,1) = [[m!(k,1) | k <- [i,i-1..1]]]

caminos1Aux m (i,j) = [m!(i,j) : xs

| xs <- caminos1Aux m (i,j-1) ++

caminos1Aux m (i-1,j)]

-- 2ª definición

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

maximaSuma2 :: Matrix Int -> Int

maximaSuma2 =

maximum . map sum . caminos2

caminos2 :: Matrix Int -> [[Int]]

caminos2 m =

map reverse (matrizCaminos m ! (nrows m, ncols m))

matrizCaminos :: Matrix Int -> Matrix [[Int]]

matrizCaminos m = q

where

q = matrix (nrows m) (ncols m) f

f (1,y) = [[m!(1,z) | z <- [y,y-1..1]]]

f (x,1) = [[m!(z,1) | z <- [x,x-1..1]]]

f (x,y) = [m!(x,y) : cs | cs <- q!(x-1,y) ++ q!(x,y-1)]

-- 3ª definicion (por recursión, sin calcular el camino)

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

maximaSuma3 :: Matrix Int -> Int

maximaSuma3 m = maximaSuma3Aux m (nf,nc)

where nf = nrows m

nc = ncols m

-- (maximaSuma3Aux m p) calcula la suma máxima de un camino hasta la

-- posición p. Por ejemplo,

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

-- 41

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

-- 32

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

-- 31

maximaSuma3Aux :: Matrix Int -> (Int,Int) -> Int

maximaSuma3Aux m (1,1) = m ! (1,1)

maximaSuma3Aux m (1,j) = maximaSuma3Aux m (1,j-1) + m ! (1,j)

maximaSuma3Aux m (i,1) = maximaSuma3Aux m (i-1,1) + m ! (i,1)

maximaSuma3Aux m (i,j) =

max (maximaSuma3Aux m (i,j-1)) (maximaSuma3Aux m (i-1,j)) + m ! (i,j)

-- 4ª solución (mediante programación dinámica)

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

maximaSuma4 :: Matrix Int -> Int

maximaSuma4 m = q ! (nf,nc)

where nf = nrows m

nc = ncols m

q = matrizMaximaSuma m

-- (matrizMaximaSuma m) es la matriz donde en cada posición p se

-- encuentra el máxima de las sumas de los caminos desde (1,1) a p en la

-- matriz m. Por ejemplo,

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

-- ( 1 7 18 20 )

-- ( 8 20 23 31 )

-- ( 11 28 32 41 )

matrizMaximaSuma :: Matrix Int -> Matrix Int

matrizMaximaSuma m = q

where nf = nrows m

nc = ncols m

q = matrix nf nc f

where f (1,1) = m ! (1,1)

f (1,j) = q ! (1,j-1) + m ! (1,j)

f (i,1) = q ! (i-1,1) + m ! (i,1)

f (i,j) = max (q ! (i,j-1)) (q ! (i-1,j)) + m ! (i,j)

-- Comparación de eficiencia

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

-- λ> maximaSuma1 (fromList 8 8 [1..])

-- 659

-- (0.11 secs, 31,853,136 bytes)

-- λ> maximaSuma1a (fromList 8 8 [1..])

-- 659

-- (0.09 secs, 19,952,640 bytes)

-- λ> maximaSuma1 (fromList 10 10 [1..])

-- 1324

-- (2.25 secs, 349,722,744 bytes)

-- λ> maximaSuma2 (fromList 10 10 [1..])

-- 1324

-- (0.76 secs, 151,019,296 bytes)

-- λ> maximaSuma2 (fromList 11 11 [1..])

-- 1781

-- (3.02 secs, 545,659,632 bytes)

-- λ> maximaSuma3 (fromList 11 11 [1..])

-- 1781

-- (1.57 secs, 210,124,912 bytes)

-- λ> maximaSuma3 (fromList 12 12 [1..])

-- 2333

-- (5.60 secs, 810,739,032 bytes)

-- λ> maximaSuma4 (fromList 12 12 [1..])

-- 2333

-- (0.01 secs, 23,154,776 bytes)

Caminos en una matriz

PorJosé A. Alonso 8-mayo-202015-mayo-2020

Los caminos desde el extremo superior izquierdo (posición (1,1)) hasta el extremo inferior derecho (posición (3,4)) en la matriz

   (  1  6 11  2 )
   (  7 12  3  8 )
   (  3  8  4  9 )

( 1 6 11 2 )

( 7 12 3 8 )

( 3 8 4 9 )

moviéndose en cada paso una casilla hacia abajo o hacia la derecha, son los siguientes:

   1, 7,  3, 8, 4, 9
   1, 7, 12, 8, 4, 9
   1, 7, 12, 3, 4, 9
   1, 7, 12, 3, 8, 9
   1, 6, 12, 8, 4, 9
   1, 6, 12, 3, 4, 9
   1, 6, 12, 3, 8, 9
   1, 6, 11, 3, 4, 9
   1, 6, 11, 3, 8, 9
   1, 6, 11, 2, 8, 9

1, 7, 3, 8, 4, 9

1, 7, 12, 8, 4, 9

1, 7, 12, 3, 4, 9

1, 7, 12, 3, 8, 9

1, 6, 12, 8, 4, 9

1, 6, 12, 3, 4, 9

1, 6, 12, 3, 8, 9

1, 6, 11, 3, 4, 9

1, 6, 11, 3, 8, 9

1, 6, 11, 2, 8, 9

Definir la función

   caminos :: Matrix Int -> [[Int]]

1	caminos :: Matrix Int -> [[Int]]

tal que (caminos m) es la lista de los caminos en la matriz m desde el extremo superior izquierdo hasta el extremo inferior derecho, moviéndose en cada paso una casilla hacia abajo o hacia la derecha. Por ejemplo,

   λ> caminos (fromLists [[1,6,11,2],[7,12,3,8],[3,8,4,9]])
   [[1,7, 3,8,4,9],
    [1,7,12,8,4,9],
    [1,7,12,3,4,9],
    [1,7,12,3,8,9],
    [1,6,12,8,4,9],
    [1,6,12,3,4,9],
    [1,6,12,3,8,9],
    [1,6,11,3,4,9],
    [1,6,11,3,8,9],
    [1,6,11,2,8,9]]
   λ> length (caminos (fromList 12 13 [1..]))
   1352078

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

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

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

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

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

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

[1,6,12,3,4,9],

[1,6,12,3,8,9],

[1,6,11,3,4,9],

[1,6,11,3,8,9],

[1,6,11,2,8,9]]

λ> length (caminos (fromList 12 13 [1..]))

1352078

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

Soluciones

import Data.Matrix

-- 1ª definición de caminos (por recursión)
-- ----------------------------------------

caminos1 :: Matrix Int -> [[Int]]
caminos1 a = aux (1,1)
  where
    aux (i,j)
      | i == m           = [[a!(i,k) | k <- [j..n]]]
      | j == n           = [[a!(k,j) | k <- [i..m]]]
      | otherwise        = [a!(i,j) : cs | cs <- aux (i+1,j) ++ aux (i,j+1)]
      where m = nrows a
            n = ncols a

-- 2ª solución (mediante programación dinámica)
-- --------------------------------------------

caminos2 :: Matrix Int -> [[Int]]
caminos2 a = q ! (1,1)
  where
    q = matrix m n f
    m = nrows a
    n = ncols a
    f (i,j) | i == m    = [[a!(i,k) | k <- [j..n]]]
            | j == n    = [[a!(k,j) | k <- [i..m]]]
            | otherwise = [a!(i,j) : cs | cs <- q!(i+1,j) ++ q!(i,j+1)]  

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

caminos3 :: Matrix Int -> [[Int]]
caminos3 a
  | m == 1 || n == 1 = [toList a]
  | otherwise = map (a ! (1,1):) (caminos3 (submatrix 2 m 1 n a) ++
                                  caminos3 (submatrix 1 m 2 n a)) 
  where m = nrows a
        n = ncols a

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

--    λ> length (caminos1 (fromList 11 11 [1..]))
--    184756
--    (4.15 secs, 738,764,712 bytes)
--    λ> length (caminos2 (fromList 11 11 [1..]))
--    184756
--    (0.74 secs, 115,904,952 bytes)
--    λ> length (caminos3 (fromList 11 11 [1..]))
--    184756
--    (2.22 secs, 614,472,136 bytes)

import Data.Matrix

-- 1ª definición de caminos (por recursión)

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

caminos1 :: Matrix Int -> [[Int]]

caminos1 a = aux (1,1)

where

aux (i,j)

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

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

| otherwise = [a!(i,j) : cs | cs <- aux (i+1,j) ++ aux (i,j+1)]

where m = nrows a

n = ncols a

-- 2ª solución (mediante programación dinámica)

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

caminos2 :: Matrix Int -> [[Int]]

caminos2 a = q ! (1,1)

where

q = matrix m n f

m = nrows a

n = ncols a

f (i,j) | i == m = [[a!(i,k) | k <- [j..n]]]

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

| otherwise = [a!(i,j) : cs | cs <- q!(i+1,j) ++ q!(i,j+1)]

-- 3ª solución

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

caminos3 :: Matrix Int -> [[Int]]

caminos3 a

| m == 1 || n == 1 = [toList a]

| otherwise = map (a ! (1,1):) (caminos3 (submatrix 2 m 1 n a) ++

caminos3 (submatrix 1 m 2 n a))

where m = nrows a

n = ncols a

-- Comparación de eficiencia

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

-- λ> length (caminos1 (fromList 11 11 [1..]))

-- 184756

-- (4.15 secs, 738,764,712 bytes)

-- λ> length (caminos2 (fromList 11 11 [1..]))

-- 184756

-- (0.74 secs, 115,904,952 bytes)

-- λ> length (caminos3 (fromList 11 11 [1..]))

-- 184756

-- (2.22 secs, 614,472,136 bytes)

Máxima longitud de sublistas crecientes

PorJosé A. Alonso 7-mayo-202014-mayo-2020

Definir la función

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

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

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

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

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

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

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

λ> longitudMayorSublistaCreciente [1..2000]

2000

λ> longitudMayorSublistaCreciente [2000,1999..1]

λ> import System.Random

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

λ> longitudMayorSublistaCreciente2 xs

λ> longitudMayorSublistaCreciente3 xs

Nota: Se puede usar programación dinámica para aumentar la eficiencia.

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)

La sucesión de Sylvester

PorJosé A. Alonso 6-mayo-202013-mayo-2020

La sucesión de Sylvester es la sucesión que comienza en 2 y sus restantes términos se obtienen multiplicando los anteriores y sumándole 1.

Definir las funciones

   sylvester        :: Integer -> Integer
   graficaSylvester :: Integer -> Integer -> IO ()

1 2	sylvester :: Integer -> Integer graficaSylvester :: Integer -> Integer -> IO ()

tales que

(sylvester n) es el n-ésimo término de la sucesión de Sylvester. Por ejemplo,

     λ> [sylvester n | n <- [0..7]]
     [2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]
     λ> length (show (sylvester 25))
     6830085

λ> [sylvester n | n <- [0..7]]

[2,3,7,43,1807,3263443,10650056950807,113423713055421844361000443]

λ> length (show (sylvester 25))

6830085

(graficaSylvester d n) dibuja la gráfica de los d últimos dígitos de los n primeros términos de la sucesión de Sylvester. Por ejemplo,
- (graficaSylvester 3 30) dibuja
- (graficaSylvester 4 30) dibuja
- (graficaSylvester 5 30) dibuja

Nota: Se puede usar programación dinámica para aumentar la eficiencia.

Soluciones

import Data.List               (genericIndex)
import Data.Array              ((!), array)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG))

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

sylvester1 :: Integer -> Integer
sylvester1 0 = 2
sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

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

sylvester2 :: Integer -> Integer
sylvester2 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 2
  f m = 1 + product [v!k | k <- [0..m-1]]

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

-- Observando que
--    S(n) = 1 + S(0)*S(1)*...*S(n-2)*S(n-1)
--         = 1 + (1 + S(0)*S(1)*...*S(n-2))*S(n-1) - S(n-1)
--         = 1 + S(n-1)*S(n-1) - S(n-1)
--         = 1 + S(n-1)^2 - S(n-1)
-- se obtiene la siguiente definición.
sylvester3 :: Integer -> Integer
sylvester3 0 = 2
sylvester3 n = 1 + x^2 - x
  where x = sylvester3 (n-1)

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

sylvester4 :: Integer -> Integer
sylvester4 n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 2
  f m = 1 + x^2 - x
    where x = v ! (m-1)

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

sylvester5 :: Integer -> Integer
sylvester5 n = sucSylvester5 `genericIndex` n

sucSylvester5 :: [Integer]
sucSylvester5 = iterate (\x -> (x-1)*x+1) 2 

-- La comparación es
--    λ> length (show (sylvester1 23))
--    1707522
--    (6.03 secs, 4,090,415,704 bytes)
--    λ> length (show (sylvester2 23))
--    1707522
--    (0.33 secs, 109,477,296 bytes)
--    λ> length (show (sylvester3 23))
--    1707522
--    (0.35 secs, 109,395,136 bytes)
--    λ> length (show (sylvester4 23))
--    1707522
--    (0.33 secs, 109,402,440 bytes)
--    λ> length (show (sylvester5 23))
--    1707522
--    (0.30 secs, 108,676,256 bytes)

graficaSylvester :: Integer -> Integer -> IO ()
graficaSylvester d n =
  plotList [ Key Nothing
           , PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")
           ]
           [sylvester5 k `mod` (10^d) | k <- [0..n]]

import Data.List (genericIndex)

import Data.Array ((!), array)

import Graphics.Gnuplot.Simple (plotList, Attribute (Key, PNG))

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

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

sylvester1 :: Integer -> Integer

sylvester1 0 = 2

sylvester1 n = 1 + product [sylvester1 k | k <- [0..n-1]]

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

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

sylvester2 :: Integer -> Integer

sylvester2 n = v ! n where

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

f 0 = 2

f m = 1 + product [v!k | k <- [0..m-1]]

-- 3ª solución

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

-- Observando que

-- S(n) = 1 + S(0)*S(1)*...*S(n-2)*S(n-1)

-- = 1 + (1 + S(0)*S(1)*...*S(n-2))*S(n-1) - S(n-1)

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

-- = 1 + S(n-1)^2 - S(n-1)

-- se obtiene la siguiente definición.

sylvester3 :: Integer -> Integer

sylvester3 0 = 2

sylvester3 n = 1 + x^2 - x

where x = sylvester3 (n-1)

-- 4ª solución

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

sylvester4 :: Integer -> Integer

sylvester4 n = v ! n where

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

f 0 = 2

f m = 1 + x^2 - x

where x = v ! (m-1)

-- 5ª solución

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

sylvester5 :: Integer -> Integer

sylvester5 n = sucSylvester5 `genericIndex` n

sucSylvester5 :: [Integer]

sucSylvester5 = iterate (\x -> (x-1)*x+1) 2

-- La comparación es

-- λ> length (show (sylvester1 23))

-- 1707522

-- (6.03 secs, 4,090,415,704 bytes)

-- λ> length (show (sylvester2 23))

-- 1707522

-- (0.33 secs, 109,477,296 bytes)

-- λ> length (show (sylvester3 23))

-- 1707522

-- (0.35 secs, 109,395,136 bytes)

-- λ> length (show (sylvester4 23))

-- 1707522

-- (0.33 secs, 109,402,440 bytes)

-- λ> length (show (sylvester5 23))

-- 1707522

-- (0.30 secs, 108,676,256 bytes)

graficaSylvester :: Integer -> Integer -> IO ()

graficaSylvester d n =

plotList [ Key Nothing

, PNG ("La_sucesion_de_Sylvester_" ++ show (d,n) ++ ".png")

]

[sylvester5 k `mod` (10^d) | k <- [0..n]]

Matriz de mínimas distancias

PorJosé A. Alonso 22-abril-202029-abril-2020

Definir las funciones

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

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

tales que

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

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

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

( 1 0 0 )

( 2 1 0 )

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

( 1 1 0 )

( 0 1 1 )

λ> minimasDistancias (identity 5)

( 0 1 2 3 4 )

( 1 0 1 2 3 )

( 2 1 0 1 2 )

( 3 2 1 0 1 )

( 4 3 2 1 0 )

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

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

sumaMinimaDistanciasIdentidad 5 == 40

sumaMinimaDistanciasIdentidad (10^2) == 333300

sumaMinimaDistanciasIdentidad (10^4) == 333333330000

sumaMinimaDistanciasIdentidad (10^6) == 333333333333000000

Soluciones

import Data.Matrix     
import Data.Maybe      
import Test.QuickCheck 

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

minimasDistancias :: Matrix Int -> Matrix Int
minimasDistancias a = 
  matrix (nrows a) (ncols a) (\(i,j) -> minimaDistancia (i,j) a) 
 
minimaDistancia :: (Int,Int) -> Matrix Int -> Int
minimaDistancia (a,b) p =
  minimum [distancia (a,b) (c,d) | (c,d) <- unos p]
 
unos :: Matrix Int -> [(Int,Int)]
unos p = [(i,j) | i <- [1..nrows p]
                , j <- [1..ncols p]
                , p ! (i,j) == 1]
 
distancia :: (Int,Int) -> (Int,Int) -> Int
distancia (a,b) (c,d) = abs (c - a) + abs (d - b)

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

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

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

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

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

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

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

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

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

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

-- La comparación es
--    λ> maximum (minimasDistancias (identity 40))
--    39
--    (3.85 secs, 654,473,496 bytes)
--    λ> maximum (minimasDistancias2 (identity 40))
--    39
--    (0.50 secs, 75,079,912 bytes)

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

import Data.Matrix

import Data.Maybe

import Test.QuickCheck

-- 1ª definición de minimasDistancias

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

minimasDistancias :: Matrix Int -> Matrix Int

minimasDistancias a =

matrix (nrows a) (ncols a) (\(i,j) -> minimaDistancia (i,j) a)

minimaDistancia :: (Int,Int) -> Matrix Int -> Int

minimaDistancia (a,b) p =

minimum [distancia (a,b) (c,d) | (c,d) <- unos p]

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

unos p = [(i,j) | i <- [1..nrows p]

, j <- [1..ncols p]

, p ! (i,j) == 1]

distancia :: (Int,Int) -> (Int,Int) -> Int

distancia (a,b) (c,d) = abs (c - a) + abs (d - b)

-- 2ª definición de minimasDistancias

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

minimasDistancias2 :: Matrix Int -> Matrix Int

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

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

| otherwise = c

where c = propagacion b

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

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

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

-- ( Nothing Nothing Just 0 )

-- ( Just 0 Nothing Nothing )

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

matrizInicial a = matrix m n f

where m = nrows a

n = ncols a

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

| otherwise = Nothing

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

-- de a por el siguiente del mínimo de los valores de sus vecinos. Por

-- ejemplo,

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

-- ( Just 1 Just 0 Just 0 )

-- ( Nothing Just 1 Just 0 )

-- λ> propagacion it

-- ( Just 1 Just 0 Just 0 )

-- ( Just 2 Just 1 Just 0 )

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

propagacion a = matrix m n f

where

m = nrows a

n = ncols a

f (i,j) | isJust x = x

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

where x = a ! (i,j)

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

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

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

-- λ> a

-- ( 1 2 3 4 )

-- ( 5 6 7 8 )

-- ( 9 10 11 12 )

-- λ> valoresVecinos a (1,1)

-- [5,2]

-- λ> valoresVecinos a (2,3)

-- [3,11,6,8]

-- λ> valoresVecinos a (2,4)

-- [4,12,7]

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

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

where m = nrows a

n = ncols a

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

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

-- derecha, arriba o abajo. por ejemplo,

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

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

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

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

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

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

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

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

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

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

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

minimo :: [Maybe Int] -> Maybe Int

minimo = foldr1 minimo2

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

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

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

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

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

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

-- minimo2 Nothing Nothing == Nothing

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

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

minimo2 Nothing (Just y) = Just y

minimo2 (Just x) Nothing = Just x

minimo2 Nothing Nothing = Nothing

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

-- Nothing como el infinito). Por ejemplo,

-- siguiente (Just 3) == Just 4

-- siguiente Nothing == Nothing

siguiente :: Maybe Int -> Maybe Int

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

siguiente Nothing = Nothing

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (minimasDistancias (identity 40))

-- 39

-- (3.85 secs, 654,473,496 bytes)

-- λ> maximum (minimasDistancias2 (identity 40))

-- 39

-- (0.50 secs, 75,079,912 bytes)

-- 1ª definición de sumaMinimaDistanciasIdentidad

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

sumaMinimaDistanciasIdentidad :: Int -> Int

sumaMinimaDistanciasIdentidad n =

sum (minimasDistancias (identity n))

-- 2ª definición de sumaMinimaDistanciasIdentidad

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

sumaMinimaDistanciasIdentidad2 :: Int -> Int

sumaMinimaDistanciasIdentidad2 n =

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

-- Equivalencia de las definiciones de sumaMinimaDistanciasIdentidad

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

-- La propiedad es

prop_MinimaDistanciasIdentidad :: Positive Int -> Bool

prop_MinimaDistanciasIdentidad (Positive n) =

sumaMinimaDistanciasIdentidad n == sumaMinimaDistanciasIdentidad2 n

-- La comprobación es

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

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia de sumaMinimaDistanciasIdentidad

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

-- La comparación es

-- λ> sumaMinimaDistanciasIdentidad 50

-- 41650

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

-- λ> sumaMinimaDistanciasIdentidad 100

-- 333300

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

-- λ> sumaMinimaDistanciasIdentidad 200

-- 2666600

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

-- λ> sumaMinimaDistanciasIdentidad2 50

-- 41650

-- (0.00 secs, 126,944 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 100

-- 333300

-- (0.00 secs, 126,872 bytes)

-- λ> sumaMinimaDistanciasIdentidad2 200

-- 2666600

-- (0.00 secs, 131,240 bytes)

-- Resumidamente, el tiempo es

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

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

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

-- | 50 | 0.24 | 0.00 |

-- | 100 | 1.98 | 0.00 |

-- | 200 | 17.96 | 0.00 |

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

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>

Matrices de Hadamard

PorJosé A. Alonso 16-abril-202029-abril-2020

Las matrices de Hadamard se definen recursivamente como sigue

   λ> hadamard 0
   ( 1 )
   
   λ> hadamard 1
   (  1  1 )
   (  1 -1 )
   
   λ> hadamard 2
   (  1  1  1  1 )
   (  1 -1  1 -1 )
   (  1  1 -1 -1 )
   (  1 -1 -1  1 )
   
   λ> hadamard 3
   (  1  1  1  1  1  1  1  1 )
   (  1 -1  1 -1  1 -1  1 -1 )
   (  1  1 -1 -1  1  1 -1 -1 )
   (  1 -1 -1  1  1 -1 -1  1 )
   (  1  1  1  1 -1 -1 -1 -1 )
   (  1 -1  1 -1 -1  1 -1  1 )
   (  1  1 -1 -1 -1 -1  1  1 )
   (  1 -1 -1  1 -1  1  1 -1 )

λ> hadamard 0

( 1 )

λ> hadamard 1

( 1 1 )

( 1 -1 )

λ> hadamard 2

( 1 1 1 1 )

( 1 -1 1 -1 )

( 1 1 -1 -1 )

( 1 -1 -1 1 )

λ> hadamard 3

( 1 1 1 1 1 1 1 1 )

( 1 -1 1 -1 1 -1 1 -1 )

( 1 1 -1 -1 1 1 -1 -1 )

( 1 -1 -1 1 1 -1 -1 1 )

( 1 1 1 1 -1 -1 -1 -1 )

( 1 -1 1 -1 -1 1 -1 1 )

( 1 1 -1 -1 -1 -1 1 1 )

( 1 -1 -1 1 -1 1 1 -1 )

En general, la n-ésima matriz de Hadamard, H(n), es

   ( H(n-1)  H(n-1) )
   ( H(n-1) -H(n-1) )

1 2	( H(n-1) H(n-1) ) ( H(n-1) -H(n-1) )

Definir la función

   hadamard :: Int -> Matrix Int

1	hadamard :: Int -> Matrix Int

tal que (hadamard n) es la n-ésima matriz de Hadamard.

Comprobar con QuickCheck que para todo número natural n, el producto de la n-ésima matriz de Hadamard y su traspuesta es igual al producto de 2^n por la matriz identidad de orden 2^n.

Soluciones

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)
import Test.QuickCheck 

hadamard :: Int -> Matrix Int
hadamard 0 = identity 1
hadamard n = joinBlocks (a, a, a, b)
  where a = hadamard (n-1)
        b = scaleMatrix (-1) a

-- La propiedad es
prop_Hadamard :: (Positive Int) -> Bool
prop_Hadamard (Positive n) =
  h * transpose h == scaleMatrix (2^n) (identity (2^n))
  where h = hadamard n

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

import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose)

import Test.QuickCheck

hadamard :: Int -> Matrix Int

hadamard 0 = identity 1

hadamard n = joinBlocks (a, a, a, b)

where a = hadamard (n-1)

b = scaleMatrix (-1) a

-- La propiedad es

prop_Hadamard :: (Positive Int) -> Bool

prop_Hadamard (Positive n) =

h * transpose h == scaleMatrix (2^n) (identity (2^n))

where h = hadamard n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_Hadamard

-- +++ OK, passed 100 tests.

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>

Cálculo de dígitos de pi y su distribución

PorJosé A. Alonso 8-abril-202021-abril-2020

Se pueden generar los dígitos de Pi, como se explica en el artículo Unbounded spigot algorithms for the digits of pi c0on la función digitosPi definida por

   digitosPi :: [Integer]
   digitosPi = g(1,0,1,1,3,3) where
     g (q,r,t,k,n,l) = 
       if 4*q+r-t < n*t
       then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
       else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k,n,l) =

if 4*q+r-t < n*t

then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)

else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

Por ejemplo,

   λ> take 25 digitosPi
   [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

1 2	λ> take 25 digitosPi [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3]

La distribución de los primeros 25 dígitos de pi es [0,2,3,5,3,3,3,1,2,3] ya que el 0 no aparece, el 1 ocurre 2 veces, el 3 ocurre 3 veces, el 4 ocurre 5 veces, …

Usando digitosPi, definir las siguientes funciones

   distribucionDigitosPi :: Int -> [Int]
   frecuenciaDigitosPi   :: Int -> [Double]

1 2	distribucionDigitosPi :: Int -> [Int] frecuenciaDigitosPi :: Int -> [Double]

tales que

(distribucionDigitosPi n) es la distribución de los n primeros dígitos de pi. Por ejemplo,

     λ> distribucionDigitosPi 10
     [0,2,1,2,1,2,1,0,0,1]
     λ> distribucionDigitosPi 100
     [8,8,12,12,10,8,9,8,12,13]
     λ> distribucionDigitosPi 1000
     [93,116,103,103,93,97,94,95,101,105]
     λ> distribucionDigitosPi 5000
     [466,531,496,460,508,525,513,488,492,521]

λ> distribucionDigitosPi 10

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

λ> distribucionDigitosPi 100

[8,8,12,12,10,8,9,8,12,13]

λ> distribucionDigitosPi 1000

[93,116,103,103,93,97,94,95,101,105]

λ> distribucionDigitosPi 5000

[466,531,496,460,508,525,513,488,492,521]

(frecuenciaDigitosPi n) es la frecuencia de los n primeros dígitos de pi. Por ejemplo,

   λ> frecuenciaDigitosPi 10
   [0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]
   λ> frecuenciaDigitosPi 100
   [8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]
   λ> frecuenciaDigitosPi 1000
   [9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]
   λ> frecuenciaDigitosPi 5000
   [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

λ> frecuenciaDigitosPi 10

[0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0]

λ> frecuenciaDigitosPi 100

[8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0]

λ> frecuenciaDigitosPi 1000

[9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5]

λ> frecuenciaDigitosPi 5000

[9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]

Soluciones

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

digitosPi :: [Integer]
digitosPi = g(1,0,1,1,3,3) where
  g (q,r,t,k,n,l) = 
    if 4*q+r-t < n*t
    then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l)
    else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2)

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

distribucionDigitosPi :: Int -> [Int]
distribucionDigitosPi n =
  elems (accumArray (+) 0 (0,9) [ (i,1)
                                | i <- take n digitosPi]) 

frecuenciaDigitosPi :: Int -> [Double]
frecuenciaDigitosPi n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi n]
  where m = fromIntegral n

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

distribucionDigitosPi2 :: Int -> [Int]
distribucionDigitosPi2 n =
  [length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))]

frecuenciaDigitosPi2 :: Int -> [Double]
frecuenciaDigitosPi2 n =
  [100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n]
  where m = fromIntegral n

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

--    λ> last (take 5000 digitosPi)
--    2
--    (4.47 secs, 3,927,848,448 bytes)
--    λ> frecuenciaDigitosPi 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.01 secs, 0 bytes)
--    λ> frecuenciaDigitosPi2 5000
--    [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42]
--    (0.02 secs, 0 bytes)

import Data.Array

import Data.List (group, sort)

digitosPi :: [Integer]

digitosPi = g(1,0,1,1,3,3) where

g (q,r,t,k