maximum

Regresión lineal

PorJosé A. Alonso 20-febrero-201726-marzo-2022

Dadas dos listas de valores

   xs = [x(1), x(2), ..., x(n)]
   ys = [y(1), y(2), ..., y(n)]

1 2	xs = [x(1), x(2), ..., x(n)] ys = [y(1), y(2), ..., y(n)]

la ecuación de la recta de regresión de ys sobre xs es y = a+bx, donde

   b = (nΣx(i)y(i) - Σx(i)Σy(i)) / (nΣx(i)² - (Σx(i))²)
   a = (Σy(i) - bΣx(i)) / n

1 2	b = (nΣx(i)y(i) - Σx(i)Σy(i)) / (nΣx(i)² - (Σx(i))²) a = (Σy(i) - bΣx(i)) / n

Definir la función

   regresionLineal :: [Double] -> [Double] -> (Double,Double)

1	regresionLineal :: [Double] -> [Double] -> (Double,Double)

tal que (regresionLineal xs ys) es el par (a,b) de los coeficientes de la recta de regresión de ys sobre xs. Por ejemplo, para los valores

   ejX, ejY :: [Double]
   ejX = [5,  7, 10, 12, 16, 20, 23, 27, 19, 14]
   ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

ejX, ejY :: [Double]

ejX = [5, 7, 10, 12, 16, 20, 23, 27, 19, 14]

ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

se tiene

   λ> regresionLineal ejX ejY
   (5.195045748716805,0.9218924347243919)

1 2	λ> regresionLineal ejX ejY (5.195045748716805,0.9218924347243919)

Para comprobar la definición, se importa la librería Graphics.Gnuplot.Simple y se define el procedimiento

   grafica :: [Double] -> [Double] -> IO ()
   grafica xs ys = 
       plotPathsStyle 
         [YRange (0,10+mY)] 
         [(defaultStyle {plotType = Points,
                         lineSpec = CustomStyle [LineTitle "Datos",
                                                 PointType 2,
                                                 PointSize 2.5]},
                        zip xs ys),
          (defaultStyle {plotType = Lines,
                         lineSpec = CustomStyle [LineTitle "Ajuste",
                                                 LineWidth 2]},
                        [(x,a+b*x) | x <- [0..mX]])]
       where (a,b) = regresionLineal xs ys                      
             mX    = maximum xs
             mY    = maximum ys

grafica :: [Double] -> [Double] -> IO ()

grafica xs ys =

plotPathsStyle

[YRange (0,10+mY)]

[(defaultStyle {plotType = Points,

lineSpec = CustomStyle [LineTitle "Datos",

PointType 2,

PointSize 2.5]},

zip xs ys),

(defaultStyle {plotType = Lines,

lineSpec = CustomStyle [LineTitle "Ajuste",

LineWidth 2]},

[(x,a+b*x) | x <- [0..mX]])]

where (a,b) = regresionLineal xs ys

mX = maximum xs

mY = maximum ys

tal que (grafica xs ys) pinta los puntos correspondientes a las listas de valores xs e ys y su recta de regresión. Por ejemplo, con (grafica ejX ejY) se obtiene el siguiente dibujo

Soluciones

import Data.List (genericLength)
import Graphics.Gnuplot.Simple

ejX, ejY :: [Double]
ejX = [5,  7, 10, 12, 16, 20, 23, 27, 19, 14]
ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

regresionLineal :: [Double] -> [Double] -> (Double,Double)
regresionLineal xs ys = (a,b)
    where n     = genericLength xs
          sumX  = sum xs
          sumY  = sum ys
          sumX2 = sum (zipWith (*) xs xs)
          sumY2 = sum (zipWith (*) ys ys)
          sumXY = sum (zipWith (*) xs ys)
          b     = (n*sumXY - sumX*sumY) / (n*sumX2 - sumX^2)
          a     = (sumY - b*sumX) / n

grafica :: [Double] -> [Double] -> IO ()
grafica xs ys = 
    plotPathsStyle 
      [YRange (0,10+mY)] 
      [(defaultStyle {plotType = Points,
                      lineSpec = CustomStyle [LineTitle "Datos",
                                              PointType 2,
                                              PointSize 2.5]},
                     zip xs ys),
       (defaultStyle {plotType = Lines,
                      lineSpec = CustomStyle [LineTitle "Ajuste",
                                              LineWidth 2]},
                     [(x,a+b*x) | x <- [0..mX]])]
    where (a,b) = regresionLineal xs ys                      
          mX    = maximum xs
          mY    = maximum ys

import Data.List (genericLength)

import Graphics.Gnuplot.Simple

ejX, ejY :: [Double]

ejX = [5, 7, 10, 12, 16, 20, 23, 27, 19, 14]

ejY = [9, 11, 15, 16, 20, 24, 27, 29, 22, 20]

regresionLineal :: [Double] -> [Double] -> (Double,Double)

regresionLineal xs ys = (a,b)

where n = genericLength xs

sumX = sum xs

sumY = sum ys

sumX2 = sum (zipWith (*) xs xs)

sumY2 = sum (zipWith (*) ys ys)

sumXY = sum (zipWith (*) xs ys)

b = (n*sumXY - sumX*sumY) / (n*sumX2 - sumX^2)

a = (sumY - b*sumX) / n

grafica :: [Double] -> [Double] -> IO ()

grafica xs ys =

plotPathsStyle

[YRange (0,10+mY)]

[(defaultStyle {plotType = Points,

lineSpec = CustomStyle [LineTitle "Datos",

PointType 2,

PointSize 2.5]},

zip xs ys),

(defaultStyle {plotType = Lines,

lineSpec = CustomStyle [LineTitle "Ajuste",

LineWidth 2]},

[(x,a+b*x) | x <- [0..mX]])]

where (a,b) = regresionLineal xs ys

mX = maximum xs

mY = maximum ys

Suma de los máximos de los subconjuntos

PorJosé A. Alonso 8-diciembre-201615-diciembre-2016

Los subconjuntos distinto del vacío del conjunto {3, 2, 5}, junto con sus máximos elementos, son

   {3}       su máximo es 3
   {2}       su máximo es 2
   {5}       su máximo es 5
   {3, 2}    su máximo es 3
   {3, 5}    su máximo es 5
   {2, 5}    su máximo es 5
   {3, 2, 5} su máximo es 5

{3} su máximo es 3

{2} su máximo es 2

{5} su máximo es 5

{3, 2} su máximo es 3

{3, 5} su máximo es 5

{2, 5} su máximo es 5

{3, 2, 5} su máximo es 5

Por tanto, la suma de los máximos elementos de los subconjuntos de {3, 2, 5} es 3 + 2 + 5 + 3 + 5 + 5 + 5 = 28.

Definir la función

   sumaMaximos :: [Integer] -> Integer

1	sumaMaximos :: [Integer] -> Integer

tal que (sumaMaximos xs) es la suma de los máximos elementos de los subconjuntos de xs. Por ejemplo,

   sumaMaximos [3,2,5]    ==  28
   sumaMaximos [4,1,6,3]  ==  71
   sumaMaximos [1..100]   ==  125497409422594710748173617332225
   length (show (sumaMaximos [1..10^5]))  ==  30108
   sumaMaximos [1..10^5] `mod` (10^7)     ==  4490625

sumaMaximos [3,2,5] == 28

sumaMaximos [4,1,6,3] == 71

sumaMaximos [1..100] == 125497409422594710748173617332225

length (show (sumaMaximos [1..10^5])) == 30108

sumaMaximos [1..10^5] `mod` (10^7) == 4490625

Soluciones

import Data.List (sort, subsequences)

-- 1ª definición
sumaMaximos :: [Integer] -> Integer
sumaMaximos xs =
  sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición
sumaMaximos2 :: [Integer] -> Integer
sumaMaximos2 =
  sum . map maximum . tail . subsequences

-- 3ª definición
sumaMaximos3 :: [Integer] -> Integer
sumaMaximos3 xs =
  sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia
--    λ> sumaMaximos [1..20]
--    19922945
--    (2.74 secs, 703,957,848 bytes)
--    λ> sumaMaximos2 [1..20]
--    19922945
--    (2.06 secs, 680,728,696 bytes)
--    λ> sumaMaximos3 [1..20]
--    19922945
--    (0.01 secs, 0 bytes)

import Data.List (sort, subsequences)

-- 1ª definición

sumaMaximos :: [Integer] -> Integer

sumaMaximos xs =

sum [maximum ys | ys <- tail (subsequences xs)]

-- 2ª definición

sumaMaximos2 :: [Integer] -> Integer

sumaMaximos2 =

sum . map maximum . tail . subsequences

-- 3ª definición

sumaMaximos3 :: [Integer] -> Integer

sumaMaximos3 xs =

sum (zipWith (*) (sort xs) potenciasDeDos)

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- Comparación de eficiencia

-- λ> sumaMaximos [1..20]

-- 19922945

-- (2.74 secs, 703,957,848 bytes)

-- λ> sumaMaximos2 [1..20]

-- 19922945

-- (2.06 secs, 680,728,696 bytes)

-- λ> sumaMaximos3 [1..20]

-- 19922945

-- (0.01 secs, 0 bytes)

Basado en el artículo
Sum of maximum elements of all subsets
de Utkarsh Trivedi en GeeksforGeeks.

Máxima ramificación

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

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

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

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

Por ejemplo, los árboles

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

1 1 1

/ \ / \ / \

2 3 2 3 2 3

| /|\ /|\ |

4 4 5 6 4 5 6 7

se representan por

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

ej1, ej2, ej3 :: Arbol Int

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

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

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

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

Definir la función

   maximaRamificacion :: Arbol a -> Int

1	maximaRamificacion :: Arbol a -> Int

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

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

maximaRamificacion ej1 == 2

maximaRamificacion ej2 == 3

maximaRamificacion ej3 == 3

Soluciones

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

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

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

data Arbol a = N a [Arbol a]

deriving Show

ej1, ej2 :: Arbol Int

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

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

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

maximaRamificacion :: Arbol a -> Int

maximaRamificacion (N _ []) = 0

maximaRamificacion (N x xs) =

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

Máximo producto en la partición de un número

PorJosé A. Alonso 16-noviembre-201623-noviembre-2016

El artículo de esta semana de Antonio Roldán en su blog Números y hoja de cálculo es Máximo producto en la partición de un número (1)

Una partición de un entero positivo n es una forma de descomponer n como suma de enteros positivos. Dos sumas se considerarán iguales si solo difieren en el orden de los sumandos. Por ejemplo, las 11 particiones de 6 (con sus correspondientes productos) son

   6 = 6                      |  6                     = 6
   6 = 5 + 1                  |  5 x 1                 = 5
   6 = 4 + 2                  |  4 x 2                 = 8
   6 = 4 + 1 + 1              |  4 x 1 x 1             = 4
   6 = 3 + 3                  |  3 x 3                 = 9
   6 = 3 + 2 + 1              |  3 x 2 x 1             = 6
   6 = 3 + 1 + 1 + 1          |  3 x 1 x 1 x 1         = 3
   6 = 2 + 2 + 2              |  2 x 2 x 2             = 8
   6 = 2 + 2 + 1 + 1          |  2 x 2 x 1 x 1         = 4
   6 = 2 + 1 + 1 + 1 + 1      |  2 x 1 x 1 x 1 x 1     = 2
   6 = 1 + 1 + 1 + 1 + 1 + 1  |  1 x 1 x 1 x 1 x 1 x 1 = 1

6 = 6 | 6 = 6

6 = 5 + 1 | 5 x 1 = 5

6 = 4 + 2 | 4 x 2 = 8

6 = 4 + 1 + 1 | 4 x 1 x 1 = 4

6 = 3 + 3 | 3 x 3 = 9

6 = 3 + 2 + 1 | 3 x 2 x 1 = 6

6 = 3 + 1 + 1 + 1 | 3 x 1 x 1 x 1 = 3

6 = 2 + 2 + 2 | 2 x 2 x 2 = 8

6 = 2 + 2 + 1 + 1 | 2 x 2 x 1 x 1 = 4

6 = 2 + 1 + 1 + 1 + 1 | 2 x 1 x 1 x 1 x 1 = 2

6 = 1 + 1 + 1 + 1 + 1 + 1 | 1 x 1 x 1 x 1 x 1 x 1 = 1

Se observa que el máximo producto de las particiones de 6 es 9.

Definir la función

   maximoProductoParticiones :: Int -> Int

1	maximoProductoParticiones :: Int -> Int

tal que (maximoProductoParticiones n) es el máximo de los productos de las particiones de n. Por ejemplo,

   maximoProductoParticiones 4     ==  4
   maximoProductoParticiones 5     ==  6
   maximoProductoParticiones 6     ==  9
   maximoProductoParticiones 7     ==  12
   maximoProductoParticiones 8     ==  18
   maximoProductoParticiones 9     ==  27
   maximoProductoParticiones 50    ==  86093442
   maximoProductoParticiones 100   ==  7412080755407364
   maximoProductoParticiones 200   ==  61806308765265224723841283607058
   length (show (maximoProductoParticiones (10^7)))  ==  1590405

maximoProductoParticiones 4 == 4

maximoProductoParticiones 5 == 6

maximoProductoParticiones 6 == 9

maximoProductoParticiones 7 == 12

maximoProductoParticiones 8 == 18

maximoProductoParticiones 9 == 27

maximoProductoParticiones 50 == 86093442

maximoProductoParticiones 100 == 7412080755407364

maximoProductoParticiones 200 == 61806308765265224723841283607058

length (show (maximoProductoParticiones (10^7))) == 1590405

Comprobar con QuickChek que los únicos posibles factores de (maximoProductoParticiones n) son 2 y 3.

Soluciones

import Data.List (genericIndex, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck

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

maximoProductoParticiones1 :: Integer -> Integer
maximoProductoParticiones1 n =
  maximum [product xs | xs <- particiones1 n]

-- (particiones1 n) es la lista de las particiones de n. Por ejemplo,  
--    λ> particiones1 4
--    [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]
--    λ> particiones1 5
--    [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]
particiones1 :: Integer -> [[Integer]]
particiones1 0 = [[]]
particiones1 n = [x:y | x <- [n,n-1..1]
                      , y <- particiones1 (n-x) 
                      , [x] >= take 1 y]
 
-- 2ª definición
-- =============

maximoProductoParticiones2 :: Integer -> Integer
maximoProductoParticiones2 n =
  maximum [product xs | xs <- particiones2 n]

-- (particiones2 n) es la lista de las particiones de n. Por ejemplo,  
--    λ> particiones2 4
--    [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]]
--    λ> particiones2 5
--    [[5],[4,1],[3,2],[3,1,1],[2,2,1],[2,1,1,1],[1,1,1,1,1]]
particiones2 :: Integer -> [[Integer]]
particiones2 n = aux `genericIndex` n
  where aux = [] : map particiones [1..]
          where particiones n = [n] : [x:p | x <- [n,n-1..1]
                                           , p <- aux `genericIndex` (n-x) 
                                           , x >= head p]

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

maximoProductoParticiones3 :: Integer -> Integer
maximoProductoParticiones3 0 = 1
maximoProductoParticiones3 n =
  maximum [(n-i) * maximoProductoParticiones3 i | i <- [0..n-1]]

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

maximoProductoParticiones4 :: Integer -> Integer
maximoProductoParticiones4 n =
  maximosProductosParticiones `genericIndex` n

maximosProductosParticiones :: [Integer]
maximosProductosParticiones = 1 : f [1]
  where f xs = y : f (y:xs)
          where y = maximum (zipWith (*) [1..] xs)

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

maximoProductoParticiones5 :: Integer -> Integer
maximoProductoParticiones5 1 = 1
maximoProductoParticiones5 n
  | r == 0 = 3^q
  | r == 1 = 4 * 3^(q-1)
  | r == 2 = 2 * 3 ^q
  where (q,r) = quotRem n 3
        
-- Comparación de eficiencia                                        
-- =========================

-- La comparación es
--    λ> maximoProductoParticiones1 20
--    1458
--    (5.42 secs, 832,283,184 bytes)
--    λ> maximoProductoParticiones2 20
--    1458
--    (0.02 secs, 0 bytes)
--    λ> maximoProductoParticiones3 20
--    1458
--    (3.18 secs, 524,500,000 bytes)
--    λ> maximoProductoParticiones4 20
--    1458
--    (0.00 secs, 0 bytes)
--    
--    λ> maximoProductoParticiones2 50
--    86093442
--    (9.18 secs, 980,524,320 bytes)
--    λ> maximoProductoParticiones4 50
--    86093442
--    (0.01 secs, 1,381,192 bytes)
--    λ> maximoProductoParticiones5 50
--    86093442
--    (0.00 secs, 0 bytes)
--    
--    λ> length (show (maximoProductoParticiones4 2000))
--    319
--    (2.93 secs, 638,270,872 bytes)
--    λ> length (show (maximoProductoParticiones5 2000))
--    319
--    (0.01 secs, 0 bytes)

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

-- La propiedad es
prop_factores :: Integer -> Property
prop_factores n =
  n > 0 ==> primeFactors (maximoProductoParticiones5 n) `contenido` [2,3]

contenido :: Eq a => [a] -> [a] -> Bool
contenido xs ys = all (`elem` ys) xs

-- La comprobación es
--    λ> quickCheck prop_factores
--    +++ 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

import Data.List (genericIndex, sort)

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª definición

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

maximoProductoParticiones1 :: Integer -> Integer

maximoProductoParticiones1 n =

maximum [product xs | xs <- particiones1 n]

-- (particiones1 n) es la lista de las particiones de n. Por ejemplo,

-- λ> particiones1 4

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

-- λ> particiones1 5

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

particiones1 :: Integer -> [[Integer]]

particiones1 0 = [[]]

particiones1 n = [x:y | x <- [n,n-1..1]

, y <- particiones1 (n-x)

, [x] >= take 1 y]

-- 2ª definición

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

maximoProductoParticiones2 :: Integer -> Integer

maximoProductoParticiones2 n =

maximum [product xs | xs <- particiones2 n]

-- (particiones2 n) es la lista de las particiones de n. Por ejemplo,

-- λ> particiones2 4

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

-- λ> particiones2 5

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

particiones2 :: Integer -> [[Integer]]

particiones2 n = aux `genericIndex` n

where aux = [] : map particiones [1..]

where particiones n = [n] : [x:p | x <- [n,n-1..1]

, p <- aux `genericIndex` (n-x)

, x >= head p]

-- 3ª definición

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

maximoProductoParticiones3 :: Integer -> Integer

maximoProductoParticiones3 0 = 1

maximoProductoParticiones3 n =

maximum [(n-i) * maximoProductoParticiones3 i | i <- [0..n-1]]

-- 4ª definición

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

maximoProductoParticiones4 :: Integer -> Integer

maximoProductoParticiones4 n =

maximosProductosParticiones `genericIndex` n

maximosProductosParticiones :: [Integer]

maximosProductosParticiones = 1 : f [1]

where f xs = y : f (y:xs)

where y = maximum (zipWith (*) [1..] xs)

-- 5ª definición

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

maximoProductoParticiones5 :: Integer -> Integer

maximoProductoParticiones5 1 = 1

maximoProductoParticiones5 n

| r == 0 = 3^q

| r == 1 = 4 * 3^(q-1)

| r == 2 = 2 * 3 ^q

where (q,r) = quotRem n 3

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoProductoParticiones1 20

-- 1458

-- (5.42 secs, 832,283,184 bytes)

-- λ> maximoProductoParticiones2 20

-- 1458

-- (0.02 secs, 0 bytes)

-- λ> maximoProductoParticiones3 20

-- 1458

-- (3.18 secs, 524,500,000 bytes)

-- λ> maximoProductoParticiones4 20

-- 1458

-- (0.00 secs, 0 bytes)

-- λ> maximoProductoParticiones2 50

-- 86093442

-- (9.18 secs, 980,524,320 bytes)

-- λ> maximoProductoParticiones4 50

-- 86093442

-- (0.01 secs, 1,381,192 bytes)

-- λ> maximoProductoParticiones5 50

-- 86093442

-- (0.00 secs, 0 bytes)

-- λ> length (show (maximoProductoParticiones4 2000))

-- 319

-- (2.93 secs, 638,270,872 bytes)

-- λ> length (show (maximoProductoParticiones5 2000))

-- 319

-- (0.01 secs, 0 bytes)

-- Comprobación

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

-- La propiedad es

prop_factores :: Integer -> Property

prop_factores n =

n > 0 ==> primeFactors (maximoProductoParticiones5 n) `contenido` [2,3]

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

contenido xs ys = all (`elem` ys) xs

-- La comprobación es

-- λ> quickCheck prop_factores

-- +++ OK, passed 100 tests.

Referencia

Máximo producto en la partición de un número (1) de Antonio Roldán en el blog Números y hoja de cálculo.
Sucesión A000792 de la OEIS.

Sucesiones de listas de números

PorJosé A. Alonso 20-mayo-201626-marzo-2022

En la Olimpiada Internacional de Matemáticas del 2012 se propuso el siguiente problema:

Varios enteros positivos se escriben en una lista. Iterativamente, Alicia elige dos números adyacentes x e y tales que x > y y x está a la izquierda de y y reemplaza el par (x,y) por (y+1,x) o (x-1,x). Demostrar que sólo puede aplicar un número finito de dichas iteraciones.

Por ejemplo, las transformadas de la lista [1,3,2] son [1,2,3] y [1,3,3] y las dos obtenidas son finales (es decir, no se les puede aplicar ninguna transformación).

Definir las funciones

   soluciones       :: [Int] -> [Estado]
   finales          :: [Int] -> [[Int]]
   finalesMaximales :: [Int] -> (Int,[[Int]])

soluciones :: [Int] -> [Estado]

finales :: [Int] -> [[Int]]

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

tales que

(soluciones xs) es la lista de pares (n,ys) tales que ys es una lista obtenida aplicándole n transformaciones a xs. Por ejemplo,

     λ> soluciones [1,3,2]
     [(1,[1,3,3]),(1,[1,2,3])]
     λ> sort (nub (soluciones [3,3,2]))
     [(1,[3,3,3]),(2,[2,3,3]),(2,[3,3,3])]
     λ> sort (nub (soluciones [3,2,1]))
     [(2,[2,2,3]),(3,[2,2,3]),(3,[2,3,3]),(3,[3,3,3]),(4,[2,3,3]),(4,[3,3,3])]

λ> soluciones [1,3,2]

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

λ> sort (nub (soluciones [3,3,2]))

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

λ> sort (nub (soluciones [3,2,1]))

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

(finales xs) son las listas obtenidas transformando xs y a las que no se les puede aplicar más transformaciones. Por ejemplo,

     finales [1,2,3]               ==  [[1,2,3]]
     finales [1,3,2]               ==  [[1,2,3],[1,3,3]]
     finales [3,2,1]               ==  [[2,2,3],[2,3,3],[3,3,3]]
     finales [1,3,2,4]             ==  [[1,2,3,4],[1,3,3,4]]
     finales [1,3,2,3]             ==  [[1,2,3,3],[1,3,3,3]]
     length (finales [9,6,0,7,2])  ==  19
     length (finales [80,60..0])   ==  420

finales [1,2,3] == [[1,2,3]]

finales [1,3,2] == [[1,2,3],[1,3,3]]

finales [3,2,1] == [[2,2,3],[2,3,3],[3,3,3]]

finales [1,3,2,4] == [[1,2,3,4],[1,3,3,4]]

finales [1,3,2,3] == [[1,2,3,3],[1,3,3,3]]

length (finales [9,6,0,7,2]) == 19

length (finales [80,60..0]) == 420

(finalesMaximales xs) es el par (n,yss) tal que la longitud de las cadenas más largas de transformaciones a partir de xs e yss es la lista de los estados finales a partir de xs con n transformaciones. Por ejemplo,

     finalesMaximales [9,5,7]   ==  (2,[[6,8,9],[8,8,9]])
     finalesMaximales [3,2,1]   ==  (4,[[2,3,3],[3,3,3]])
     finalesMaximales [3,2..0]  ==  (10,[[2,3,3,3],[3,3,3,3]])
     finalesMaximales [4,3..0]  ==  (20,[[3,4,4,4,4],[4,4,4,4,4]])

finalesMaximales [9,5,7] == (2,[[6,8,9],[8,8,9]])

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

finalesMaximales [3,2..0] == (10,[[2,3,3,3],[3,3,3,3]])

finalesMaximales [4,3..0] == (20,[[3,4,4,4,4],[4,4,4,4,4]])

Soluciones

import Data.List (nub, sort)
import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado
inicial xs = (0,xs)

esFinal :: Estado -> Bool
esFinal e = null (sucesores e)

--    λ> sucesores [9,6,0,7,2]
--    [[7,9,0,7,2],[8,9,0,7,2],[9,1,6,7,2],[9,5,6,7,2],[9,6,0,3,7],[9,6,0,6,7]]
sucesores :: Estado -> [Estado]
sucesores (_,[])  = []
sucesores (_,[_]) = []
sucesores (n,x:y:xs) | x > y     = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss
                     | otherwise = yss
    where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]
                       

soluciones :: [Int] -> [Estado]
soluciones xs =
    buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]
finales xs =
    sort (nub (map snd (soluciones xs)))
            
finalesMaximales :: [Int] -> (Int,[[Int]])
finalesMaximales xs =
    (m, [xs | (n,xs) <- es, n == m])
    where es    = sort (nub (soluciones xs))
          (m,_) = maximum es

import Data.List (nub, sort)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

type Estado = (Int,[Int])

inicial :: [Int] -> Estado

inicial xs = (0,xs)

esFinal :: Estado -> Bool

esFinal e = null (sucesores e)

-- λ> sucesores [9,6,0,7,2]

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

sucesores :: Estado -> [Estado]

sucesores (_,[]) = []

sucesores (_,[_]) = []

sucesores (n,x:y:xs) | x > y = [(n+1,y+1:x:xs), (n+1,x-1:x:xs)] ++ yss

| otherwise = yss

where yss = [(m,x:ys) | (m,ys) <- sucesores (n,y:xs)]

soluciones :: [Int] -> [Estado]

soluciones xs =

buscaEE sucesores esFinal (inicial xs)

finales :: [Int] -> [[Int]]

finales xs =

sort (nub (map snd (soluciones xs)))

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

finalesMaximales xs =

(m, [xs | (n,xs) <- es, n == m])

where es = sort (nub (soluciones xs))

(m,_) = maximum es

Regresión lineal

Soluciones

Suma de los máximos de los subconjuntos

Soluciones

Máxima ramificación

Soluciones

Máximo producto en la partición de un número

Soluciones

Referencia

Sucesiones de listas de números

Soluciones

Entradas recientes

Buscar

Correo electrónico