Menu Close

Etiqueta: subsequences

Suma de los máximos de los subconjuntos

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

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

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

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)

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

Problema de las particiones óptimas

El problema de la particiones óptimas consiste en dada una lista xs dividirla en dos sublistas ys y zs tales que el valor absoluto de la diferencia de la suma de los elementos de xs y la suma de los elemento de zs sea lo menor posible.Cada una de estas divisiones (ys,zs) es una partición óptima de xs. Por ejemplo, la partición óptima de [2,3,5] es ([2,3],[5]) ya que |(2+3) – 5| = 0. Una lista puede tener distintas particiones óptimas. Por ejemplo, [1,1,2,3] tiene dos particiones óptimas ([1,2],[1,3]) y ([1,1,2],[3]) ambas con diferencia 1 (es decir, 1 = |(1+2)-(1+3)| = |(1+1+2)-3|).

Definir la función

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

tal que (particionesOptimas xs) es la lista de las particiones óptimas de xs. Por ejemplo,

   particionesOptimas [2,3,5]    ==  [([2,3],[5])]
   particionesOptimas [1,1,2,3]  ==  [([1,2],[1,3]),([1,1,2],[3])]

Soluciones

import Data.List ((\\), nub, sort, subsequences)
 
-- Una partición es un par de lista de enteros.
type Particion = ([Int],[Int])
 
-- (particiones xs) es la lista de las particiones de xs. Por ejemplo,
--    λ> particiones [2,3,5]
--    [([],[2,3,5]),([2],[3,5]),([2,3],[5]),([2,5],[3])]
particiones :: [Int] -> [Particion]
particiones xs =
  [(sort ys, sort zs) | ys <- subsequences xs
                      , let zs = xs \\ ys
                      , ys <= zs]
 
-- (diferencia p) es el valor absoluto de la diferencia de las sumas de
-- los elementos de la partición p. Por ejemplo,
--    diferencia ([2],[3,5])  ==  6
--    diferencia ([2,3],[5])  ==  0
diferencia :: Particion -> Int
diferencia (xs,ys) = abs (sum xs - sum ys)
 
-- (diferenciasParticiones xs) es la lista de las diferencias de las
-- particiones de xs. Por ejemplo,
--    diferenciasParticiones [2,3,5]  ==  [10,6,0,4]
diferenciasParticiones :: [Int] -> [Int]
diferenciasParticiones xs = map diferencia (particiones xs)
 
-- (minDiferenciaParticiones xs) es el mínimo de las diferencias de las
-- particiones de xs. Por ejemplo, 
--    minDiferenciaParticiones [2,3,5]    ==  0
--    minDiferenciaParticiones [1,1,2,3]  ==  1
minDiferenciaParticiones :: [Int] -> Int
minDiferenciaParticiones = minimum . diferenciasParticiones
 
particionesOptimas :: [Int] -> [Particion]
particionesOptimas xs =
  nub [(ys,zs) | (ys,zs) <- particiones xs
               , diferencia (ys,zs) == m]
  where m = minDiferenciaParticiones xs

Subconjuntos acotados

Definir la función

   subconjuntosAcotados :: [a] -> Int -> [[a]]

tal que (subconjuntosAcotados xs k) es la lista de los subconjuntos de xs con k elementos como máximo. Por ejemplo,

   λ> subconjuntosAcotados "abcd" 1
   ["a","b","c","d",""]
   λ> subconjuntosAcotados "abcd" 2
   ["ab","ac","ad","a","bc","bd","b","cd","c","d",""]
   λ> subconjuntosAcotados "abcd" 3
   ["abc","abd","ab","acd","ac","ad","a",
    "bcd","bc","bd","b","cd","c","d",""]
   λ> length (subconjuntosAcotados [1..1000] 2)
   500501
   λ> length (subconjuntosAcotados2 [1..2000] 2)
   2001001

Soluciones

import Data.List (subsequences)
 
-- 1ª definición
subconjuntosAcotados1 :: [a] -> Int -> [[a]]
subconjuntosAcotados1 xs k =
  [ys | ys <- subsequences xs
      , length ys <= k]
 
-- 2ª definición
subconjuntosAcotados2 :: [a] -> Int -> [[a]]
subconjuntosAcotados2 _ 0  = [[]]
subconjuntosAcotados2 [] _ = [[]]
subconjuntosAcotados2 (x:xs) k =
  [x:ys | ys <- subconjuntosAcotados2 xs (k-1)]
  ++ subconjuntosAcotados2 xs k
 
-- Comparación de eficiencia
--    λ> length (subconjuntosAcotados1 [1..25] 2)
--    326
--    (10.48 secs, 6,968,637,480 bytes)
--    λ> length (subconjuntosAcotados2 [1..25] 2)
--    326
--    (0.00 secs, 0 bytes)

Máxima longitud de las sublistas comunes

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

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

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)

Menor no expresable como suma

Definir la función

   menorNoSuma :: [Integer] -> Integer

tal que (menorNoSuma xs) es el menor número que no se puede escribir como suma de un subconjunto de xs, donde se supone que xs es un conjunto de números enteros positivos. Por ejemplo,

   menorNoSuma [6,1,2]    ==  4
   menorNoSuma [1,2,3,9]  ==  7
   menorNoSuma [5]        ==  1
   menorNoSuma [1..20]    ==  211
   menorNoSuma [1..10^6]  ==  500000500001

Comprobar con QuickCheck que para todo n,

   menorNoSuma [1..n] == 1 + sum [1..n]

Soluciones

-- 1ª definición
-- =============
 
import Data.List (sort, subsequences)
import Test.QuickCheck
 
menorNoSuma1 :: [Integer] -> Integer
menorNoSuma1 xs =
  head [n | n <- [1..], n `notElem` sumas xs]
 
-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,
--    sumas [1,2,6]  ==  [0,1,2,3,6,7,8,9]
--    sumas [6,1,2]  ==  [0,6,1,7,2,8,3,9]
sumas :: [Integer] -> [Integer]
sumas xs = map sum (subsequences xs)
 
-- 2ª definición
-- =============
 
menorNoSuma2 :: [Integer] -> Integer
menorNoSuma2  = menorNoSumaOrd . reverse . sort 
 
-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como
-- suma de un subconjunto de xs, donde xs es una lista de números
-- naturales ordenada de mayor a menor. Por ejemplo,
--    menorNoSumaOrd [6,2,1]  ==  4
menorNoSumaOrd [] = 1
menorNoSumaOrd (x:xs) | x > y     = y
                      | otherwise = y+x
    where y = menorNoSumaOrd xs
 
-- Comparación de eficiencia
-- =========================
 
--    λ> menorNoSuma1 [1..20]
--    211
--    (20.40 secs, 28,268,746,320 bytes)
--    λ> menorNoSuma2 [1..20]
--    211
--    (0.01 secs, 0 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_menorNoSuma :: (Positive Integer) -> Bool
prop_menorNoSuma (Positive n) =
    menorNoSuma2 [1..n] == 1 + sum [1..n]
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma
--    +++ OK, passed 100 tests.

2016 es un número práctico

Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:

    1 = 1
    2 = 2
    3 = 3
    4 = 4
    5 = 2 + 3
    6 = 6
    7 = 1 + 6
    8 = 2 + 6
    9 = 3 + 6
   10 = 4 + 6
   11 = 1 + 4 + 6

En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.

Definir la función

   esPractico :: Integer -> Bool

tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,

   esPractico 12                                      ==  True
   esPractico 14                                      ==  False
   esPractico 2016                                    ==  True
   esPractico 42535295865117307932921825928971026432  ==  True

Soluciones

import Data.List (genericLength, group, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple
 
-- 1ª definición
-- =============
 
esPractico1 :: Integer -> Bool
esPractico1 n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]
 
-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]
 
-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))
 
-- 2ª definición
-- =============
 
esPractico2 :: Integer -> Bool
esPractico2 n = all (esSumable (divisores n)) [1..n-1]
 
-- (esSumable xs n) se verifica si n se puede escribir como una suma de
-- elementos distintos de la lista creciente xs. Por ejemplo,
--    esSumable [1,2,7] 8  ==  True
--    esSumable [1,2,7] 6  ==  False
--    esSumable [1,2,7] 4  ==  False
--    esSumable [1,2,7] 2  ==  True
--    esSumable [1,2,7] 0  ==  True
esSumable :: [Integer] -> Integer -> Bool
esSumable _ 0  = True
esSumable [] _ = False
esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)
 
-- 3ª definición
-- =============
 
-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2
-- es práctico syss para su factorización prima
--    n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)
-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que
--                         1+e(j) 
--                i-1  p(j)       - 1
--    p(i) <= 1 +  ∏  ----------------
--                j=1     p(j) - 1
 
esPractico3 :: Integer -> Bool
esPractico3 1 = True
esPractico3 n = 
    x == 2 &&
    and [p <= 1 + c | (p,c) <- zip bases cotas]
    where xss       = factorizacion n
          (x:bases) = map fst xss
          cotas     = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]
 
-- (factorizacion n) es la factorización de n. Por ejemplo, 
--    factorizacion  600  ==  [(2,3),(3,1),(5,2)]
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
    [(head xs,genericLength xs) | xs <- group (primeFactors n)]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length [n | n <- [1..400], esPractico1 n]
--    92
--    (40.21 secs, 8,378,539,464 bytes)
--    λ> length [n | n <- [1..400], esPractico2 n]
--    92
--    (8.29 secs, 1,109,669,760 bytes)
--    λ> length [n | n <- [1..400], esPractico3 n]
--    92
--    (0.02 secs, 0 bytes)

Referencias

Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.

Otras referencias