Biparticiones con la misma suma

El enunciado del problema 1 de la Fase Local de la Olimpiada Matemática Española del 2010 es

Sea I(n) el conjunto de los n primeros números naturales impares. Por ejemplo: I(3) = {1,3,5}, I(6) = {1,3,5,7,9,11}, etc.

¿Para qué números n el conjunto I(n) se puede descomponer en dos partes (disjuntas) de forma que coincidan las sumas de los números en cada una de ellas?

Definir las funciones

   biparticiones :: Integer -> [([Integer],[Integer])]
   tieneBiparticiones :: Integer -> Bool
   biparticionD :: Integer -> Maybe ([Integer],[Integer])

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

tieneBiparticiones :: Integer -> Bool

biparticionD :: Integer -> Maybe ([Integer],[Integer])

tales que

(biparticiones n) es la lista de las biparticiones de I(n) con igual suma; es decir, la lista de los pares (xs,ys) tales que xs e ys son subconjuntos disjuntos de I(n) cuya unión es I(n) y la suma de los elementos de xs es igual que la de los de ys. Por ejemplo,

     λ> biparticiones 4
     [([1,7],[3,5])]
     λ> biparticiones 5
     []
     λ> biparticiones 8
     [([1,3,13,15],[5,7,9,11]),([1,5,11,15],[3,7,9,13]),([1,7,9,15],[3,5,11,13]),([1,7,11,13],[3,5,9,15])]

λ> biparticiones 4

[([1,7],[3,5])]

λ> biparticiones 5

[]

λ> biparticiones 8

[([1,3,13,15],[5,7,9,11]),([1,5,11,15],[3,7,9,13]),([1,7,9,15],[3,5,11,13]),([1,7,11,13],[3,5,9,15])]

(tieneBiparticiones n) se verifica si I(n) tiene alguna bipartición con igual suma. Por ejemplo,

     tieneBiparticiones 4  ==  True
     tieneBiparticiones 5  ==  False
     tieneBiparticiones (10^(10^7))  ==  True

tieneBiparticiones 4 == True

tieneBiparticiones 5 == False

tieneBiparticiones (10^(10^7)) == True

(biparticionD n) es una de las biparticiones de I(n) con igual suma, si tiene alguna y Nothing, en caso contrario. Por ejemplo,

     λ> biparticionD 6
     Just ([7,11],[1,3,5,9])
     λ> biparticionD 7
     Nothing
     λ> biparticionD 8
     Just ([1,7,9,15],[3,5,11,13])
     λ> biparticionD 10
     Just ([7,11,13,19],[1,3,5,9,15,17])
     λ> biparticionD 12
     Just ([1,7,9,15,17,23],[3,5,11,13,19,21])
     λ> biparticionD 30
     Just ([7,11,13,19,21,27,29,35,37,43,45,51,53,59],[1,3,5,9,15,17,23,25,31,33,39,41,47,49,55,57])
     λ> length (show (biparticionD (2*10^4)))
     114455

λ> biparticionD 6

Just ([7,11],[1,3,5,9])

λ> biparticionD 7

Nothing

λ> biparticionD 8

Just ([1,7,9,15],[3,5,11,13])

λ> biparticionD 10

Just ([7,11,13,19],[1,3,5,9,15,17])

λ> biparticionD 12

Just ([1,7,9,15,17,23],[3,5,11,13,19,21])

λ> biparticionD 30

Just ([7,11,13,19,21,27,29,35,37,43,45,51,53,59],[1,3,5,9,15,17,23,25,31,33,39,41,47,49,55,57])

λ> length (show (biparticionD (2*10^4)))

114455

Usando tieneBiparticiones calcular los 10 primeros valores buscados (es decir, los 10 valores de n para los que I(n) se puede descomponer en dos partes (disjuntas) de forma que coincidan las sumas de los números en cada una de ellas) y generalizar.

Soluciones

import Data.List ((\\), delete, genericTake, sort, subsequences)
import Data.Maybe (listToMaybe)
import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª definición de biparticiones
-- =================================

biparticiones :: Integer -> [([Integer],[Integer])]
biparticiones n =
  ordena [(bs \\ as,as) | as <- genericTake (2^(n-1)) (subsequences bs),
                          2 * sum as == m]
  where bs = genericTake n impares
        m  = sum bs

-- impares es la lista de los números impares. Por ejemplo,
--    take 9 impares  ==  [1,3,5,7,9,11,13,15,17]
impares :: [Integer]
impares = [1,3..]

-- (ordena ps) es lista obtenida poniendo en primer lugar la menor de
-- las componentes de los pares de ps y ordenando el resultado. Por
-- ejemplo,
--    ordena [(5,3),(1,7),(4,2)]  ==  [(1,7),(2,4),(3,5)]
ordena :: Ord a => [(a,a)] -> [(a,a)]
ordena ps = sort (map aux ps)
  where aux (xs,ys) | xs < ys   = (xs,ys)
                    | otherwise = (ys,xs)

-- 2ª definición de biparticiones
-- =================================

biparticiones2 :: Integer -> [([Integer],[Integer])]
biparticiones2 n = sort (aux ([([a], delete a bs) | a <- bs]))
  where bs = genericTake n impares
        m  = sum bs
        aux [] = []
        aux ((_,[]):ps) = aux ps
        aux ((xs,ys):ps)
          | sum xs == sum ys = if xs < ys then (xs,ys) : aux ps
                               else aux ps
          | sum xs <  sum ys = aux ([(a:xs, delete a ys) | a <- ys, a < head xs] ++ ps)
          | otherwise        = aux ps

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

-- La propiedad es
prop_biparticiones :: Integer -> Bool
prop_biparticiones n =
  and [biparticiones k == biparticiones2 k | k <- [1..n]]

-- La comprobación es
--    λ> prop_biparticiones 20
--    True

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

-- La comparación es
--    λ> length (biparticiones 20)
--    3965
--    (0.36 secs, 568,151,296 bytes)
--    λ> length (biparticiones2 20)
--    3965
--    (2.51 secs, 2,490,876,672 bytes)
--    λ> head (biparticiones 20)
--    ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])
--    (0.37 secs, 562,477,968 bytes)
--    λ> head (biparticiones2 20)
--    ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])
--    (2.33 secs, 2,488,098,776 bytes)

-- 1ª definición de tieneBiparticiones
-- ======================================

tieneBiparticiones :: Integer -> Bool
tieneBiparticiones = not . null . biparticiones

-- 2ª definición de tieneBiparticiones
-- ======================================

-- Observando el siguiente cálculo
--    λ> [n | n <- [1..20], tieneBiparticiones n]
--    [4,6,8,10,12,14,16,18,20]

tieneBiparticiones2 :: Integer -> Bool
tieneBiparticiones2 n = n > 3 && even n

-- 1ª definición de biparticionD
-- ================================

biparticionD :: Integer -> Maybe ([Integer],[Integer])
biparticionD = listToMaybe . biparticiones

-- 2ª definición de biparticionD
-- ================================

biparticionD2 :: Integer -> Maybe ([Integer],[Integer])
biparticionD2 x
  | x < 4 || odd x = Nothing
  | otherwise      = Just (aux x)
  where
    aux 4 = ([1,7],[3,5])
    aux 6 = ([7,11],[1,3,5,9])
    aux n = (xs ++ [m+1,m+7], ys ++ [m+3,m+5])
      where (xs,ys) = aux (n-4)
            m       = 2*(n-4)

-- Cálculo de la respuesta
-- =======================

-- El cálculo es
--    λ> take 10 [n | n <- [1..], tieneBiparticiones n]
--    [4,6,8,10,12,14,16,18,20,22]
-- cuyos valores son los números pares mayores que 3.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List ((\\), delete, genericTake, sort, subsequences)

import Data.Maybe (listToMaybe)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª definición de biparticiones

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

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

biparticiones n =

ordena [(bs \\ as,as) | as <- genericTake (2^(n-1)) (subsequences bs),

2 * sum as == m]

where bs = genericTake n impares

m = sum bs

-- impares es la lista de los números impares. Por ejemplo,

-- take 9 impares == [1,3,5,7,9,11,13,15,17]

impares :: [Integer]

impares = [1,3..]

-- (ordena ps) es lista obtenida poniendo en primer lugar la menor de

-- las componentes de los pares de ps y ordenando el resultado. Por

-- ejemplo,

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

ordena :: Ord a => [(a,a)] -> [(a,a)]

ordena ps = sort (map aux ps)

where aux (xs,ys) | xs < ys = (xs,ys)

| otherwise = (ys,xs)

-- 2ª definición de biparticiones

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

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

biparticiones2 n = sort (aux ([([a], delete a bs) | a <- bs]))

where bs = genericTake n impares

m = sum bs

aux [] = []

aux ((_,[]):ps) = aux ps

aux ((xs,ys):ps)

| sum xs == sum ys = if xs < ys then (xs,ys) : aux ps

else aux ps

| sum xs < sum ys = aux ([(a:xs, delete a ys) | a <- ys, a < head xs] ++ ps)

| otherwise = aux ps

-- Comprobación de equivalencia

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

-- La propiedad es

prop_biparticiones :: Integer -> Bool

prop_biparticiones n =

and [biparticiones k == biparticiones2 k | k <- [1..n]]

-- La comprobación es

-- λ> prop_biparticiones 20

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (biparticiones 20)

-- 3965

-- (0.36 secs, 568,151,296 bytes)

-- λ> length (biparticiones2 20)

-- 3965

-- (2.51 secs, 2,490,876,672 bytes)

-- λ> head (biparticiones 20)

-- ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])

-- (0.37 secs, 562,477,968 bytes)

-- λ> head (biparticiones2 20)

-- ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])

-- (2.33 secs, 2,488,098,776 bytes)

-- 1ª definición de tieneBiparticiones

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

tieneBiparticiones :: Integer -> Bool

tieneBiparticiones = not . null . biparticiones

-- 2ª definición de tieneBiparticiones

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

-- Observando el siguiente cálculo

-- λ> [n | n <- [1..20], tieneBiparticiones n]

-- [4,6,8,10,12,14,16,18,20]

tieneBiparticiones2 :: Integer -> Bool

tieneBiparticiones2 n = n > 3 && even n

-- 1ª definición de biparticionD

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

biparticionD :: Integer -> Maybe ([Integer],[Integer])

biparticionD = listToMaybe . biparticiones

-- 2ª definición de biparticionD

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

biparticionD2 :: Integer -> Maybe ([Integer],[Integer])

biparticionD2 x

| x < 4 || odd x = Nothing

| otherwise = Just (aux x)

where

aux 4 = ([1,7],[3,5])

aux 6 = ([7,11],[1,3,5,9])

aux n = (xs ++ [m+1,m+7], ys ++ [m+3,m+5])

where (xs,ys) = aux (n-4)

m = 2*(n-4)

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> take 10 [n | n <- [1..], tieneBiparticiones n]

-- [4,6,8,10,12,14,16,18,20,22]

-- cuyos valores son los números pares mayores que 3.

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

3 Comentarios

import Data.List
biparticiones :: Integer -> [([Integer],[Integer])]
biparticiones n = [(xs,ys) | xs<-s , ys<-s, sum xs == sum ys,
                            (genericLength xs + genericLength ys) == n,
                             null (intersect xs ys),
                             head xs <= head ys]
           where s  = subsequences zs
                 zs = genericTake n [1,3..]

tieneBiparticiones' :: Integer -> Bool
tieneBiparticiones' n = not (null (biparticiones n))

--Con los ejemplos propuestos, vemos que n tendrá biparticiones si es par y mayor que 4
tieneBiparticiones :: Integer -> Bool
tieneBiparticiones n = even n && n>=4

biparticionD :: Integer -> Maybe ([Integer],[Integer])
biparticionD n | tieneBiparticiones n = Just (head (biparticiones n))
               | otherwise            = Nothing

import Data.List

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

biparticiones n = [(xs,ys) | xs<-s , ys<-s, sum xs == sum ys,

(genericLength xs + genericLength ys) == n,

null (intersect xs ys),

head xs <= head ys]

where s = subsequences zs

zs = genericTake n [1,3..]

tieneBiparticiones' :: Integer -> Bool

tieneBiparticiones' n = not (null (biparticiones n))

--Con los ejemplos propuestos, vemos que n tendrá biparticiones si es par y mayor que 4

tieneBiparticiones :: Integer -> Bool

tieneBiparticiones n = even n && n>=4

biparticionD :: Integer -> Maybe ([Integer],[Integer])

biparticionD n | tieneBiparticiones n = Just (head (biparticiones n))

| otherwise = Nothing

Responder

No se me ocurre una forma más sucinta de mostrar cómo construir cualquier solución con coste O(n)

{-

  Si la suma es impar es imposible balancear => n debe ser par.

  Para n = 2 es {1,3} que es imposible de dividir en dos.

  Para n = 2k > 2 tenemos el siguiente esquema

                     +--+
                     :  :
                     +--+
                     :  :
                  +--+--+
                  :  :  :
                  +--+--+
                  :  :  :
               +--+--+--+
               :  :  :  :
               +--+--+--+
               ::::::::::
            +--+::::::::+
            :  ::::::::::
            +--+::::::::+
            :  ::::::::::
         +--+--+::::::::+
         :  :  ::::::::::
         +--+--+::::::::+
         :  :  ::::::::::
      +--+--+--+::::::::+
      :  :  :  ::::::::::
      +--+--+--+--+--+--+

      \___ ___/\___ ____/
          V        V

          A        B

  A la hora de hacer la bipartición, si tomamos un índice
  `j` de B, el `j-k` de A lo compensa excepto con `n`
  de diferencia, que compensaremos pasando otro `j` de B
  al grupo contrario. Si `k` es par, este ajuste se hace
  dos a dos.

  Así, para `k` par siempre habrá al menos una solución.

  Para `k` impar debemos quitarnos de encima tres columnas
  para dejarlas pares, una forma de hacerlo es ver que hay
  un índice `i` tal que su columna y la `k + i` suman `2n`,
  que es la `i = (k + 1) / 2`. El balance ahora es 0 y tenemos
  columnas pares, por lo que hacemos lo que antes.

  Así, para cualquier n = 2 k > 2 habrá siempre solución.

  El proceso anterior nos lleva a poder encontrar, directamente,
  un conjunto de soluciones para cualquier `n` (pero no
  hemos demostrado que no haya otras soluciones como de hecho hay).

-}
sumSplit :: Integer -> [Integer]
sumSplit n = if even k then rep [1..k]
                       else (-1):(k+1):(-2):(k+2):(-i):(-k-i):rep ([3..i-1]++[i+1..k])
  where k = n `div` 2
        i = (k + 1) `div` 2
        rep [] = []
        rep (x:y:xs) = (-x):(-k-y):(k+x):y: rep xs

-- al formato del enunciado
biparticionD :: Integer -> Maybe ([Integer], [Integer])
biparticionD n = if n < 4 || odd n then Nothing else Just (f abs (<0), f id (>0))
  where xs = sumSplit n
        f g q = [2 * i - 1 | i <- map g $ filter q xs]

{-

*Main> length (show (biparticionD (2*10^4)))
114455
(0.05 secs, 19,124,456 bytes)

*Main> length (show (biparticionD (10^7)))
84444455
(18.15 secs, 10,577,925,432 bytes)

-}

Si la suma es impar es imposible balancear => n debe ser par.

Para n = 2 es {1,3} que es imposible de dividir en dos.

Para n = 2k > 2 tenemos el siguiente esquema

+--+

: :

+--+

: :

+--+--+

: : :

+--+--+

: : :

+--+--+--+

: : : :

+--+--+--+

::::::::::

+--+::::::::+

: ::::::::::

+--+::::::::+

: ::::::::::

+--+--+::::::::+

: : ::::::::::

+--+--+::::::::+

: : ::::::::::

+--+--+--+::::::::+

: : : ::::::::::

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

\___ ___/\___ ____/

V V

A B

A la hora de hacer la bipartición, si tomamos un índice

`j` de B, el `j-k` de A lo compensa excepto con `n`

de diferencia, que compensaremos pasando otro `j` de B

al grupo contrario. Si `k` es par, este ajuste se hace

dos a dos.

Así, para `k` par siempre habrá al menos una solución.

Para `k` impar debemos quitarnos de encima tres columnas

para dejarlas pares, una forma de hacerlo es ver que hay

un índice `i` tal que su columna y la `k + i` suman `2n`,

que es la `i = (k + 1) / 2`. El balance ahora es 0 y tenemos

columnas pares, por lo que hacemos lo que antes.

Así, para cualquier n = 2 k > 2 habrá siempre solución.

El proceso anterior nos lleva a poder encontrar, directamente,

un conjunto de soluciones para cualquier `n` (pero no

hemos demostrado que no haya otras soluciones como de hecho hay).

sumSplit :: Integer -> [Integer]

sumSplit n = if even k then rep [1..k]

else (-1):(k+1):(-2):(k+2):(-i):(-k-i):rep ([3..i-1]++[i+1..k])

where k = n `div` 2

i = (k + 1) `div` 2

rep [] = []

rep (x:y:xs) = (-x):(-k-y):(k+x):y: rep xs

-- al formato del enunciado

biparticionD :: Integer -> Maybe ([Integer], [Integer])

biparticionD n = if n < 4 || odd n then Nothing else Just (f abs (<0), f id (>0))

where xs = sumSplit n

f g q = [2 * i - 1 | i <- map g $ filter q xs]

*Main> length (show (biparticionD (2*10^4)))

114455

(0.05 secs, 19,124,456 bytes)

*Main> length (show (biparticionD (10^7)))

84444455

(18.15 secs, 10,577,925,432 bytes)

Responder

import Data.Numbers.Primes
import Data.List

biparticiones :: Integer -> [([Integer],[Integer])]
biparticiones n = [(xs,ys) | xs <- rs, ys <- rs,
                   sum xs == sum ys,
                   not (null xs),
                   not (null ys),
                   null (intersect xs ys),
                   head xs <= head ys,
                   length xs + length ys == fromIntegral n]
 where zs = 1: take (fromIntegral (n-1)) [x | x <- [3,5..], isPrime x]
       rs = subsequences zs
       
-- Si nos fijamos, para que se puede descomponer I(n) - conjunto de los n
-- primeros numeros primos impares - necesitamos que las sumas de las dos listas sean iguales. Dado que son numeros impares, esta suma podria ser: 
-- a)	Si tenemos un numero impar de terminos en una de las listas, la suma sera impar. 
-- b)	Si tenemos un numero par de terminos, la suma sera par
-- Si tenemos un numero impar de terminos I(3) o I(5), en una de las listas tendremos como suma un numero par y en la otra impar. Luego tendremos que tener un numero par de terminos para que las sumas puedan coincidir.
-- Ademas, en la practica se verifica que para n par y n >= 4, I(n) podra descomponerse


tieneBiparticiones :: Integer -> Bool
tieneBiparticiones n = even n && n >=4

biparticionD :: Integer -> Maybe ([Integer],[Integer])
biparticionD n | not (tieneBiparticiones n) = Nothing
               | otherwise                  = Just (head (biparticiones n))

import Data.Numbers.Primes

import Data.List

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

biparticiones n = [(xs,ys) | xs <- rs, ys <- rs,

sum xs == sum ys,

not (null xs),

not (null ys),

null (intersect xs ys),

head xs <= head ys,

length xs + length ys == fromIntegral n]

where zs = 1: take (fromIntegral (n-1)) [x | x <- [3,5..], isPrime x]

rs = subsequences zs

-- Si nos fijamos, para que se puede descomponer I(n) - conjunto de los n

-- primeros numeros primos impares - necesitamos que las sumas de las dos listas sean iguales. Dado que son numeros impares, esta suma podria ser:

-- a) Si tenemos un numero impar de terminos en una de las listas, la suma sera impar.

-- b) Si tenemos un numero par de terminos, la suma sera par

-- Si tenemos un numero impar de terminos I(3) o I(5), en una de las listas tendremos como suma un numero par y en la otra impar. Luego tendremos que tener un numero par de terminos para que las sumas puedan coincidir.

-- Ademas, en la practica se verifica que para n par y n >= 4, I(n) podra descomponerse

tieneBiparticiones :: Integer -> Bool

tieneBiparticiones n = even n && n >=4

biparticionD :: Integer -> Maybe ([Integer],[Integer])

biparticionD n | not (tieneBiparticiones n) = Nothing

| otherwise = Just (head (biparticiones n))

Responder

Biparticiones con la misma suma

Soluciones

Nuevas soluciones

3 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Nuevas soluciones

Se puede imprimir o compartir con

3 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico