Menu Close

Día: 17 junio, 2021

Máximo valor de permutaciones

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1982 es

Calcular una permutación (a(1),…,a(n)) de {1,2,…,n} que maximice el valor de

a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

Definir la función

   maximoValorPermutaciones :: Integer -> Integer

tal que (maximoValorPermutaciones n) es el máximo valor de

   a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

para todas las permutaciones (a(1),…,a(n)) de {1,2,…,n}. Por ejemplo,

   maximoValorPermutaciones 4       ==  25
   maximoValorPermutaciones (10^7)  ==  333333383333315000003
   maximoValorPermutaciones (10^8)  ==  333333338333333150000003
   maximoValorPermutaciones (10^9)  ==  333333333833333331500000003
   length (show (maximoValorPermutaciones (10^1000)))  ==  3000
   length (show (maximoValorPermutaciones (10^2000)))  ==  6000
   length (show (maximoValorPermutaciones (10^3000)))  ==  9000

Comprobar con QuickCheck que, para todo entero positivo n y toda permutación (a(1),…,a(n)) de {1,2,…,n},

   maximoValorPermutaciones n >= a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)
Soluciones
import Data.List (permutations)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
maximoValorPermutaciones :: Integer -> Integer
maximoValorPermutaciones n =
  maximum (map valor (permutations [1..n]))
 
valor :: [Integer] -> Integer
valor xs = sum [a * b | (a,b) <- zip xs (tail xs ++ take 1 xs)]
 
-- 2ª solución
-- ===========
 
maximoValorPermutaciones2 :: Integer -> Integer
maximoValorPermutaciones2 n =
  valor (head (permutacionesMaximizadoras n))
 
-- (permutacionesMaximizadoras n) es la lista de las permutaciones
-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de
--       a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)
-- es máximo. Por ejemplo,
--    λ> permutacionesMaximizadoras 5
--    [[3,1,2,4,5],[4,2,1,3,5],[3,5,4,2,1],[2,4,5,3,1],[2,1,3,5,4],
--     [5,3,1,2,4],[4,5,3,1,2],[1,3,5,4,2],[5,4,2,1,3],[1,2,4,5,3]]
permutacionesMaximizadoras :: Integer -> [[Integer]]
permutacionesMaximizadoras n =
  [xs | xs <- xss, valor xs == m]
  where xss = permutations [1..n]
        m   = maximum (map valor xss)
 
-- 3ª solución
-- ===========
 
maximoValorPermutaciones3 :: Integer -> Integer
maximoValorPermutaciones3 =
  valor . menorPermutacionMaximizadora
 
-- (menorPermutacionMaximizadora n) es la menor de las permutaciones
-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de
--       a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)
-- es máximo. Por ejemplo,
--    menorPermutacionMaximizadora 5  ==  [1,2,4,5,3]
menorPermutacionMaximizadora :: Integer -> [Integer]
menorPermutacionMaximizadora n =
  minimum [xs | xs <- xss, valor xs == m]
  where xss = permutations [1..n]
        m   = maximum (map valor xss)
 
-- 4ª solución
-- ===========
 
maximoValorPermutaciones4 :: Integer -> Integer
maximoValorPermutaciones4 =
  valor . menorPermutacionMaximizadora2
 
-- Redefinición de menorPermutacionMaximizadora observando que
--    menorPermutacionMaximizadora 2  ==  [1,2]
--    menorPermutacionMaximizadora 3  ==  [1,2,3]
--    menorPermutacionMaximizadora 4  ==  [1,2,4,3]
--    menorPermutacionMaximizadora 5  ==  [1,2,4,5,3]
--    menorPermutacionMaximizadora 6  ==  [1,2,4,6,5,3]
--    menorPermutacionMaximizadora 7  ==  [1,2,4,6,7,5,3]
--    menorPermutacionMaximizadora 8  ==  [1,2,4,6,8,7,5,3]
--    menorPermutacionMaximizadora 9  ==  [1,2,4,6,8,9,7,5,3]
menorPermutacionMaximizadora2 :: Integer -> [Integer]
menorPermutacionMaximizadora2 n
  | even n    = 1 : [2,4..n] ++ [n-1,n-3..3]
  | otherwise = 1 : [2,4..n] ++ [n,n-2..3]
 
-- 5ª solución
-- ===========
 
maximoValorPermutaciones5 :: Integer -> Integer
maximoValorPermutaciones5 n
  | even n    = valor (1 : [2,4..n] ++ [n-1,n-3..3])
  | otherwise = valor (1 : [2,4..n] ++ [n,n-2..3])
 
-- 6ª solución
-- ===========
 
maximoValorPermutaciones6 :: Integer -> Integer
maximoValorPermutaciones6 1 = 1
maximoValorPermutaciones6 n = (2*n^3+3*n^2-11*n+18) `div` 6
 
-- Comprobación de la equivalencia
-- ===============================
 
-- La propiedad, para pequeños valores, es
prop_equivalencia1 :: Integer -> Bool
prop_equivalencia1 n =
  and [maximoValorPermutaciones k == f k | k <- [2..n],
                                           f <- [maximoValorPermutaciones2,
                                                 maximoValorPermutaciones3,
                                                 maximoValorPermutaciones4,
                                                 maximoValorPermutaciones5,
                                                 maximoValorPermutaciones6]]
 
-- La comprobación es
--    λ> prop_equivalencia1 9
--    True
 
-- La propiedad, para grandes valores, es
prop_equivalencia2 :: Integer -> Property
prop_equivalencia2 n =
  n > 0 ==>
  maximoValorPermutaciones5 n == maximoValorPermutaciones6 n
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia2
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> maximoValorPermutaciones 10
--    368
--    (15.33 secs, 15,147,056,648 bytes)
--    λ> maximoValorPermutaciones2 10
--    368
--    (15.00 secs, 15,193,414,656 bytes)
--    λ> maximoValorPermutaciones3 10
--    368
--    (31.86 secs, 28,297,837,624 bytes)
--    λ> maximoValorPermutaciones4 10
--    368
--    (0.01 secs, 104,120 bytes)
--    λ> maximoValorPermutaciones5 10
--    368
--    (0.01 secs, 104,264 bytes)
--    λ> maximoValorPermutaciones6 10
--    368
--    (0.01 secs, 102,712 bytes)
--
--    λ> maximoValorPermutaciones4 (4*10^6)
--    21333341333326000003
--    (2.77 secs, 1,972,797,144 bytes)
--    λ> maximoValorPermutaciones5 (4*10^6)
--    21333341333326000003
--    (2.66 secs, 1,972,797,440 bytes)
--    λ> maximoValorPermutaciones6 (4*10^6)
--    21333341333326000003
--    (0.03 secs, 119,592 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_maximizadora :: Integer -> Property
prop_maximizadora n =
  n > 0 ==>
  do xs <- shuffle [1..n]
     return (maximoValorPermutaciones6 n >= valor xs)
 
-- La comprobación es
--    λ> quickCheck prop_maximizadora
--    +++ OK, passed 100 tests.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="haskell"> y otra con </pre>