Recursión

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>

Elemento más repetido de manera consecutiva

PorJosé A. Alonso 24-marzo-202231-marzo-2022

Definir la función

   masRepetido :: Ord a => [a] -> (a,Int)

1	masRepetido :: Ord a => [a] -> (a,Int)

tal que (masRepetido xs) es el elemento de xs que aparece más veces de manera consecutiva en la lista junto con el número de sus apariciones consecutivas; en caso de empate, se devuelve el mayor de dichos elementos. Por ejemplo,

   masRepetido [1,1,4,4,1]  ==  (4,2)
   masRepetido [4,4,1,1,5]  ==  (4,2)
   masRepetido "aadda"      ==  ('d',2)
   masRepetido "ddaab"      ==  ('d',2)
   masRepetido (show (product [1..5*10^4]))  ==  ('0',12499)

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

masRepetido [4,4,1,1,5] == (4,2)

masRepetido "aadda" == ('d',2)

masRepetido "ddaab" == ('d',2)

masRepetido (show (product [1..5*10^4])) == ('0',12499)

Soluciones

import Data.List (group)
import Data.Tuple (swap)
import Control.Arrow ((&&&))
import Test.QuickCheck

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

masRepetido1 :: Ord a => [a] -> (a,Int)
masRepetido1 [x] = (x,1)
masRepetido1 (x:y:zs) | m > n      = (x,m)
                      | m == n     = (max x u,m)
                      | otherwise  = (u,n)
  where (u,n)  = masRepetido1 (y:zs)
        m      = length (takeWhile (==x) (x:y:zs))

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

masRepetido2 :: Ord a => [a] -> (a,Int)
masRepetido2 (x:xs)
  | null xs'   = (x,length (x:xs))
  | m > n      = (x,m)
  | m == n     = (max x u,m)
  | otherwise  = (u,n)
  where xs'    = dropWhile (== x) xs
        m      = length (takeWhile (==x) (x:xs))
        (u,n)  = masRepetido2 xs'

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

masRepetido3 :: Ord a => [a] -> (a,Int)
masRepetido3 xs = (n,z)
  where (z,n) = maximum [(1 + length ys,y) | (y:ys) <- group xs]

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

masRepetido4 :: Ord a => [a] -> (a,Int)
masRepetido4 xs =
  swap (maximum [(1 + length ys,y) | (y:ys) <- group xs])

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

masRepetido5 :: Ord a => [a] -> (a,Int)
masRepetido5 xs =
  swap (maximum (map (\ys -> (length ys, head ys)) (group xs)))

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

masRepetido6 :: Ord a => [a] -> (a,Int)
masRepetido6 =
  swap . maximum . map ((,) <$> length <*> head) . group

-- 7ª solución
-- ============

masRepetido7 :: Ord a => [a] -> (a,Int)
masRepetido7 =
  swap . maximum . map (length &&& head) . group

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

-- La propiedad es
prop_masRepetido :: NonEmptyList Int -> Bool
prop_masRepetido (NonEmpty xs) =
  all (== masRepetido1 xs)
      [masRepetido2 xs,
       masRepetido3 xs,
       masRepetido4 xs,
       masRepetido5 xs,
       masRepetido6 xs,
       masRepetido7 xs]

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

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

-- La comparación es
--    λ> masRepetido1 (show (product [1..3*10^4]))
--    ('0',7498)
--    (3.72 secs, 2,589,930,952 bytes)
--    λ> masRepetido2 (show (product [1..3*10^4]))
--    ('0',7498)
--    (1.27 secs, 991,406,232 bytes)
--    λ> masRepetido3 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.85 secs, 945,399,976 bytes)
--    λ> masRepetido4 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.86 secs, 945,399,888 bytes)
--    λ> masRepetido5 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.80 secs, 943,760,760 bytes)
--    λ> masRepetido6 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.78 secs, 945,400,400 bytes)
--    λ> masRepetido7 (show (product [1..3*10^4]))
--    ('0',7498)
--    (0.78 secs, 942,122,088 bytes)
--
--    λ> masRepetido2 (show (product [1..5*10^4]))
--    ('0',12499)
--    (3.27 secs, 2,798,156,008 bytes)
--    λ> masRepetido3 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.20 secs, 2,716,952,408 bytes)
--    λ> masRepetido4 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.22 secs, 2,716,952,320 bytes)
--    λ> masRepetido5 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.18 secs, 2,714,062,328 bytes)
--    λ> masRepetido6 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.17 secs, 2,716,952,832 bytes)
--    λ> masRepetido7 (show (product [1..5*10^4]))
--    ('0',12499)
--    (2.17 secs, 2,711,172,792 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

import Data.List (group)

import Data.Tuple (swap)

import Control.Arrow ((&&&))

import Test.QuickCheck

-- 1ª solución

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

masRepetido1 :: Ord a => [a] -> (a,Int)

masRepetido1 [x] = (x,1)

masRepetido1 (x:y:zs) | m > n = (x,m)

| m == n = (max x u,m)

| otherwise = (u,n)

where (u,n) = masRepetido1 (y:zs)

m = length (takeWhile (==x) (x:y:zs))

-- 2ª solución

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

masRepetido2 :: Ord a => [a] -> (a,Int)

masRepetido2 (x:xs)

| null xs' = (x,length (x:xs))

| m > n = (x,m)

| m == n = (max x u,m)

| otherwise = (u,n)

where xs' = dropWhile (== x) xs

m = length (takeWhile (==x) (x:xs))

(u,n) = masRepetido2 xs'

-- 3ª solución

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

masRepetido3 :: Ord a => [a] -> (a,Int)

masRepetido3 xs = (n,z)

where (z,n) = maximum [(1 + length ys,y) | (y:ys) <- group xs]

-- 4ª solución

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

masRepetido4 :: Ord a => [a] -> (a,Int)

masRepetido4 xs =

swap (maximum [(1 + length ys,y) | (y:ys) <- group xs])

-- 5ª solución

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

masRepetido5 :: Ord a => [a] -> (a,Int)

masRepetido5 xs =

swap (maximum (map (\ys -> (length ys, head ys)) (group xs)))

-- 6ª solución

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

masRepetido6 :: Ord a => [a] -> (a,Int)

masRepetido6 =

swap . maximum . map ((,) <$> length <*> head) . group

-- 7ª solución

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

masRepetido7 :: Ord a => [a] -> (a,Int)

masRepetido7 =

swap . maximum . map (length &&& head) . group

-- Comprobación de equivalencia

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

-- La propiedad es

prop_masRepetido :: NonEmptyList Int -> Bool

prop_masRepetido (NonEmpty xs) =

all (== masRepetido1 xs)

[masRepetido2 xs,

masRepetido3 xs,

masRepetido4 xs,

masRepetido5 xs,

masRepetido6 xs,

masRepetido7 xs]

-- La comprobación es

-- λ> quickCheck prop_masRepetido

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> masRepetido1 (show (product [1..3*10^4]))

-- ('0',7498)

-- (3.72 secs, 2,589,930,952 bytes)

-- λ> masRepetido2 (show (product [1..3*10^4]))

-- ('0',7498)

-- (1.27 secs, 991,406,232 bytes)

-- λ> masRepetido3 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.85 secs, 945,399,976 bytes)

-- λ> masRepetido4 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.86 secs, 945,399,888 bytes)

-- λ> masRepetido5 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.80 secs, 943,760,760 bytes)

-- λ> masRepetido6 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.78 secs, 945,400,400 bytes)

-- λ> masRepetido7 (show (product [1..3*10^4]))

-- ('0',7498)

-- (0.78 secs, 942,122,088 bytes)

-- λ> masRepetido2 (show (product [1..5*10^4]))

-- ('0',12499)

-- (3.27 secs, 2,798,156,008 bytes)

-- λ> masRepetido3 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.20 secs, 2,716,952,408 bytes)

-- λ> masRepetido4 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.22 secs, 2,716,952,320 bytes)

-- λ> masRepetido5 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.18 secs, 2,714,062,328 bytes)

-- λ> masRepetido6 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.17 secs, 2,716,952,832 bytes)

-- λ> masRepetido7 (show (product [1..5*10^4]))

-- ('0',12499)

-- (2.17 secs, 2,711,172,792 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>

Regiones determinadas por n rectas del plano

PorJosé A. Alonso 23-marzo-20222-abril-2022

En los siguientes dibujos se observa que el número máximo de regiones en el plano generadas con 1, 2 ó 3 líneas son 2, 4 ó 7, respectivamente.

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

\ |

\5|

| \

| | \

1 1 | 3 1 | 3 \ 6

------ ---|--- ---|----\---

2 2 | 4 2 | 4 \ 7

| | \

Definir la función

   regiones :: Integer -> Integer

1	regiones :: Integer -> Integer

tal que (regiones n) es el número máximo de regiones en el plano generadas con n líneas. Por ejemplo,

   regiones 1     ==  2
   regiones 2     ==  4
   regiones 3     ==  7
   regiones 100   ==  5051
   regiones 1000  ==  500501
   regiones 10000 ==  50005001
   length (show (regiones (10^(10^5)))) ==  200000
   length (show (regiones (10^(10^6)))) ==  2000000
   length (show (regiones (10^(10^6)))) ==  2000000
   length (show (regiones (10^(10^7)))) ==  20000000

regiones 1 == 2

regiones 2 == 4

regiones 3 == 7

regiones 100 == 5051

regiones 1000 == 500501

regiones 10000 == 50005001

length (show (regiones (10^(10^5)))) == 200000

length (show (regiones (10^(10^6)))) == 2000000

length (show (regiones (10^(10^7)))) == 20000000

Soluciones

import Data.List (genericIndex)
import Test.QuickCheck

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

regiones1 :: Integer -> Integer
regiones1 0 = 1
regiones1 n = regiones1 (n-1) + n

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

regiones2 :: Integer -> Integer
regiones2 n = 1 + sum [0..n]

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

regiones3 :: Integer -> Integer
regiones3 n = 1 + sumas `genericIndex` n

-- (sumas n) es la suma 0 + 1 + 2 +...+ n. Por ejemplo,
--    take 10 sumas  ==  [0,1,3,6,10,15,21,28,36,45]
sumas :: [Integer]
sumas = scanl1 (+) [0..]

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

regiones4 :: Integer -> Integer
regiones4 n = 1 + n*(n+1) `div` 2

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

-- La propiedad es
prop_regiones :: Positive Integer -> Bool
prop_regiones (Positive n) =
  all (== regiones1 n)
      [regiones2 n,
       regiones3 n,
       regiones4 n]

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

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

-- La comparación es
--    λ> regiones1 (4*10^6)
--    8000002000001
--    (2.20 secs, 938,105,888 bytes)
--    λ> regiones2 (4*10^6)
--    8000002000001
--    (0.77 secs, 645,391,624 bytes)
--    λ> regiones3 (4*10^6)
--    8000002000001
--    (1.22 secs, 1,381,375,296 bytes)
--    λ> regiones4 (4*10^6)
--    8000002000001
--    (0.01 secs, 484,552 bytes)

import Data.List (genericIndex)

import Test.QuickCheck

-- 1ª solución

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

regiones1 :: Integer -> Integer

regiones1 0 = 1

regiones1 n = regiones1 (n-1) + n

-- 2ª solución

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

regiones2 :: Integer -> Integer

regiones2 n = 1 + sum [0..n]

-- 3ª solución

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

regiones3 :: Integer -> Integer

regiones3 n = 1 + sumas `genericIndex` n

-- (sumas n) es la suma 0 + 1 + 2 +...+ n. Por ejemplo,

-- take 10 sumas == [0,1,3,6,10,15,21,28,36,45]

sumas :: [Integer]

sumas = scanl1 (+) [0..]

-- 4ª solución

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

regiones4 :: Integer -> Integer

regiones4 n = 1 + n*(n+1) `div` 2

-- Comprobación de equivalencia

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

-- La propiedad es

prop_regiones :: Positive Integer -> Bool

prop_regiones (Positive n) =

all (== regiones1 n)

[regiones2 n,

regiones3 n,

regiones4 n]

-- La comprobación es

-- λ> quickCheck prop_regiones

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> regiones1 (4*10^6)

-- 8000002000001

-- (2.20 secs, 938,105,888 bytes)

-- λ> regiones2 (4*10^6)

-- 8000002000001

-- (0.77 secs, 645,391,624 bytes)

-- λ> regiones3 (4*10^6)

-- 8000002000001

-- (1.22 secs, 1,381,375,296 bytes)

-- λ> regiones4 (4*10^6)

-- 8000002000001

-- (0.01 secs, 484,552 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>

Emparejamiento binario

PorJosé A. Alonso 21-marzo-202228-marzo-2022

Definir la función

   zipBinario :: [a -> b -> c] -> [a] -> [b] -> [c]

1	zipBinario :: [a -> b -> c] -> [a] -> [b] -> [c]

tal que (zipBinario fs xs ys) es la lista obtenida aplicando cada una de las operaciones binarias de fs a los correspondientes elementos de xs e ys. Por ejemplo,

   zipBinario [(+), (*), (*)] [2,2,2] [4,4,4]    == [6,8,8]
   zipBinario [(+)] [2,2,2] [4,4,4]              == [6]
   zipBinario [(<), (==), (==)] "coloca" "lobo"  == [True,True,False]

zipBinario [(+), (*), (*)] [2,2,2] [4,4,4] == [6,8,8]

zipBinario [(+)] [2,2,2] [4,4,4] == [6]

zipBinario [(<), (==), (==)] "coloca" "lobo" == [True,True,False]

Soluciones

import Test.QuickCheck
import Test.QuickCheck.HigherOrder
import Test.Hspec

-- 1ª solución
zipBinario1 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario1 (f:fs) (x:xs) (y:ys) = f x y : zipBinario1 fs xs ys
zipBinario1 _ _ _                = []

-- 2ª solución
zipBinario2 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario2 fs xs ys = [f x y | (f,(x,y)) <- zip fs (zip xs ys)]

-- 3ª solución
zipBinario3 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario3 fs xs ys = [f x y | (f,x,y) <- zip3 fs xs ys]

-- 4ª solución
zipBinario4 :: [a -> b -> c] -> [a] -> [b] -> [c]
zipBinario4 = zipWith3 id

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

especificacion :: ([Int -> Int -> Int] -> [Int] -> [Int] -> [Int]) -> Spec
especificacion zipBinario = do
  it "e1" $ zipBinario [(+), (*), (*)] [2,2,2] [4,4,4]    `shouldBe` [6,8,8]
  it "e2" $ zipBinario [(+)] [2,2,2] [4,4,4]              `shouldBe` [6]

verifica :: IO ()
verifica = hspec $ do
  describe "zipBinario1" $ especificacion zipBinario1
  describe "zipBinario2" $ especificacion zipBinario2
  describe "zipBinario3" $ especificacion zipBinario3
  describe "zipBinario4" $ especificacion zipBinario4

-- La verificación es
--    λ> verifica
--
--    zipBinario1
--      e1
--      e2
--    zipBinario2
--      e1
--      e2
--    zipBinario3
--      e1
--      e2
--    zipBinario4
--      e1
--      e2
--
--    Finished in 0.0016 seconds
--    8 examples, 0 failures

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


-- La propiedad es
prop_zipBinario :: [Bool -> Bool -> Bool] -> [Bool] -> [Bool] -> Bool
prop_zipBinario fs xs ys =
  all (== zipBinario1 fs xs ys)
      [g fs xs ys | g <- [zipBinario2,
                          zipBinario3,
                          zipBinario4]]

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

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

-- La comparación es
--    λ> maximum (zipBinario1 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (2.13 secs, 965,392,072 bytes)
--    λ> maximum (zipBinario2 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (1.86 secs, 1,109,392,176 bytes)
--    λ> maximum (zipBinario3 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (1.93 secs, 981,392,128 bytes)
--    λ> maximum (zipBinario4 (cycle [(+), (*)]) [1..] [1..2*10^6])
--    4000000000000
--    (1.07 secs, 773,392,040 bytes)

import Test.QuickCheck

import Test.QuickCheck.HigherOrder

import Test.Hspec

-- 1ª solución

zipBinario1 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario1 (f:fs) (x:xs) (y:ys) = f x y : zipBinario1 fs xs ys

zipBinario1 _ _ _ = []

-- 2ª solución

zipBinario2 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario2 fs xs ys = [f x y | (f,(x,y)) <- zip fs (zip xs ys)]

-- 3ª solución

zipBinario3 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario3 fs xs ys = [f x y | (f,x,y) <- zip3 fs xs ys]

-- 4ª solución

zipBinario4 :: [a -> b -> c] -> [a] -> [b] -> [c]

zipBinario4 = zipWith3 id

-- Verificación

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

especificacion :: ([Int -> Int -> Int] -> [Int] -> [Int] -> [Int]) -> Spec

especificacion zipBinario = do

it "e1" $ zipBinario [(+), (*), (*)] [2,2,2] [4,4,4] `shouldBe` [6,8,8]

it "e2" $ zipBinario [(+)] [2,2,2] [4,4,4] `shouldBe` [6]

verifica :: IO ()

verifica = hspec $ do

describe "zipBinario1" $ especificacion zipBinario1

describe "zipBinario2" $ especificacion zipBinario2

describe "zipBinario3" $ especificacion zipBinario3

describe "zipBinario4" $ especificacion zipBinario4

-- La verificación es

-- λ> verifica

-- zipBinario1

-- e1

-- e2

-- zipBinario2

-- e1

-- e2

-- zipBinario3

-- e1

-- e2

-- zipBinario4

-- e1

-- e2

-- Finished in 0.0016 seconds

-- 8 examples, 0 failures

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zipBinario :: [Bool -> Bool -> Bool] -> [Bool] -> [Bool] -> Bool

prop_zipBinario fs xs ys =

all (== zipBinario1 fs xs ys)

[g fs xs ys | g <- [zipBinario2,

zipBinario3,

zipBinario4]]

-- La comprobación es

-- λ> quickCheck' prop_zipBinario

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum (zipBinario1 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (2.13 secs, 965,392,072 bytes)

-- λ> maximum (zipBinario2 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (1.86 secs, 1,109,392,176 bytes)

-- λ> maximum (zipBinario3 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (1.93 secs, 981,392,128 bytes)

-- λ> maximum (zipBinario4 (cycle [(+), (*)]) [1..] [1..2*10^6])

-- 4000000000000

-- (1.07 secs, 773,392,040 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>

Numeración de las ternas de números naturales

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

Las ternas de números naturales se pueden ordenar como sigue

   (0,0,0),
   (0,0,1),(0,1,0),(1,0,0),
   (0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),
   (0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...
   ...

(0,0,0),

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

(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),

(0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...

...

Definir la función

   posicion :: (Int,Int,Int) -> Int

1	posicion :: (Int,Int,Int) -> Int

tal que (posicion (x,y,z)) es la posición de la terna de números naturales (x,y,z) en la ordenación anterior. Por ejemplo,

   posicion (0,1,0)  ==  2
   posicion (0,0,2)  ==  4
   posicion (0,1,1)  ==  5

posicion (0,1,0) == 2

posicion (0,0,2) == 4

posicion (0,1,1) == 5

Comprobar con QuickCheck que

la posición de (x,0,0) es x(x²+6x+11)/6
la posición de (0,y,0) es y(y²+3y+ 8)/6
la posición de (0,0,z) es z(z²+3z+ 2)/6
la posición de (x,x,x) es x(9x²+14x+7)/2

Soluciones

import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Test.QuickCheck

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

posicion1 :: (Int,Int,Int) -> Int
posicion1 t = aux 0 ternas
  where aux n (t':ts) | t' == t   = n
                      | otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,
--    λ> take 9 ternas
--    [(0,0,0),(0,0,1),(0,1,0),(1,0,0),(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0)]
ternas :: [(Int,Int,Int)]
ternas = [(x,y,n-x-y) | n <- [0..], x <- [0..n], y <- [0..n-x]]

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

posicion2 :: (Int,Int,Int) -> Int
posicion2 t =
  head [n | (n,t') <- zip [0..] ternas, t' == t]

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

posicion3 :: (Int,Int,Int) -> Int
posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,
--    indice 5 [0..]  ==  5
indice :: Eq a => a -> [a] -> Int
indice x ys = length (takeWhile (/= x) ys)

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

posicion4 :: (Int,Int,Int) -> Int
posicion4 t = fromJust (elemIndex t ternas)

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

posicion5 :: (Int,Int,Int) -> Int
posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia
-- ============

-- La propiedad es
prop_posicion_equiv :: NonNegative Int
                    -> NonNegative Int
                    -> NonNegative Int
                    -> Bool
prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =
  all (== posicion1 (x,y,z))
      [f (x,y,z) | f <- [ posicion2
                        , posicion3
                        , posicion4
                        , posicion5 ]]

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

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

-- La comparación es
--    λ> posicion1 (147,46,116)
--    5000000
--    (5.84 secs, 2,621,428,184 bytes)
--    λ> posicion2 (147,46,116)
--    5000000
--    (3.63 secs, 2,173,230,200 bytes)
--    λ> posicion3 (147,46,116)
--    5000000
--    (2.48 secs, 1,453,229,880 bytes)
--    λ> posicion4 (147,46,116)
--    5000000
--    (1.91 secs, 1,173,229,840 bytes)
--    λ> posicion5 (147,46,116)
--    5000000
--    (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición
posicion :: (Int,Int,Int) -> Int
posicion = posicion5

-- Propiedades
-- ===========

-- La 1ª propiedad es
prop_posicion1 :: NonNegative Int -> Bool
prop_posicion1 (NonNegative x) =
  posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1
--    +++ OK, passed 100 tests.

-- La 2ª propiedad es
prop_posicion2 :: NonNegative Int -> Bool
prop_posicion2 (NonNegative y) =
  posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2
--    +++ OK, passed 100 tests.

-- La 3ª propiedad es
prop_posicion3 :: NonNegative Int -> Bool
prop_posicion3 (NonNegative z) =
  posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3
--    +++ OK, passed 100 tests.

-- La 4ª propiedad es
prop_posicion4 :: NonNegative Int -> Bool
prop_posicion4 (NonNegative x) =
  posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

import Data.List (elemIndex)

import Data.Maybe (fromJust)

import Test.QuickCheck

-- 1ª solución

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

posicion1 :: (Int,Int,Int) -> Int

posicion1 t = aux 0 ternas

where aux n (t':ts) | t' == t = n

| otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,

-- λ> take 9 ternas

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

ternas :: [(Int,Int,Int)]

ternas = [(x,y,n-x-y) | n <- [0..], x <- [0..n], y <- [0..n-x]]

-- 2ª solución

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

posicion2 :: (Int,Int,Int) -> Int

posicion2 t =

head [n | (n,t') <- zip [0..] ternas, t' == t]

-- 3ª solución

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

posicion3 :: (Int,Int,Int) -> Int

posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,

-- indice 5 [0..] == 5

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

indice x ys = length (takeWhile (/= x) ys)

-- 4ª solución

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

posicion4 :: (Int,Int,Int) -> Int

posicion4 t = fromJust (elemIndex t ternas)

-- 5ª solución

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

posicion5 :: (Int,Int,Int) -> Int

posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia

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

-- La propiedad es

prop_posicion_equiv :: NonNegative Int

-> NonNegative Int

-> Bool

prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =

all (== posicion1 (x,y,z))

[f (x,y,z) | f <- [ posicion2

, posicion3

, posicion4

, posicion5 ]]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> posicion1 (147,46,116)

-- 5000000

-- (5.84 secs, 2,621,428,184 bytes)

-- λ> posicion2 (147,46,116)

-- 5000000

-- (3.63 secs, 2,173,230,200 bytes)

-- λ> posicion3 (147,46,116)

-- 5000000

-- (2.48 secs, 1,453,229,880 bytes)

-- λ> posicion4 (147,46,116)

-- 5000000

-- (1.91 secs, 1,173,229,840 bytes)

-- λ> posicion5 (147,46,116)

-- 5000000

-- (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición

posicion :: (Int,Int,Int) -> Int

posicion = posicion5

-- Propiedades

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

-- La 1ª propiedad es

prop_posicion1 :: NonNegative Int -> Bool

prop_posicion1 (NonNegative x) =

posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad es

prop_posicion2 :: NonNegative Int -> Bool

prop_posicion2 (NonNegative y) =

posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2

-- +++ OK, passed 100 tests.

-- La 3ª propiedad es

prop_posicion3 :: NonNegative Int -> Bool

prop_posicion3 (NonNegative z) =

posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3

-- +++ OK, passed 100 tests.

-- La 4ª propiedad es

prop_posicion4 :: NonNegative Int -> Bool

prop_posicion4 (NonNegative x) =

posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Mayor producto de las ramas de un árbol

Soluciones

Nuevas soluciones

Elemento más repetido de manera consecutiva

Soluciones

Nuevas soluciones

Regiones determinadas por n rectas del plano

Soluciones

Nuevas soluciones

Emparejamiento binario

Soluciones

Nuevas soluciones

Numeración de las ternas de números naturales

Soluciones

Entradas recientes

Buscar

Correo electrónico