arbitrary

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>

Enumeración de árboles binarios

PorJosé A. Alonso 6-abril-202213-abril-2022

Los árboles binarios se pueden representar mediante el tipo Arbol definido por

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

data Arbol a = H a

| N (Arbol a) a (Arbol a)

deriving Show

Por ejemplo, el árbol

        "B"
        / \
       /   \
      /     \
    "B"     "A"
    / \     / \
  "A" "B" "C" "C"

"B"

/ \

"B" "A"

/ \ / \

"A" "B" "C" "C"

se puede definir por

   ej1 :: Arbol String
   ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

1 2	ej1 :: Arbol String ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

Definir la función

   enumeraArbol :: Arbol t -> Arbol Int

1	enumeraArbol :: Arbol t -> Arbol Int

tal que (enumeraArbol a) es el árbol obtenido numerando las hojas y los nodos de a desde la hoja izquierda hasta la raíz. Por ejemplo,

   λ> enumeraArbol ej1
   N (N (H 0) 1 (H 2)) 3 (N (H 4) 5 (H 6))

1 2	λ> enumeraArbol ej1 N (N (H 0) 1 (H 2)) 3 (N (H 4) 5 (H 6))

Gráficamente,

         3
        / \
       /   \
      /     \
     1       5
    / \     / \
   0   2   4   6

/ \

1 5

/ \ / \

0 2 4 6

Soluciones

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized)
import Control.Monad.State (State, evalState, get, put)

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

ej1 :: Arbol String
ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

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

enumeraArbol1 :: Arbol t -> Arbol Int
enumeraArbol1 a = fst (aux a 0)
  where aux :: Arbol t -> Int -> (Arbol Int, Int)
        aux (H _) n     = (H n, n+1)
        aux (N i _ d) n = (N i' n1 d', n2)
          where (i', n1) = aux i n
                (d', n2) = aux d (n1+1)

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

enumeraArbol2 :: Arbol t -> Arbol Int
enumeraArbol2 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = do
          i' <- aux i
          n1 <- contador
          d' <- aux d
          return (N i' n1 d')

contador :: State Int Int
contador = do
  n <- get
  put (n+1)
  return n

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

enumeraArbol3 :: Arbol t -> Arbol Int
enumeraArbol3 a = evalState (aux a) 0
  where aux :: Arbol t -> State Int (Arbol Int)
        aux (H _)     = H <$> contador
        aux (N i _ d) = N <$> aux i <*> contador <*> aux d

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

-- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por
-- ejemplo,
--    λ> generate (arbolArbitrario 3 :: Gen (Arbol Int))
--    N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26))
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n
  | n <= 0    = H <$> arbitrary
  | otherwise = N <$> subarbol <*> arbitrary <*> subarbol
  where subarbol = arbolArbitrario (n `div` 2)

-- Arbol es una subclase de Arbitrary.
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_enumeraArbol :: Arbol Int -> Bool
prop_enumeraArbol a =
  all (== enumeraArbol1 a)
      [enumeraArbol2 a,
       enumeraArbol3 a]

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

import Test.QuickCheck (Arbitrary, Gen, arbitrary, quickCheck, sized)

import Control.Monad.State (State, evalState, get, put)

data Arbol a = H a

| N (Arbol a) a (Arbol a)

deriving (Show, Eq)

ej1 :: Arbol String

ej1 = N (N (H "A") "B" (H "B")) "B" (N (H "C") "A" (H "C"))

-- 1ª solución

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

enumeraArbol1 :: Arbol t -> Arbol Int

enumeraArbol1 a = fst (aux a 0)

where aux :: Arbol t -> Int -> (Arbol Int, Int)

aux (H _) n = (H n, n+1)

aux (N i _ d) n = (N i' n1 d', n2)

where (i', n1) = aux i n

(d', n2) = aux d (n1+1)

-- 2ª solución

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

enumeraArbol2 :: Arbol t -> Arbol Int

enumeraArbol2 a = evalState (aux a) 0

where aux :: Arbol t -> State Int (Arbol Int)

aux (H _) = H <$> contador

aux (N i _ d) = do

i' <- aux i

n1 <- contador

d' <- aux d

return (N i' n1 d')

contador :: State Int Int

contador = do

n <- get

put (n+1)

return n

-- 3ª solución

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

enumeraArbol3 :: Arbol t -> Arbol Int

enumeraArbol3 a = evalState (aux a) 0

where aux :: Arbol t -> State Int (Arbol Int)

aux (H _) = H <$> contador

aux (N i _ d) = N <$> aux i <*> contador <*> aux d

-- Comprobación de equivalencia

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

-- (arbolArbitrario n) genera un árbol aleatorio de orden n. Por

-- ejemplo,

-- λ> generate (arbolArbitrario 3 :: Gen (Arbol Int))

-- N (N (H 19) 0 (H (-27))) 21 (N (H 2) 17 (H 26))

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n

| n <= 0 = H <$> arbitrary

| otherwise = N <$> subarbol <*> arbitrary <*> subarbol

where subarbol = arbolArbitrario (n `div` 2)

-- Arbol es una subclase de Arbitrary.

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_enumeraArbol :: Arbol Int -> Bool

prop_enumeraArbol a =

all (== enumeraArbol1 a)

[enumeraArbol2 a,

enumeraArbol3 a]

-- La comprobación es

-- λ> quickCheck prop_enumeraArbol

-- +++ OK, passed 100 tests.

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>

[/schedule]

Mayor producto de las ramas de un árbol

PorJosé A. Alonso 28-marzo-20224-abril-2022

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

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

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

Por ejemplo, los árboles

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

1 3

/ \ /|\

2 3 / | \

| 5 4 7

4 | /\

6 2 1

se representan por

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

ej1, ej2 :: Arbol Int

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

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

Definir la función

   mayorProducto :: (Ord a, Num a) => Arbol a -> a

1	mayorProducto :: (Ord a, Num a) => Arbol a -> a

tal que (mayorProducto a) es el mayor producto de las ramas del árbol a. Por ejemplo,

   λ> mayorProducto (N 1 [N 2 [], N  3 []])
   3
   λ> mayorProducto (N 1 [N 8 [], N  4 [N 3 []]])
   12
   λ> mayorProducto (N 1 [N 2 [],N 3 [N 4 []]])
   12
   λ> mayorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
   90
   λ> mayorProducto (N (-8) [N 0 [N (-9) []],N 6 []])
   0
   λ> a = N (-4) [N (-7) [],N 14 [N 19 []],N (-1) [N (-6) [],N 21 []],N (-4) []]
   λ> mayorProducto a
   84

λ> mayorProducto (N 1 [N 2 [], N 3 []])

λ> mayorProducto (N 1 [N 8 [], N 4 [N 3 []]])

λ> mayorProducto (N 1 [N 2 [],N 3 [N 4 []]])

λ> mayorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

λ> mayorProducto (N (-8) [N 0 [N (-9) []],N 6 []])

λ> a = N (-4) [N (-7) [],N 14 [N 19 []],N (-1) [N (-6) [],N 21 []],N (-4) []]

λ> mayorProducto a

Soluciones

import Test.QuickCheck

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

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

mayorProducto1 :: (Ord a, Num a) => Arbol a -> a
mayorProducto1 a = maximum [product xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,
--    λ> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [[3,5,6],[3,4],[3,7,2],[3,7,1]]
ramas :: Arbol b -> [[b]]
ramas (N x []) = [[x]]
ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

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

mayorProducto2 :: (Ord a, Num a) => Arbol a -> a
mayorProducto2 a = maximum (map product (ramas a))

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

mayorProducto3 :: (Ord a, Num a) => Arbol a -> a
mayorProducto3 = maximum . map product . ramas

-- 4º solución
-- ===========

mayorProducto4 :: (Ord a, Num a) => Arbol a -> a
mayorProducto4 = maximum . productosRamas

-- (productosRamas a) es la lista de los productos de las ramas
-- del árbol a. Por ejemplo,
--    λ> productosRamas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    [90,12,42,21]
productosRamas :: (Ord a, Num a) => Arbol a -> [a]
productosRamas (N x []) = [x]
productosRamas (N x xs) = [x * y | a <- xs, y <- productosRamas a]

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

mayorProducto5 :: (Ord a, Num a) => Arbol a -> a
mayorProducto5 (N x []) = x
mayorProducto5 (N x xs)
  | x > 0     = x * maximum (map mayorProducto5 xs)
  | x == 0    = 0
  | otherwise = x * minimum (map menorProducto xs)

-- (menorProducto a) es el menor producto de las ramas del árbol
-- a. Por ejemplo,
--    λ> menorProducto (N 1 [N 2 [], N  3 []])
--    2
--    λ> menorProducto (N 1 [N 8 [], N  4 [N 3 []]])
--    8
--    λ> menorProducto (N 1 [N 2 [],N 3 [N 4 []]])
--    2
--    λ> menorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])
--    12
menorProducto :: (Ord a, Num a) => Arbol a -> a
menorProducto (N x []) = x
menorProducto (N x xs)
  | x > 0     = x * minimum (map menorProducto xs)
  | x == 0    = 0
  | otherwise = x * maximum (map mayorProducto2 xs)

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

mayorProducto6 :: (Ord a, Num a) => Arbol a -> a
mayorProducto6 = maximum . aux
  where aux (N a []) = [a]
        aux (N a b)  = [v,u]
          where u = maximum g
                v = minimum g
                g = map (*a) (concatMap aux b)

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,
--   > sample (arbolArbitrario 5 :: Gen (Arbol Int))
--   N 0 [N 0 []]
--   N (-2) []
--   N 4 []
--   N 2 [N 4 []]
--   N 8 []
--   N (-2) [N (-9) [],N 7 []]
--   N 11 []
--   N (-11) [N 4 [],N 14 []]
--   N 10 [N (-3) [],N 13 []]
--   N 12 [N 11 []]
--   N 20 [N (-18) [],N (-13) []]
arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)
arbolArbitrario n = do
  x  <- arbitrary
  ms <- sublistOf [0 .. n `div` 2]
  as <- mapM arbolArbitrario ms
  return (N x as)

-- Arbol es una subclase de Arbitraria
instance Arbitrary a => Arbitrary (Arbol a) where
  arbitrary = sized arbolArbitrario

-- La propiedad es
prop_mayorProducto :: Arbol Integer -> Bool
prop_mayorProducto a =
  all (== mayorProducto1 a)
      [f a | f <- [ mayorProducto2
                  , mayorProducto3
                  , mayorProducto4
                  , mayorProducto5
                  , mayorProducto6
                  ]]

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

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

-- La comparación es
--    λ> ejArbol <- generate (arbolArbitrario 600 :: Gen (Arbol Integer))
--    λ> mayorProducto1 ejArbol
--    2419727651266241493467136000
--    (1.87 secs, 1,082,764,480 bytes)
--    λ> mayorProducto2 ejArbol
--    2419727651266241493467136000
--    (1.57 secs, 1,023,144,008 bytes)
--    λ> mayorProducto3 ejArbol
--    2419727651266241493467136000
--    (1.55 secs, 1,023,144,248 bytes)
--    λ> mayorProducto4 ejArbol
--    2419727651266241493467136000
--    (1.60 secs, 824,473,800 bytes)
--    λ> mayorProducto5 ejArbol
--    2419727651266241493467136000
--    (0.83 secs, 732,370,352 bytes)
--    λ> mayorProducto6 ejArbol
--    2419727651266241493467136000
--    (0.98 secs, 817,473,344 bytes)
--
--    λ> ejArbol2 <- generate (arbolArbitrario 700 :: Gen (Arbol Integer))
--    λ> mayorProducto5 ejArbol2
--    1044758937398026715504640000000
--    (4.94 secs, 4,170,324,376 bytes)
--    λ> mayorProducto6 ejArbol2
--    1044758937398026715504640000000
--    (5.88 secs, 4,744,782,024 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

import Test.QuickCheck

data Arbol a = N a [Arbol a]

deriving Show

-- 1ª solución

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

mayorProducto1 :: (Ord a, Num a) => Arbol a -> a

mayorProducto1 a = maximum [product xs | xs <- ramas a]

-- (ramas a) es la lista de las ramas del árbol a. Por ejemplo,

-- λ> ramas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

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

ramas :: Arbol b -> [[b]]

ramas (N x []) = [[x]]

ramas (N x as) = [x : xs | a <- as, xs <- ramas a]

-- 2ª solución

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

mayorProducto2 :: (Ord a, Num a) => Arbol a -> a

mayorProducto2 a = maximum (map product (ramas a))

-- 3ª solución

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

mayorProducto3 :: (Ord a, Num a) => Arbol a -> a

mayorProducto3 = maximum . map product . ramas

-- 4º solución

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

mayorProducto4 :: (Ord a, Num a) => Arbol a -> a

mayorProducto4 = maximum . productosRamas

-- (productosRamas a) es la lista de los productos de las ramas

-- del árbol a. Por ejemplo,

-- λ> productosRamas (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

-- [90,12,42,21]

productosRamas :: (Ord a, Num a) => Arbol a -> [a]

productosRamas (N x []) = [x]

productosRamas (N x xs) = [x * y | a <- xs, y <- productosRamas a]

-- 5ª solución

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

mayorProducto5 :: (Ord a, Num a) => Arbol a -> a

mayorProducto5 (N x []) = x

mayorProducto5 (N x xs)

| x > 0 = x * maximum (map mayorProducto5 xs)

| x == 0 = 0

| otherwise = x * minimum (map menorProducto xs)

-- (menorProducto a) es el menor producto de las ramas del árbol

-- a. Por ejemplo,

-- λ> menorProducto (N 1 [N 2 [], N 3 []])

-- 2

-- λ> menorProducto (N 1 [N 8 [], N 4 [N 3 []]])

-- 8

-- λ> menorProducto (N 1 [N 2 [],N 3 [N 4 []]])

-- 2

-- λ> menorProducto (N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]])

-- 12

menorProducto :: (Ord a, Num a) => Arbol a -> a

menorProducto (N x []) = x

menorProducto (N x xs)

| x > 0 = x * minimum (map menorProducto xs)

| x == 0 = 0

| otherwise = x * maximum (map mayorProducto2 xs)

-- 6ª solución

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

mayorProducto6 :: (Ord a, Num a) => Arbol a -> a

mayorProducto6 = maximum . aux

where aux (N a []) = [a]

aux (N a b) = [v,u]

where u = maximum g

v = minimum g

g = map (*a) (concatMap aux b)

-- Comprobación de equivalencia

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

-- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo,

-- > sample (arbolArbitrario 5 :: Gen (Arbol Int))

-- N 0 [N 0 []]

-- N (-2) []

-- N 4 []

-- N 2 [N 4 []]

-- N 8 []

-- N (-2) [N (-9) [],N 7 []]

-- N 11 []

-- N (-11) [N 4 [],N 14 []]

-- N 10 [N (-3) [],N 13 []]

-- N 12 [N 11 []]

-- N 20 [N (-18) [],N (-13) []]

arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)

arbolArbitrario n = do

x <- arbitrary

ms <- sublistOf [0 .. n `div` 2]

as <- mapM arbolArbitrario ms

return (N x as)

-- Arbol es una subclase de Arbitraria

instance Arbitrary a => Arbitrary (Arbol a) where

arbitrary = sized arbolArbitrario

-- La propiedad es

prop_mayorProducto :: Arbol Integer -> Bool

prop_mayorProducto a =

all (== mayorProducto1 a)

[f a | f <- [ mayorProducto2

, mayorProducto3

, mayorProducto4

, mayorProducto5

, mayorProducto6

]]

-- La comprobación es

-- λ> quickCheck prop_mayorProducto

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ejArbol <- generate (arbolArbitrario 600 :: Gen (Arbol Integer))

-- λ> mayorProducto1 ejArbol

-- 2419727651266241493467136000

-- (1.87 secs, 1,082,764,480 bytes)

-- λ> mayorProducto2 ejArbol

-- 2419727651266241493467136000

-- (1.57 secs, 1,023,144,008 bytes)

-- λ> mayorProducto3 ejArbol

-- 2419727651266241493467136000

-- (1.55 secs, 1,023,144,248 bytes)

-- λ> mayorProducto4 ejArbol

-- 2419727651266241493467136000

-- (1.60 secs, 824,473,800 bytes)

-- λ> mayorProducto5 ejArbol

-- 2419727651266241493467136000

-- (0.83 secs, 732,370,352 bytes)

-- λ> mayorProducto6 ejArbol

-- 2419727651266241493467136000

-- (0.98 secs, 817,473,344 bytes)

-- λ> ejArbol2 <- generate (arbolArbitrario 700 :: Gen (Arbol Integer))

-- λ> mayorProducto5 ejArbol2

-- 1044758937398026715504640000000

-- (4.94 secs, 4,170,324,376 bytes)

-- λ> mayorProducto6 ejArbol2

-- 1044758937398026715504640000000

-- (5.88 secs, 4,744,782,024 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>

Teorema de existencia de divisores

PorJosé A. Alonso 10-enero-20206-junio-2022

El teorema de existencia de divisores afirma que

En cualquier subconjunto de {1, 2, …, 2m} con al menos m+1 elementos existen números distintos a, b tales que a divide a b.

Un conjunto de números naturales xs es mayoritario si existe un m tal que la lista de xs es un subconjunto de {1,2,…,2m} con al menos m+1 elementos. Por ejemplo, {2,3,5,6} porque es un subconjunto de {1,2,…,6} con más de 3 elementos.

Definir las funciones

   divisoresMultiplos :: [Integer] -> [(Integer,Integer)]
   esMayoritario :: [Integer] -> Bool

1 2	divisoresMultiplos :: [Integer] -> [(Integer,Integer)] esMayoritario :: [Integer] -> Bool

tales que

(divisores xs) es la lista de pares de elementos distintos de (a,b) tales que a divide a b. Por ejemplo,

     divisoresMultiplos [2,3,5,6]  ==  [(2,6),(3,6)]
     divisoresMultiplos [2,3,5]    ==  []
     divisoresMultiplos [4..8]     ==  [(4,8)]

divisoresMultiplos [2,3,5,6] == [(2,6),(3,6)]

divisoresMultiplos [2,3,5] == []

divisoresMultiplos [4..8] == [(4,8)]

(esMayoritario xs) se verifica xs es mayoritario. Por ejemplo,

     esMayoritario [2,3,5,6]  ==  True
     esMayoritario [2,3,5]    ==  False

1 2	esMayoritario [2,3,5,6] == True esMayoritario [2,3,5] == False

Comprobar con QuickCheck el teorema de existencia de divisores; es decir, en cualquier conjunto mayoritario existen números distintos a, b tales que a divide a b. Para la comprobación se puede usar el siguiente generador de conjuntos mayoritarios

   mayoritario :: Gen [Integer]
   mayoritario = do
     m' <- arbitrary
     let m = 1 + abs m'
     xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)
     return xs'

mayoritario :: Gen [Integer]

mayoritario = do

m' <- arbitrary

let m = 1 + abs m'

xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)

return xs'

con lo que la propiedad que hay que comprobar con QuickCheck es

   teorema_de_existencia_de_divisores :: Property
   teorema_de_existencia_de_divisores =
     forAll mayoritario (not . null . divisoresMultiplos)

teorema_de_existencia_de_divisores :: Property

teorema_de_existencia_de_divisores =

forAll mayoritario (not . null . divisoresMultiplos)

Soluciones

import Data.List (genericLength)
import Test.QuickCheck

divisoresMultiplos :: [Integer] -> [(Integer,Integer)]
divisoresMultiplos xs =
  [(x,y) | x <- xs
         , y <- xs
         , y /= x
         , y `mod` x == 0]

esMayoritario :: [Integer] -> Bool
esMayoritario xs =
  not (null xs) && length xs > ceiling (n / 2) 
  where n = fromIntegral (maximum xs)

-- Comprobación del teorema
-- ========================

-- La propiedad es
teorema_de_existencia_de_divisores :: Property
teorema_de_existencia_de_divisores =
  forAll mayoritario (not . null . divisoresMultiplos)

-- mayoritario es un generador de conjuntos mayoritarios. Por ejemplo, 
--    λ> sample mayoritario
--    [1,2]
--    [2,5,7,8]
--    [1,2,8,10,14]
--    [3,8,11,12,13,15,18,19,22,23,25,26]
--    [1,3,4,6]
--    [3,6,9,11,12,14,17,19]
mayoritario :: Gen [Integer]
mayoritario = do
  m' <- arbitrary
  let m = 1 + abs m'
  xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)
  return xs'

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

import Data.List (genericLength)

import Test.QuickCheck

divisoresMultiplos :: [Integer] -> [(Integer,Integer)]

divisoresMultiplos xs =

[(x,y) | x <- xs

, y <- xs

, y /= x

, y `mod` x == 0]

esMayoritario :: [Integer] -> Bool

esMayoritario xs =

not (null xs) && length xs > ceiling (n / 2)

where n = fromIntegral (maximum xs)

-- Comprobación del teorema

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

-- La propiedad es

teorema_de_existencia_de_divisores :: Property

teorema_de_existencia_de_divisores =

forAll mayoritario (not . null . divisoresMultiplos)

-- mayoritario es un generador de conjuntos mayoritarios. Por ejemplo,

-- λ> sample mayoritario

-- [1,2]

-- [2,5,7,8]

-- [1,2,8,10,14]

-- [3,8,11,12,13,15,18,19,22,23,25,26]

-- [1,3,4,6]

-- [3,6,9,11,12,14,17,19]

mayoritario :: Gen [Integer]

mayoritario = do

m' <- arbitrary

let m = 1 + abs m'

xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)

return xs'

-- La comprobación es

-- λ> quickCheck teorema_de_existencia_de_divisores

-- +++ OK, passed 100 tests.

Pensamiento

Guiomar, Guiomar,
mírame en ti castigado:
reo de haberte creado,
ya no te puedo olvidar.

Antonio Machado

Elementos de una matriz con algún vecino menor

Soluciones

Nuevas soluciones

Enumeración de árboles binarios

Soluciones

Nuevas soluciones

Mayor producto de las ramas de un árbol

Soluciones

Nuevas soluciones

Teorema de existencia de divisores

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico