maximum – Página 2

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

Mínimo número de cambios para igualar una lista

PorJosé A. Alonso 27-abril-20164-mayo-2016

Definir la función

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

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

tal que (nMinimoCambios xs) es el menor número de elementos de xs que hay que cambiar para que todos sean iguales. Por ejemplo,

   nMinimoCambios [3,5,3,7,9,6]      ==  4
   nMinimoCambios [3,5,3,7,3,3]      ==  2
   nMinimoCambios "Salamanca"        ==  5
   nMinimoCambios (4 : [1..500000])  ==  499999

nMinimoCambios [3,5,3,7,9,6] == 4

nMinimoCambios [3,5,3,7,3,3] == 2

nMinimoCambios "Salamanca" == 5

nMinimoCambios (4 : [1..500000]) == 499999

En el primer ejemplo, los elementos que hay que cambiar son 5, 7, 9 y 6.

Soluciones

import Data.List (group, nub, sort)

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

nMinimoCambios1 :: Ord a => [a] -> Int
nMinimoCambios1 xs = 
    length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias :: Ord a => [a] -> [(Int,a)]
frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,
--    cuenta 3 [3,5,3,7,9,6]  ==  2
cuenta :: Ord a => a -> [a] -> Int
cuenta x ys = length [y | y <- ys, y == x]

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

nMinimoCambios2 :: Ord a => [a] -> Int
nMinimoCambios2 xs = 
    length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias2 [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias2 [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias2 :: Ord a  => [a] -> [(Int,a)]
frecuencias2 xs = 
    [(1 + length ys, y) | (y:ys) <- group (sort xs)] 

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

nMinimoCambios3 :: Ord a => [a] -> Int
nMinimoCambios3 xs = sum ys - maximum ys
    where ys = [length ys | ys <- group (sort xs)]

import Data.List (group, nub, sort)

-- 1ª definición

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

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

nMinimoCambios1 xs =

length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

-- frecuencias [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

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

frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,

-- cuenta 3 [3,5,3,7,9,6] == 2

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

cuenta x ys = length [y | y <- ys, y == x]

-- 2ª definición

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

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

nMinimoCambios2 xs =

length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias2 [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

-- frecuencias2 [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

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

frecuencias2 xs =

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

-- 3ª definición

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

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

nMinimoCambios3 xs = sum ys - maximum ys

where ys = [length ys | ys <- group (sort xs)]

Máxima suma de elementos consecutivos

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

Definir la función

   sumaMaxima :: [Integer] -> Integer

1	sumaMaxima :: [Integer] -> Integer

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

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

sumaMaxima [] == 0

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

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

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

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

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

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

Comprobar con QuickCheck que

   sumaMaxima xs == sumaMaxima (reverse xs)

1	sumaMaxima xs == sumaMaxima (reverse xs)

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List (inits, tails)

import Test.QuickCheck

-- 1ª definición

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

sumaMaxima1 :: [Integer] -> Integer

sumaMaxima1 [] = 0

sumaMaxima1 xs =

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

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

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

sublista xs i j =

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

-- 2ª definición

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

sumaMaxima2 :: [Integer] -> Integer

sumaMaxima2 [] = 0

sumaMaxima2 xs = sumaMaximaAux 0 0 xs

where m = maximum xs

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

sumaMaximaAux m v [] = max m v

sumaMaximaAux m v (x:xs)

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

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

| otherwise = sumaMaximaAux (max m v) 0 xs

-- 3ª definición

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

sumaMaxima3 :: [Integer] -> Integer

sumaMaxima3 [] = 0

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

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

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

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

segmentos xs =

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

-- 4ª definición

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

sumaMaxima4 :: [Integer] -> Integer

sumaMaxima4 [] = 0

sumaMaxima4 xs =

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

-- Comprobación

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

-- La propiedad es

prop_sumaMaxima :: [Integer] -> Bool

prop_sumaMaxima xs =

sumaMaxima2 xs == n &&

sumaMaxima3 xs == n &&

sumaMaxima4 xs == n

where n = sumaMaxima1 xs

-- La comprobación es

-- λ> quickCheck prop_sumaMaxima

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

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

-- 5050

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

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

-- 5050

-- (0.02 secs, 0 bytes)

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

-- 5050

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

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

-- 5050

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

prop_inversa :: [Integer] -> Bool

prop_inversa xs =

sumaMaxima2 xs == sumaMaxima2 (reverse xs)

Máxima suma en una matriz

PorJosé A. Alonso 11-marzo-201628-marzo-2016

Las matrices puede representarse mediante tablas cuyos índices son pares de números naturales:

   type Matriz = Array (Int,Int) Int

1	type Matriz = Array (Int,Int) Int

Definir la función

   maximaSuma :: Matriz -> Int

1	maximaSuma :: Matriz -> Int

tal que (maximaSuma p) es el máximo de las sumas de las listas de elementos de la matriz p tales que cada elemento pertenece sólo a una fila y a una columna. Por ejemplo,

   ghci> maximaSuma (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])
   17

1 2	ghci> maximaSuma (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7]) 17

ya que las selecciones, y sus sumas, de la matriz

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

|1 2 3|

|8 4 9|

|5 6 7|

son

   [1,4,7] --> 12
   [1,9,6] --> 16
   [2,8,7] --> 17
   [2,9,5] --> 16
   [3,8,6] --> 17
   [3,4,5] --> 12

[1,4,7] --> 12

[1,9,6] --> 16

[2,8,7] --> 17

[2,9,5] --> 16

[3,8,6] --> 17

[3,4,5] --> 12

Hay dos selecciones con máxima suma: [2,8,7] y [3,8,6].

Soluciones

import Data.Array
import Data.List (permutations)

type Matriz = Array (Int,Int) Int

maximaSuma :: Matriz -> Int
maximaSuma p = maximum [sum xs | xs <- selecciones p]

-- (selecciones p) es la lista de las selecciones en las que cada
-- elemento pertenece a un única fila y a una única columna de la matriz
-- p. Por ejemplo,
--    ghci> selecciones (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])
--    [[1,4,7],[2,8,7],[3,4,5],[2,9,5],[3,8,6],[1,9,6]]
selecciones :: Matriz -> [[Int]]
selecciones p = 
    [[p!(i,j) | (i,j) <- ijs] | 
     ijs <- [zip [1..n] xs | xs <- permutations [1..n]]] 
    where (_,(m,n)) = bounds p

-- 2ª solución (mediante submatrices):
maximaSuma2 :: Matriz -> Int
maximaSuma2 p 
    | (m,n) == (1,1) = p!(1,1)
    | otherwise = maximum [p!(1,j) 
                  + maximaSuma2 (submatriz 1 j p) | j <- [1..n]]
    where (_,(m,n)) = bounds p

-- (submatriz i j p) es la matriz obtenida a partir de la p eliminando
-- la fila i y la columna j. Por ejemplo, 
--    ghci> submatriz 2 3 (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])
--    array ((1,1),(2,2)) [((1,1),1),((1,2),2),((2,1),5),((2,2),6)]
submatriz :: Int -> Int -> Matriz -> Matriz
submatriz i j p = 
    array ((1,1), (m-1,n -1))
          [((k,l), p ! f k l) | k <- [1..m-1], l <- [1.. n-1]]
    where (_,(m,n)) = bounds p
          f k l | k < i  && l < j  = (k,l)
                | k >= i && l < j  = (k+1,l)
                | k < i  && l >= j = (k,l+1)
                | otherwise        = (k+1,l+1)

import Data.Array

import Data.List (permutations)

type Matriz = Array (Int,Int) Int

maximaSuma :: Matriz -> Int

maximaSuma p = maximum [sum xs | xs <- selecciones p]

-- (selecciones p) es la lista de las selecciones en las que cada

-- elemento pertenece a un única fila y a una única columna de la matriz

-- p. Por ejemplo,

-- ghci> selecciones (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])

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

selecciones :: Matriz -> [[Int]]

selecciones p =

[[p!(i,j) | (i,j) <- ijs] |

ijs <- [zip [1..n] xs | xs <- permutations [1..n]]]

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

-- 2ª solución (mediante submatrices):

maximaSuma2 :: Matriz -> Int

maximaSuma2 p

| (m,n) == (1,1) = p!(1,1)

| otherwise = maximum [p!(1,j)

+ maximaSuma2 (submatriz 1 j p) | j <- [1..n]]

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

-- (submatriz i j p) es la matriz obtenida a partir de la p eliminando

-- la fila i y la columna j. Por ejemplo,

-- ghci> submatriz 2 3 (listArray ((1,1),(3,3)) [1,2,3,8,4,9,5,6,7])

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

submatriz :: Int -> Int -> Matriz -> Matriz

submatriz i j p =

array ((1,1), (m-1,n -1))

[((k,l), p ! f k l) | k <- [1..m-1], l <- [1.. n-1]]

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

f k l | k < i && l < j = (k,l)

| k >= i && l < j = (k+1,l)

| k < i && l >= j = (k,l+1)

| otherwise = (k+1,l+1)

Máxima longitud de las sublistas comunes

PorJosé A. Alonso 9-marzo-201616-marzo-2016

Las sublistas comunes de «1325» y «36572» son «», «3»,»32″, «35», «2» y «5». El máximo de sus longitudes es 2.

Definir la función

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

1	maximo :: Eq a => [a] -> [a] -> Int

tal que (maximo xs ys) es el máximo de las longitudes de las sublistas comunes de xs e ys. Por ejemplo,

   maximo "1325" "36572"       == 2
   maximo [1,4..33] [2,4..33]  == 5
   maximo [1..10^6] [1..10^6]  == 100000

maximo "1325" "36572" == 2

maximo [1,4..33] [2,4..33] == 5

maximo [1..10^6] [1..10^6] == 100000

Soluciones

import Data.List (subsequences, intersect)

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

maximo1 :: Eq a => [a] -> [a] -> Int
maximo1 xs ys = 
    maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e
-- ys. Por ejemplo,
sublistasComunes :: Eq a => [a] -> [a] -> [[a]]
sublistasComunes xs ys =
    subsequences xs `intersect` subsequences ys

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

maximo2 :: Eq a => [a] -> [a] -> Int
maximo2 l1@(x:xs) l2@(y:ys) 
    | x == y    = 1 + maximo2 xs ys
    | otherwise = max (maximo2 xs l2) (maximo2 l1 ys)  
maximo2 _ _ = 0

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

--    λ> maximo1 [1,4..30] [2,4..30]
--    5
--    (3.60 secs, 0 bytes)
--    λ> maximo2 [1,4..30] [2,4..30]
--    5
--    (1.58 secs, 216,347,472 bytes)
--    
--    λ> maximo2 [1..10^6] [1..10^6]
--    1000000
--    (2.44 secs, 407,051,096 bytes)

import Data.List (subsequences, intersect)

-- 1ª definición

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

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

maximo1 xs ys =

maximum (map length (sublistasComunes xs ys))

-- (sublistasComunes xs ys) es la lista de las sublistas comunes de xs e

-- ys. Por ejemplo,

sublistasComunes :: Eq a => [a] -> [a] -> [[a]]

sublistasComunes xs ys =

subsequences xs `intersect` subsequences ys

-- 2ª definición

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

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

maximo2 l1@(x:xs) l2@(y:ys)

| x == y = 1 + maximo2 xs ys

| otherwise = max (maximo2 xs l2) (maximo2 l1 ys)

maximo2 _ _ = 0

-- Comparación de eficiencia

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

-- λ> maximo1 [1,4..30] [2,4..30]

-- 5

-- (3.60 secs, 0 bytes)

-- λ> maximo2 [1,4..30] [2,4..30]

-- 5

-- (1.58 secs, 216,347,472 bytes)

-- λ> maximo2 [1..10^6] [1..10^6]

-- 1000000

-- (2.44 secs, 407,051,096 bytes)

Regresión lineal

PorJosé A. Alonso 22-febrero-201626-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)

Definir el procedimiento

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

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

tal que (grafica xs ys) pinte 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 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     = fromIntegral (length 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 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 = fromIntegral (length 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

Ganadores de las elecciones

PorJosé A. Alonso 24-noviembre-20151-diciembre-2015

Los resultados de las votaciones a delegado en un grupo de clase se recogen mediante listas de asociación. Por ejemplo,

   votos :: [(String,Int)]
   votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),
            ("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

votos :: [(String,Int)]

votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),

("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

Definir la función

   ganadores :: [(String,Int)] -> [String]

1	ganadores :: [(String,Int)] -> [String]

tal que (ganadores xs) es la lista de los estudiantes con mayor número de votos en xs. Por ejemplo,

    ganadores votos == ["Julia Rus","Pedro Ruiz"]

1	ganadores votos == ["Julia Rus","Pedro Ruiz"]

Soluciones

votos :: [(String,Int)]
votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),
         ("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

ganadores :: [(String,Int)] -> [String]
ganadores xs = [c | (c,x) <- xs, x == maxVotos]
    where maxVotos = maximum [j | (i,j) <- xs]

votos :: [(String,Int)]

votos = [("Ana Perez",10),("Juan Lopez",7), ("Julia Rus", 27),

("Pedro Val",1), ("Pedro Ruiz",27),("Berta Gomez",11)]

ganadores :: [(String,Int)] -> [String]

ganadores xs = [c | (c,x) <- xs, x == maxVotos]

where maxVotos = maximum [j | (i,j) <- xs]

Mayor resto

PorJosé A. Alonso 26-octubre-20152-noviembre-2015

El resultado de dividir un número n por un divisor d es un cociente q y un resto r.

Definir la función

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

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

tal que (mayorResto n d) es el par (m,xs) tal que m es el mayor resto de dividir n entre x (con 1 ≤ x < d) y xs es la lista de números x menores que d tales que el resto de n entre x es m. Por ejemplo,

   mayorResto 20 10  ==  (6,[7])
   mayorResto 50 8   ==  (2,[3,4,6])

1 2	mayorResto 20 10 == (6,[7]) mayorResto 50 8 == (2,[3,4,6])

Nota: Se supone que d es mayor que 1.

Soluciones

mayorResto :: Int -> Int -> (Int,[Int])
mayorResto n d = (m, [x | x <- [1..d-1], n `rem` x == m])
    where m = maximum [n `rem` x | x <- [1..d-1]]

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

mayorResto n d = (m, [x | x <- [1..d-1], n `rem` x == m])

where m = maximum [n `rem` x | x <- [1..d-1]]

Referencia

El ejercio está basado en el problema Largest possible remainder publicado el 16 de octubre de 2015 en «Programming paraxis».

Perímetro más frecuente de triángulos rectángulos

PorJosé A. Alonso 7-abril-20151-mayo-2015

El grado perimetral de un número p es la cantidad de tres triángulos rectángulos de lados enteros cuyo perímetro es p. Por ejemplo, el grado perimetral de 120 es 3 ya que sólo hay 3 triángulos rectángulos de lados enteros cuyo perímetro es 120: {20,48,52}, {24,45,51} y {30,40,50}.

Definir la función

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

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

tal que (maxGradoPerimetral n) es el par (m,ps) tal que m es el máximo grado perimetral de los números menores o iguales que n y ps son los perímetros, menores o iguales que n, cuyo grado perimetral es m. Por ejemplo,

   maxGradoPerimetral   50  ==  (1,[12,24,30,36,40,48])
   maxGradoPerimetral  100  ==  (2,[60,84,90])
   maxGradoPerimetral  200  ==  (3,[120,168,180])
   maxGradoPerimetral  400  ==  (4,[240,360])
   maxGradoPerimetral  500  ==  (5,[420])
   maxGradoPerimetral  750  ==  (6,[720])
   maxGradoPerimetral  839  ==  (6,[720])
   maxGradoPerimetral  840  ==  (8,[840])
   maxGradoPerimetral 1500  ==  (8,[840,1260])
   maxGradoPerimetral 2000  ==  (10,[1680])
   maxGradoPerimetral 3000  ==  (12,[2520])

maxGradoPerimetral 50 == (1,[12,24,30,36,40,48])

maxGradoPerimetral 100 == (2,[60,84,90])

maxGradoPerimetral 200 == (3,[120,168,180])

maxGradoPerimetral 400 == (4,[240,360])

maxGradoPerimetral 500 == (5,[420])

maxGradoPerimetral 750 == (6,[720])

maxGradoPerimetral 839 == (6,[720])

maxGradoPerimetral 840 == (8,[840])

maxGradoPerimetral 1500 == (8,[840,1260])

maxGradoPerimetral 2000 == (10,[1680])

maxGradoPerimetral 3000 == (12,[2520])

Soluciones

import Data.List
import Data.Array (accumArray, assocs)

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

maxGradoPerimetral1 :: Int -> (Int,[Int])
maxGradoPerimetral1 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(length (triangulos x),x) | x <- [1..p]] 
          (m,_) = maximum ts 

-- (triangulos p) es el conjunto de triángulos rectángulos de perímetro
-- p. Por ejemplo,
--    triangulos 120  ==  [(20,48,52),(24,45,51),(30,40,50)]
triangulos :: Int -> [(Int,Int,Int)]
triangulos p = 
    [(a,b,c) | a <- [1..q],
               b <- [a..q],
               let c = p-a-b,
               a*a+b*b == c*c]
    where q = p `div` 2

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

maxGradoPerimetral2 :: Int -> (Int,[Int])
maxGradoPerimetral2 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(n,x) | (x,n) <- numeroPerimetrosTriangulos p, n > 0]
          (m,_) = maximum ts 

-- (numeroPerimetrosTriangulos p) es la lista formado por los números de
-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro
-- es dicho número. Por ejemplo,
--    ghci>  [(p,n) | (p,n) <- numeroPerimetrosTriangulos 70, n > 0]
--    [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]
numeroPerimetrosTriangulos :: Int -> [(Int,Int)] 
numeroPerimetrosTriangulos p = 
    assocs (accumArray (\x _ -> 1+x) 0 (1,p) (perimetrosTriangulos p))

-- (perimetrosTriangulos p) es la lista formada por los perímetros y los
-- lados de los triángulos rectángulos enteros cuyo perímetro es menor o
-- igual que p. Por ejemplo,
--    ghci> perimetrosTriangulos 70
--    [(12,(3,4,5)),   (30,(5,12,13)),(24,(6,8,10)),  (56,(7,24,25)),
--     (40,(8,15,17)), (36,(9,12,15)),(60,(10,24,26)),(48,(12,16,20)),
--     (60,(15,20,25)),(70,(20,21,29))]
perimetrosTriangulos :: Int -> [(Int,(Int,Int,Int))]
perimetrosTriangulos p =
    [(q,(a,b,c)) | a <- [1..p1],
                   b <- [a..p1],
                   esCuadrado (a*a+b*b), 
                   let c = raizCuadradaE (a*a+b*b), 
                   let q = a+b+c,
                   q <= p]
    where p1 = p `div` 2

-- (esCuadrado n) se verifica si n es un cuadrado. Por ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Int -> Bool
esCuadrado n = a*a == n
    where a = raizCuadradaE n

-- (raizCuadradaE n) es la raíz cuadrada entera de n. Por ejemplo,
--    raizCuadradaE 25  ==  5
--    raizCuadradaE 27  ==  5
--    raizCuadradaE 35  ==  5
--    raizCuadradaE 36  ==  6
raizCuadradaE :: Int -> Int
raizCuadradaE = floor . sqrt . fromIntegral

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

maxGradoPerimetral3 :: Int -> (Int,[Int])
maxGradoPerimetral3 p = (m,[x | (n,x) <- ts, n == m])
    where ts    = [(n,x) | (x,n) <- numeroPerimetrosTriangulos2 p, n > 0]
          (m,_) = maximum ts 

-- (numeroPerimetrosTriangulos2 p) es la lista formado por los números de
-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro
-- es dicho número. Por ejemplo,
--    ghci>  [(p,n) | (p,n) <- numeroPerimetrosTriangulos2 70, n > 0]
--    [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]
numeroPerimetrosTriangulos2 :: Int -> [(Int,Int)] 
numeroPerimetrosTriangulos2 p = 
    [(head xs, length xs) | xs <- group (sort (perimetrosTriangulos2 p))]

-- (perimetrosTriangulos2 p) es la lista formada por los perímetros de
-- los triángulos rectángulos enteros cuyo perímetro es menor o igual
-- que p. Por ejemplo, 
--    perimetrosTriangulos2 70  ==  [12,30,24,56,40,36,60,48,60,70]
perimetrosTriangulos2 :: Int -> [Int]
perimetrosTriangulos2 p =
    [q | a <- [1..p1],
         b <- [a..p1],
         esCuadrado (a*a+b*b), 
         let c = raizCuadradaE (a*a+b*b), 
         let q = a+b+c,
         q <= p]
    where p1 = p `div` 2

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

-- La comparación es
--    ghci> maxGradoPerimetral1 1000
--    (8,[840])
--    (120.08 secs, 21116625136 bytes)
--    ghci> maxGradoPerimetral2 1000
--    (8,[840])
--    (0.66 secs, 132959056 bytes)
--    ghci> maxGradoPerimetral3 1000
--    (1000,[1])
--    (0.66 secs, 133443816 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List

import Data.Array (accumArray, assocs)

-- 1ª solución --

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

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

maxGradoPerimetral1 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(length (triangulos x),x) | x <- [1..p]]

(m,_) = maximum ts

-- (triangulos p) es el conjunto de triángulos rectángulos de perímetro

-- p. Por ejemplo,

-- triangulos 120 == [(20,48,52),(24,45,51),(30,40,50)]

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

triangulos p =

[(a,b,c) | a <- [1..q],

b <- [a..q],

let c = p-a-b,

a*a+b*b == c*c]

where q = p `div` 2

-- 2ª solución --

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

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

maxGradoPerimetral2 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos p, n > 0]

(m,_) = maximum ts

-- (numeroPerimetrosTriangulos p) es la lista formado por los números de

-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro

-- es dicho número. Por ejemplo,

-- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos 70, n > 0]

-- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]

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

numeroPerimetrosTriangulos p =

assocs (accumArray (\x _ -> 1+x) 0 (1,p) (perimetrosTriangulos p))

-- (perimetrosTriangulos p) es la lista formada por los perímetros y los

-- lados de los triángulos rectángulos enteros cuyo perímetro es menor o

-- igual que p. Por ejemplo,

-- ghci> perimetrosTriangulos 70

-- [(12,(3,4,5)), (30,(5,12,13)),(24,(6,8,10)), (56,(7,24,25)),

-- (40,(8,15,17)), (36,(9,12,15)),(60,(10,24,26)),(48,(12,16,20)),

-- (60,(15,20,25)),(70,(20,21,29))]

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

perimetrosTriangulos p =

[(q,(a,b,c)) | a <- [1..p1],

b <- [a..p1],

esCuadrado (a*a+b*b),

let c = raizCuadradaE (a*a+b*b),

let q = a+b+c,

q <= p]

where p1 = p `div` 2

-- (esCuadrado n) se verifica si n es un cuadrado. Por ejemplo,

-- esCuadrado 25 == True

-- esCuadrado 27 == False

esCuadrado :: Int -> Bool

esCuadrado n = a*a == n

where a = raizCuadradaE n

-- (raizCuadradaE n) es la raíz cuadrada entera de n. Por ejemplo,

-- raizCuadradaE 25 == 5

-- raizCuadradaE 27 == 5

-- raizCuadradaE 35 == 5

-- raizCuadradaE 36 == 6

raizCuadradaE :: Int -> Int

raizCuadradaE = floor . sqrt . fromIntegral

-- 3ª solución --

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

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

maxGradoPerimetral3 p = (m,[x | (n,x) <- ts, n == m])

where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos2 p, n > 0]

(m,_) = maximum ts

-- (numeroPerimetrosTriangulos2 p) es la lista formado por los números de

-- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro

-- es dicho número. Por ejemplo,

-- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos2 70, n > 0]

-- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)]

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

numeroPerimetrosTriangulos2 p =

[(head xs, length xs) | xs <- group (sort (perimetrosTriangulos2 p))]

-- (perimetrosTriangulos2 p) es la lista formada por los perímetros de

-- los triángulos rectángulos enteros cuyo perímetro es menor o igual

-- que p. Por ejemplo,

-- perimetrosTriangulos2 70 == [12,30,24,56,40,36,60,48,60,70]

perimetrosTriangulos2 :: Int -> [Int]

perimetrosTriangulos2 p =

[q | a <- [1..p1],

b <- [a..p1],

esCuadrado (a*a+b*b),

let c = raizCuadradaE (a*a+b*b),

let q = a+b+c,

q <= p]

where p1 = p `div` 2

-- Comparación de eficiencia

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

-- La comparación es

-- ghci> maxGradoPerimetral1 1000

-- (8,[840])

-- (120.08 secs, 21116625136 bytes)

-- ghci> maxGradoPerimetral2 1000

-- (8,[840])

-- (0.66 secs, 132959056 bytes)

-- ghci> maxGradoPerimetral3 1000

-- (1000,[1])

-- (0.66 secs, 133443816 bytes)

Caminos maximales en árboles binarios

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

Consideremos los árboles binarios con etiquetas en las hojas y en los nodos. Por ejemplo,

/ \

2 4

/ \

7 1

/ \

2 3

Un camino es una sucesión de nodos desde la raiz hasta una hoja. Por ejemplo, [5,2] y [5,4,1,2] son caminos que llevan a 2, mientras que [5,4,1] no es un camino, pues no lleva a una hoja.

Definimos el tipo de dato Arbol y el ejemplo por

   data Arbol = H Int | N Arbol Int Arbol 
                deriving Show
   
   arb1:: Arbol 
   arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

data Arbol = H Int | N Arbol Int Arbol

deriving Show

arb1:: Arbol

arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

Definir la función

   maxLong :: Int -> Arbol -> Int

1	maxLong :: Int -> Arbol -> Int

tal que (maxLong x a) es la longitud máxima de los caminos que terminan en x. Por ejemplo,

   maxLong 3 arb1 == 4
   maxLong 2 arb1 == 4
   maxLong 7 arb1 == 3

maxLong 3 arb1 == 4

maxLong 2 arb1 == 4

maxLong 7 arb1 == 3

Soluciones

data Arbol = H Int | N Arbol Int Arbol 
             deriving Show

arb1:: Arbol 
arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

-- 1ª solución (calculando los caminos)
-- ------------------------------------

-- (caminos x a) es la lista de los caminos en el árbol a desde la raíz
-- hasta las hojas x. Por ejemplo,
--    caminos 2 arb1 == [[5,2],[5,4,1,2]]
--    caminos 3 arb1 == [[5,4,1,3]]
--    caminos 1 arb1 == []
caminos :: Int -> Arbol -> [[Int]]
caminos x (H y) | x == y    = [[x]]
                | otherwise = []
caminos x (N i r d) = map (r:) (caminos x i ++ caminos x d)

maxLong1 :: Int -> Arbol -> Int
maxLong1 x a = maximum (0: map length (caminos x a))

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

maxLong2 :: Int -> Arbol -> Int
maxLong2 x a = maximum (0 : aux x a)
    where aux x (H y) | x == y    = [1]
                      | otherwise = []
          aux x (N i r d) = map (+1) (aux x i ++ aux x d)

data Arbol = H Int | N Arbol Int Arbol

deriving Show

arb1:: Arbol

arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

-- 1ª solución (calculando los caminos)

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

-- (caminos x a) es la lista de los caminos en el árbol a desde la raíz

-- hasta las hojas x. Por ejemplo,

-- caminos 2 arb1 == [[5,2],[5,4,1,2]]

-- caminos 3 arb1 == [[5,4,1,3]]

-- caminos 1 arb1 == []

caminos :: Int -> Arbol -> [[Int]]

caminos x (H y) | x == y = [[x]]

| otherwise = []

caminos x (N i r d) = map (r:) (caminos x i ++ caminos x d)

maxLong1 :: Int -> Arbol -> Int

maxLong1 x a = maximum (0: map length (caminos x a))

-- 2ª solución

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

maxLong2 :: Int -> Arbol -> Int

maxLong2 x a = maximum (0 : aux x a)

where aux x (H y) | x == y = [1]

| otherwise = []

aux x (N i r d) = map (+1) (aux x i ++ aux x d)

Mayor diferencia progresiva

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

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

Definir la función

   mayorDiferencia :: [Int] -> Int

1	mayorDiferencia :: [Int] -> Int

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

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

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

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

mayorDiferencia [7,2,6] == 4

mayorDiferencia [3,2,1] == 0

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

Soluciones

import Data.List (inits)

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

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

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

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

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

import Data.List (inits)

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

mayorDiferencia :: [Int] -> Int

mayorDiferencia ([_]) = 0

mayorDiferencia (x:xs) =

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

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

mayorDiferencia2 :: [Int] -> Int

mayorDiferencia2 xs =

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

-- 3ª definición:

mayorDiferencia3 :: [Int] -> Int

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

-- 4ª definición:

mayorDiferencia4 :: [Int] -> Int

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

-- Comparación de eficiencia

-- ghci> mayorDiferencia [1..3000]

-- 2999

-- (3.43 secs, 943439560 bytes)

-- ghci> mayorDiferencia2 [1..3000]

-- 2999

-- (3.38 secs, 978359192 bytes)

-- ghci> mayorDiferencia3 [1..3000]

-- 2999

-- (0.01 secs, 2877960 bytes)

-- ghci> mayorDiferencia4 [1..3000]

-- 2999

-- (0.01 secs, 2062616 bytes)

Mínimo número de cambios para igualar una lista

PorJosé A. Alonso 23-febrero-201525-abril-2021

Definir la función

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

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

tal que (nMinimoCambios xs) es el menor número de elementos de xs que hay que cambiar para que todos sean iguales. Por ejemplo,

   nMinimoCambios [3,5,3,7,9,6]      ==  4
   nMinimoCambios [3,5,3,7,3,3]      ==  2
   nMinimoCambios "Salamanca"        ==  5
   nMinimoCambios (4 : [1..500000])  ==  499999

nMinimoCambios [3,5,3,7,9,6] == 4

nMinimoCambios [3,5,3,7,3,3] == 2

nMinimoCambios "Salamanca" == 5

nMinimoCambios (4 : [1..500000]) == 499999

En el primer ejemplo, los elementos que hay que cambiar son 5, 7, 9 y 6.

Soluciones

import Data.List (group, nub, sort)

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

nMinimoCambios1 :: Ord a => [a] -> Int
nMinimoCambios1 xs = 
    length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias :: Ord a => [a] -> [(Int,a)]
frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,
--    cuenta 3 [3,5,3,7,9,6]  ==  2
cuenta :: Ord a => a -> [a] -> Int
cuenta x ys = length [y | y <- ys, y == x]

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

nMinimoCambios2 :: Ord a => [a] -> Int
nMinimoCambios2 xs = 
    length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el
-- número de veces que ocurren en xs. Por ejemplo,
--    frecuencias2 [3,5,3,7,9,6]  ==  [(2,3),(1,5),(1,7),(1,9),(1,6)]
--    frecuencias2 [3,5,3,7,5,5]  ==  [(2,3),(3,5),(1,7)]
frecuencias2 :: Ord a  => [a] -> [(Int,a)]
frecuencias2 xs = 
    [(1 + length ys, y) | (y:ys) <- group (sort xs)] 

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

nMinimoCambios3 :: Ord a => [a] -> Int
nMinimoCambios3 xs = sum ys - maximum ys
    where ys = [length ys | ys <- group (sort xs)]

import Data.List (group, nub, sort)

-- 1ª definición

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

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

nMinimoCambios1 xs =

length xs - fst (last (sort (frecuencias xs)))

-- (frecuencias xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

-- frecuencias [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

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

frecuencias xs = [(cuenta x xs,x) | x <- nub xs]

-- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo,

-- cuenta 3 [3,5,3,7,9,6] == 2

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

cuenta x ys = length [y | y <- ys, y == x]

-- 2ª definición

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

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

nMinimoCambios2 xs =

length xs - fst (last (sort (frecuencias2 xs)))

-- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el

-- número de veces que ocurren en xs. Por ejemplo,

-- frecuencias2 [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)]

-- frecuencias2 [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)]

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

frecuencias2 xs =

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

-- 3ª definición

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

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

nMinimoCambios3 xs = sum ys - maximum ys

where ys = [length ys | ys <- group (sort xs)]

Mayor producto de n dígitos consecutivos de un número

PorJosé A. Alonso 12-febrero-201525-abril-2021

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

mayorProducto 5 (product [1..1000]) == 41472

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)

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

mayorProducto1 :: Int -> Integer -> Integer
mayorProducto1 n x = 
    maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a
-- izquierda. Por ejemplo, 
--    cifras 325  ==  [5,2,3]
cifras :: Integer -> [Integer]
cifras x 
    | x < 10    = [x]
    | otherwise = r : cifras q
    where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

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

mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)

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

mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum . 
                   map (product . take n) .
                   filter ((>=n) . length) .
                   tails . 
                   cifras

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

mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum . 
                   map (product . map (fromIntegral . digitToInt)) . 
                   filter ((==n) . length) . 
                   concatMap inits . 
                   tails .
                   show

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))
-- 
--    | Def | 10   | 100  | 1000 | 5000  |
--    |-----+------+------+------+-------|
--    | 1   | 0.01 | 0.01 | 0.04 |  0.34 |
--    | 2   | 0.01 | 0.01 | 0.07 |  2.86 |
--    | 3   | 0.01 | 0.01 | 0.06 | 12.48 |
--    | 4   | 0.00 | 0.12 |      |       |
...

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

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

mayorProducto1 :: Int -> Integer -> Integer

mayorProducto1 n x =

maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a

-- izquierda. Por ejemplo,

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

cifras :: Integer -> [Integer]

cifras x

| x < 10 = [x]

| otherwise = r : cifras q

where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la

-- lista xs. Por ejemplo,

-- segmentos 2 [3,5,4,6] == [[3,5],[5,4],[4,6]]

segmentos :: Int -> [Integer] -> [[Integer]]

segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución

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

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

where ns = [read [d] | d <- show x]

aux xs | length xs < n = []

| otherwise = product (take n xs) : aux (tail xs)

-- 3ª solución

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

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum .

map (product . take n) .

filter ((>=n) . length) .

tails .

cifras

-- 4ª solución

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

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum .

map (product . map (fromIntegral . digitToInt)) .

filter ((==n) . length) .

concatMap inits .

tails .

show

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

-- Comparación de soluciones --

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

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))

-- | Def | 10 | 100 | 1000 | 5000 |

-- |-----+------+------+------+-------|

-- | 1 | 0.01 | 0.01 | 0.04 | 0.34 |

-- | 2 | 0.01 | 0.01 | 0.07 | 2.86 |

-- | 3 | 0.01 | 0.01 | 0.06 | 12.48 |

-- | 4 | 0.00 | 0.12 | | |

...

Mayor capicúa producto de dos números de n cifras

PorJosé A. Alonso 3-febrero-201525-abril-2021

Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.

Definir la función

   mayorCapicuaP :: Integer -> Integer

1	mayorCapicuaP :: Integer -> Integer

tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,

   mayorCapicuaP 2  ==  9009
   mayorCapicuaP 3  ==  906609
   mayorCapicuaP 4  ==  99000099
   mayorCapicuaP 5  ==  9966006699

mayorCapicuaP 2 == 9009

mayorCapicuaP 3 == 906609

mayorCapicuaP 4 == 99000099

mayorCapicuaP 5 == 9966006699

Soluciones

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

mayorCapicuaP1 :: Integer -> Integer
mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que
-- pueden escribirse como productos de dos números de n cifras. Por
-- ejemplo, Por ejemplo,
--    ghci> capicuasP 2
--    [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,
--     5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,
--     2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]
capicuasP n = [x | x <- capicuas n,
                        not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a
-- menor. Por ejemplo, 
--    capicuas 1           ==  [99,88,77,66,55,44,33,22,11]
--    take 7 (capicuas 2)  ==  [9999,9889,9779,9669,9559,9449,9339]
capicuas :: Integer -> [Integer]
capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a
-- menor. Por ejemplo,
--    numerosCifras 1           ==  [9,8,7,6,5,4,3,2,1]
--    take 7 (numerosCifras 2)  ==  [99,98,97,96,95,94,93]
--    take 7 (numerosCifras 3)  ==  [999,998,997,996,995,994,993]
numerosCifras :: Integer -> [Integer]
numerosCifras n = [a,a-1..b]
    where a = 10^n-1
          b = 10^(n-1) 

-- (capicua n) es la capicúa formada añadiendo el inverso de n a
--  continuación de n. Por ejemplo,
--    capicua 93  ==  9339
capicua :: Integer -> Integer
capicua n = read (xs ++ (reverse xs))
    where xs = show n

-- (productosDosNumerosCifras n x) es la lista de los números y de n
-- cifras tales que existe un z de n cifras y x es el producto de y por
-- z. Por ejemplo, 
--    productosDosNumerosCifras 2 9009  ==  [99,91]
productosDosNumerosCifras n x = [y | y <- numeros,
                                     mod x y == 0,
                                     div x y `elem` numeros]
    where numeros = numerosCifras n

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

mayorCapicuaP2 :: Integer -> Integer
mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],
                                  y <- [a,a-1..b],
                                  esCapicua (x*y)] 
    where a = 10^n-1
          b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,
--    esCapicua 353  ==  True
--    esCapicua 357  ==  False
esCapicua :: Integer -> Bool
esCapicua n = xs == reverse xs
    where xs = show n

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

mayorCapicuaP3 :: Integer -> Integer
mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, 
                                  esCapicua (x*y)] 
     where a = 10^n-1
           b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares a b = [(x,z-x) | z <- [a1,a1-1..b1],
                       x <- [a,a-1..b],
                       x <= z-x, z-x <= a]
            where a1 = 2*a
                  b1 = 2*b

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

mayorCapicuaP4 :: Integer -> Integer
mayorCapicuaP4 n = maximum [x | y <- [a..b],
                                z <- [y..b],
                                let x = y * z,
                                let s = show x,
                                s == reverse s]
     where a = 10^(n-1)
           b = 10^n-1
     
-- 5ª solución
-- ===========

mayorCapicuaP5 :: Integer -> Integer
mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]
     where a = 10^(n-1)
           b = 10^n-1
                       
-- (pares2 a b) es la lista de los pares de números entre a y b de forma
-- que su suma es decreciente. Por ejemplo,
--    pares2 9 7  ==  [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]
pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

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

mayorCapicuaP6 :: Integer -> Integer
mayorCapicuaP6 n = maximum [x*y | x <- [a..b], 
                                  y <- [x..b] , 
                                  esCapicua (x*y)]
     where a = 10^(n-1)
           b = 10^n-1
 
-- (cifras n) es la lista de las cifras de n en orden inverso. Por
-- ejemplo,  
--    cifras 325  == [5,2,3]
cifras :: Integer -> [Integer]
cifras n 
    | n < 10    = [n]
    | otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,
--    ultima 325  ==  5
ultima  :: Integer -> Integer
ultima n =  n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última
-- cifra. Por ejemplo,
--    quitarUltima 325  =>  32 
quitarUltima :: Integer -> Integer
quitarUltima n = (n - (ultima n)) `div` 10

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

mayorCapicuaP7 :: Integer -> Integer
mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto
-- de dos números de n dígitos. Por ejemplo,
--    esFactorizable 1219 2  ==  True
--    esFactorizable 1217 2  ==  False
esFactorizable x n = aux i x
    where b = 10^n-1
          i = floor (sqrt (fromIntegral x))
          aux i x | i > b          = False
                  | x `mod` i == 0 = x `div` i < b 
                  | otherwise      = aux (i+1) x

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) de cálculo de (mayorCapicuaP n) con las 7
-- definiciones
--    +------+------+------+------+
--    | Def. | 2    | 3    | 4    |
--    |------+------+------+------|
--    |    1 | 0.01 | 0.13 | 1.39 |
--    |    2 | 0.03 | 2.07 |      |
--    |    3 | 0.05 | 3.86 |      |
--    |    4 | 0.01 | 0.89 |      |
--    |    5 | 0.03 | 1.23 |      |
--    |    6 | 0.02 | 1.03 |      |
--    |    7 | 0.01 | 0.02 | 0.02 |
--    +------+------+------+------+

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

-- 1ª solución

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

mayorCapicuaP1 :: Integer -> Integer

mayorCapicuaP1 n = head (capicuasP n)

-- (capicuasP n) es la lista de las capicúas de 2*n cifras que

-- pueden escribirse como productos de dos números de n cifras. Por

-- ejemplo, Por ejemplo,

-- ghci> capicuasP 2

-- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335,

-- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003,

-- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001]

capicuasP n = [x | x <- capicuas n,

not (null (productosDosNumerosCifras n x))]

-- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a

-- menor. Por ejemplo,

-- capicuas 1 == [99,88,77,66,55,44,33,22,11]

-- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339]

capicuas :: Integer -> [Integer]

capicuas n = [capicua x | x <- numerosCifras n]

-- (numerosCifras n) es la lista de los números de n cifras de mayor a

-- menor. Por ejemplo,

-- numerosCifras 1 == [9,8,7,6,5,4,3,2,1]

-- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93]

-- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993]

numerosCifras :: Integer -> [Integer]

numerosCifras n = [a,a-1..b]

where a = 10^n-1

b = 10^(n-1)

-- (capicua n) es la capicúa formada añadiendo el inverso de n a

-- continuación de n. Por ejemplo,

-- capicua 93 == 9339

capicua :: Integer -> Integer

capicua n = read (xs ++ (reverse xs))

where xs = show n

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

-- cifras tales que existe un z de n cifras y x es el producto de y por

-- z. Por ejemplo,

-- productosDosNumerosCifras 2 9009 == [99,91]

productosDosNumerosCifras n x = [y | y <- numeros,

mod x y == 0,

div x y `elem` numeros]

where numeros = numerosCifras n

-- 2ª solución

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

mayorCapicuaP2 :: Integer -> Integer

mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b],

y <- [a,a-1..b],

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (esCapicua x) se verifica si x es capicúa. Por ejemplo,

-- esCapicua 353 == True

-- esCapicua 357 == False

esCapicua :: Integer -> Bool

esCapicua n = xs == reverse xs

where xs = show n

-- 3ª solución

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

mayorCapicuaP3 :: Integer -> Integer

mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b,

esCapicua (x*y)]

where a = 10^n-1

b = 10^(n-1)

-- (pares a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares a b = [(x,z-x) | z <- [a1,a1-1..b1],

x <- [a,a-1..b],

x <= z-x, z-x <= a]

where a1 = 2*a

b1 = 2*b

-- 4ª solución

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

mayorCapicuaP4 :: Integer -> Integer

mayorCapicuaP4 n = maximum [x | y <- [a..b],

z <- [y..b],

let x = y * z,

let s = show x,

s == reverse s]

where a = 10^(n-1)

b = 10^n-1

-- 5ª solución

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

mayorCapicuaP5 :: Integer -> Integer

mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (pares2 a b) es la lista de los pares de números entre a y b de forma

-- que su suma es decreciente. Por ejemplo,

-- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)]

pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]]

-- 6ª solución

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

mayorCapicuaP6 :: Integer -> Integer

mayorCapicuaP6 n = maximum [x*y | x <- [a..b],

y <- [x..b] ,

esCapicua (x*y)]

where a = 10^(n-1)

b = 10^n-1

-- (cifras n) es la lista de las cifras de n en orden inverso. Por

-- ejemplo,

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

cifras :: Integer -> [Integer]

cifras n

| n < 10 = [n]

| otherwise = (ultima n) : (cifras (quitarUltima n))

-- (ultima n) es la última cifra de n. Por ejemplo,

-- ultima 325 == 5

ultima :: Integer -> Integer

ultima n = n - (n `div` 10)*10

-- (quitarUltima n) es el número obtenido al quitarle a n su última

-- cifra. Por ejemplo,

-- quitarUltima 325 => 32

quitarUltima :: Integer -> Integer

quitarUltima n = (n - (ultima n)) `div` 10

-- 7ª solución

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

mayorCapicuaP7 :: Integer -> Integer

mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n]

-- (esFactorizable x n) se verifica si x se puede escribir como producto

-- de dos números de n dígitos. Por ejemplo,

-- esFactorizable 1219 2 == True

-- esFactorizable 1217 2 == False

esFactorizable x n = aux i x

where b = 10^n-1

i = floor (sqrt (fromIntegral x))

aux i x | i > b = False

| x `mod` i == 0 = x `div` i < b

| otherwise = aux (i+1) x

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

-- Comparación de soluciones --

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

-- Tiempo (en segundos) de cálculo de (mayorCapicuaP n) con las 7

-- definiciones

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

-- | Def. | 2 | 3 | 4 |

-- |------+------+------+------|

-- | 1 | 0.01 | 0.13 | 1.39 |

-- | 2 | 0.03 | 2.07 | |

-- | 3 | 0.05 | 3.86 | |

-- | 4 | 0.01 | 0.89 | |

-- | 5 | 0.03 | 1.23 | |

-- | 6 | 0.02 | 1.03 | |

-- | 7 | 0.01 | 0.02 | 0.02 |

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

Máxima suma de los segmentos

PorJosé A. Alonso 13-enero-201525-abril-2021

Un segmento de una lista xs es una sublista de xs formada por elementos consecutivos en la lista. El problema de la máxima suma de segmentos consiste en dada una lista de números enteros calcular el máximo de las sumas de todos los segmentos de la lista. Por ejemplo, para la lista [-1,2,-3,5,-2,1,3,-2,-2,-3,6] la máxima suma de segmentos es 7 que es la suma del segmento [5,-2,1,3] y para la lista [-1,-2,-3] es 0 que es la suma de la lista vacía.

Definir la función

   mss :: [Integer] -> Integer

1	mss :: [Integer] -> Integer

tal que (mss xs) es la máxima suma de los segmentos de xs. Por ejemplo,

   mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6]  ==  7
   mss [-1,-2,-3]                     ==  0
   mss [1..500]                       ==  125250
   mss [1..1000]                      ==  500500
   mss [-500..3]                      ==  6
   mss [-1000..3]                     ==  6

mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6] == 7

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

mss [1..500] == 125250

mss [1..1000] == 500500

mss [-500..3] == 6

mss [-1000..3] == 6

Soluciones

import Data.List (inits,tails)

-- 1ª solución
mss :: [Integer] -> Integer
mss = maximum . map sum . segmentos

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

-- 2ª definición:
mss2 :: [Integer] -> Integer
mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:
mss3 :: [Integer] -> Integer
mss3 = maximum . map sum . concatMap tails . inits 

-- 4ª definición
mss4 :: [Integer] -> Integer
mss4  = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0) 

-- 5ª definición (con scanl):
mss5 :: [Integer] -> Integer
mss5 = maximum . scanl (\a x -> max 0 a + x) 0

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

--    ghci> mss [1..500]
--    125250
--    (7.52 secs, 2022130824 bytes)
--    
--    ghci> mss2 [1..500]
--    125250
--    (0.01 secs, 10474956 bytes)
--    
--    ghci> mss3 [1..500]
--    125250
--    (0.98 secs, 841862016 bytes)
--    
--    ghci> mss4 [1..500]
--    125250
--    (0.01 secs, 552252 bytes)
--    
--    ghci> mss2 [1..1000]
--    500500
--    (0.06 secs, 54575712 bytes)
--    
--    ghci> mss3 [1..1000]
--    500500
--    (7.87 secs, 7061347900 bytes)
--
--    ghci> mss4 [1..1000]
--    500500
--    (0.01 secs, 549700 bytes)
--    
--    ghci> mss2 [1..2000]
--    2001000
--    (0.29 secs, 216424336 bytes)
--    
--    ghci> mss2 [1..5000]
--    12502500
--    (2.37 secs, 1356384840 bytes)
--    
--    ghci> mss4 [1..5000]
--    12502500
--    (0.02 secs, 1913548 bytes)
--
--    ghci> mss5 [1..5000]
--    12502500
--    (0.01 secs, 2886360 bytes)

import Data.List (inits,tails)

-- 1ª solución

mss :: [Integer] -> Integer

mss = maximum . map sum . segmentos

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

-- ghci> segmentos "abc"

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

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

segmentos = concat . map inits . tails

-- 2ª definición:

mss2 :: [Integer] -> Integer

mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:

mss3 :: [Integer] -> Integer

mss3 = maximum . map sum . concatMap tails . inits

-- 4ª definición

mss4 :: [Integer] -> Integer

mss4 = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0)

-- 5ª definición (con scanl):

mss5 :: [Integer] -> Integer

mss5 = maximum . scanl (\a x -> max 0 a + x) 0

-- Comparación de eficiencia

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

-- ghci> mss [1..500]

-- 125250

-- (7.52 secs, 2022130824 bytes)

-- ghci> mss2 [1..500]

-- 125250

-- (0.01 secs, 10474956 bytes)

-- ghci> mss3 [1..500]

-- 125250

-- (0.98 secs, 841862016 bytes)

-- ghci> mss4 [1..500]

-- 125250

-- (0.01 secs, 552252 bytes)

-- ghci> mss2 [1..1000]

-- 500500

-- (0.06 secs, 54575712 bytes)

-- ghci> mss3 [1..1000]

-- 500500

-- (7.87 secs, 7061347900 bytes)

-- ghci> mss4 [1..1000]

-- 500500

-- (0.01 secs, 549700 bytes)

-- ghci> mss2 [1..2000]

-- 2001000

-- (0.29 secs, 216424336 bytes)

-- ghci> mss2 [1..5000]

-- 12502500

-- (2.37 secs, 1356384840 bytes)

-- ghci> mss4 [1..5000]

-- 12502500

-- (0.02 secs, 1913548 bytes)

-- ghci> mss5 [1..5000]

-- 12502500

-- (0.01 secs, 2886360 bytes)

Referencias

El ejercicio está basado en la función mss del libro de Bird Thinking functionally with Haskell (página 127).
Las soluciones 3ª y 4ª las publicó josejuan aquí

Máximo de una función

PorJosé A. Alonso 4-noviembre-201427-diciembre-2014

Enunciado

-- Se considera la siguiente función
--    g :: Integer -> Integer
--    g n = if n < 10 then n*n else n
-- 
-- Definir la función 
--    max_g :: Integer -> Integer
-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza
-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por
-- ejemplo,
--    max_g (-7)  ==  0
--    max_g 7     ==  7
--    max_g 14    ==  9
--    max_g 84    ==  84
-- 
-- Comprobar con QuickCheck que la función max_g es equivalente a la
-- función f definida por  
--    f :: Integer -> Integer
--    f n | n < 0             = 0
--        | n >= 10 && n < 81 = 9
--        | otherwise         = n
--
-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra
-- por recursión.

-- Se considera la siguiente función

-- g :: Integer -> Integer

-- g n = if n < 10 then n*n else n

-- Definir la función

-- max_g :: Integer -> Integer

-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza

-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por

-- ejemplo,

-- max_g (-7) == 0

-- max_g 7 == 7

-- max_g 14 == 9

-- max_g 84 == 84

-- Comprobar con QuickCheck que la función max_g es equivalente a la

-- función f definida por

-- f :: Integer -> Integer

-- f n | n < 0 = 0

-- | n >= 10 && n < 81 = 9

-- | otherwise = n

-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra

-- por recursión.

Soluciones

import Test.QuickCheck

g :: Integer -> Integer
g n = if n < 10 then n*n else n

-- 1ª definición (por comprensión):
max_gC :: Integer -> Integer
max_gC n | n < 0     = 0 
         | otherwise = snd (maximum [(g i,i) | i <- [0..n]])

-- 2ª definición (por recursión):
max_gR :: Integer -> Integer
max_gR n | n < 0      = 0
         | g m > g n  = m 
         | otherwise  = n
         where m = max_gR (n - 1)

f :: Integer -> Integer
f n | n < 0             = 0
    | n >= 10 && n < 81 = 9
    | otherwise         = n

-- La propiedad con max_gR es
prop_max_gR n = max_gR n == f n

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

-- La propiedad con max_gC es
prop_max_gC n = max_gC n == f n

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

import Test.QuickCheck

g :: Integer -> Integer

g n = if n < 10 then n*n else n

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

max_gC :: Integer -> Integer

max_gC n | n < 0 = 0

| otherwise = snd (maximum [(g i,i) | i <- [0..n]])

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

max_gR :: Integer -> Integer

max_gR n | n < 0 = 0

| g m > g n = m

| otherwise = n

where m = max_gR (n - 1)

f :: Integer -> Integer

f n | n < 0 = 0

| n >= 10 && n < 81 = 9

| otherwise = n

-- La propiedad con max_gR es

prop_max_gR n = max_gR n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gR

-- +++ OK, passed 100 tests.

-- La propiedad con max_gC es

prop_max_gC n = max_gC n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gC

-- +++ OK, passed 100 tests.

Límite de sucesiones

PorJosé A. Alonso 1-julio-201427-diciembre-2014

Enunciado

-- Ejercicio. Definir la función  
--    limite :: (Double -> Double) -> Double -> Double
-- tal que (limite f a) es el valor de f en el primer término x tal que, 
-- para todo y entre x+1 y x+100, el valor absoluto de la diferencia
-- entre f(y) y f(x) es menor que a. Por ejemplo,
--    limite (\n -> (2*n+1)/(n+5)) 0.001  ==  1.9900110987791344
--    limite (\n -> (1+1/n)**n) 0.001     ==  2.714072874546881

-- Ejercicio. Definir la función

-- limite :: (Double -> Double) -> Double -> Double

-- tal que (limite f a) es el valor de f en el primer término x tal que,

-- para todo y entre x+1 y x+100, el valor absoluto de la diferencia

-- entre f(y) y f(x) es menor que a. Por ejemplo,

-- limite (\n -> (2*n+1)/(n+5)) 0.001 == 1.9900110987791344

-- limite (\n -> (1+1/n)**n) 0.001 == 2.714072874546881

Soluciones

limite :: (Double -> Double) -> Double -> Double
limite f a = 
    head [f x | x <- [1..],
                maximum [abs(f y - f x) | y <- [x+1..x+100]] < a]

limite :: (Double -> Double) -> Double -> Double

limite f a =

head [f x | x <- [1..],

maximum [abs(f y - f x) | y <- [x+1..x+100]] < a]

Mayor sucesión del problema 3n+1

PorJosé A. Alonso 20-junio-20141-mayo-2016

Enunciado

-- La sucesión 3n+1 generada por un número entero positivo x es la
-- sucesión generada por el siguiente algoritmo: Se empieza con el
-- número x. Si x es par, se divide entre 2. Si x es impar, se
-- multiplica por 3 y se le suma 1. El  proceso se repite con el número
-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de
-- números generadas cuando se empieza en 22 es
--    22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre
-- alcanza el 1 empezando en cualquier entero positivo.
-- 
-- Definir la función
--    mayorLongitud :: Integer -> Integer -> Integer
-- tal que (mayorLongitud i j) es el máximo de las longitudes de las
-- sucesiones 3n+1 para todos los números comprendidos entre i y j,
-- ambos inclusives. Por ejemplo,
--    mayorLongitud   1   10  ==  20
--    mayorLongitud 100  200  ==  125
--    mayorLongitud 201  210  ==  89
--    mayorLongitud 900 1000  ==  174

-- La sucesión 3n+1 generada por un número entero positivo x es la

-- sucesión generada por el siguiente algoritmo: Se empieza con el

-- número x. Si x es par, se divide entre 2. Si x es impar, se

-- multiplica por 3 y se le suma 1. El proceso se repite con el número

-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de

-- números generadas cuando se empieza en 22 es

-- 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1

-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre

-- alcanza el 1 empezando en cualquier entero positivo.

-- Definir la función

-- mayorLongitud :: Integer -> Integer -> Integer

-- tal que (mayorLongitud i j) es el máximo de las longitudes de las

-- sucesiones 3n+1 para todos los números comprendidos entre i y j,

-- ambos inclusives. Por ejemplo,

-- mayorLongitud 1 10 == 20

-- mayorLongitud 100 200 == 125

-- mayorLongitud 201 210 == 89

-- mayorLongitud 900 1000 == 174

Soluciones

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

mayorLongitud1 :: Int -> Int -> Int
mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion :: Int -> [Int]
sucesion 1 = [1]
sucesion n | even n    = n : sucesion (n `div` 2)
           | otherwise = n : sucesion (3*n+1)

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

mayorLongitud2 :: Int -> Int -> Int
mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por
-- ejemplo, 
--    longitud 22  ==  16
longitud :: Int -> Int
longitud 1 = 1
longitud n | even n    = 1 + longitud (n `div` 2)
           | otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)
-- =========================

mayorLongitud3 :: Int -> Int -> Int
mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion2 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion2 :: Int -> [Int]
sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]
    where f x | even x    = x `div` 2
              | otherwise = 3*x+1

-- 1ª solución

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

mayorLongitud1 :: Int -> Int -> Int

mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion :: Int -> [Int]

sucesion 1 = [1]

sucesion n | even n = n : sucesion (n `div` 2)

| otherwise = n : sucesion (3*n+1)

-- 2ª solución

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

mayorLongitud2 :: Int -> Int -> Int

mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por

-- ejemplo,

-- longitud 22 == 16

longitud :: Int -> Int

longitud 1 = 1

longitud n | even n = 1 + longitud (n `div` 2)

| otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)

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

mayorLongitud3 :: Int -> Int -> Int

mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion2 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion2 :: Int -> [Int]

sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]

where f x | even x = x `div` 2

| otherwise = 3*x+1

Referencia

El ejercicio está basado en The 3n + 1 problem de UVa Online Judge.

Soluciones

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencia

Entradas recientes

Buscar

Correo electrónico