Ir al contenido principal

Listas con suma dada


Definir la función

conSuma :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]

tal que (conSuma xs yss) es la lista de los vectores de xss cuya suma vectorial es xs. Por ejemplo,

λ> conSuma [9,10,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]
[[[4,7,3],[5,3,9]],[[4,7,3],[3,1,4],[2,2,5]]]
λ> conSuma [9,11,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]
[]
λ> length (conSuma [5,5,5] (replicate 70 [1,1,1]))
12103014

Soluciones

import Data.List (sort, subsequences, transpose)
import qualified Data.Map.Strict as M
import Test.Hspec (Spec, describe, hspec, it, shouldBe)
import Test.QuickCheck

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

conSuma1 :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma1 xs yss = [zss | zss <- subsequences yss, suma1 zss == xs]

-- (suma xss) es la suma de las listas xs. Por ejemplo,
--    suma [[4,7,3],[3,1,4],[2,2,5]]  ==  [9,10,12
suma1 :: Num a => [[a]] -> [a]
suma1 []       = []
suma1 [xs]     = xs
suma1 (xs:xss) = zipWith (+) xs (suma1 xss)

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

conSuma2 :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma2 xs yss = [zss | zss <- subsequences yss, suma2 zss == xs]

suma2 :: Num a => [[a]] -> [a]
suma2 = map sum . transpose

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

conSuma3 :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma3 xs =
  filter ((xs==) . foldr1 (zipWith (+))) . tail . subsequences

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

conSuma4 :: (Ord a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma4 _  [] = []
conSuma4 xs [ys] | xs == ys  = [[ys]]
                 | otherwise = []
conSuma4 xs (ys:yss)
    | xs == ys    = [ys] : conSuma4 xs yss
    | menor ys xs = [ys:zs | zs <- conSuma4 (menos xs ys) yss] ++
                    conSuma4 xs yss
    | otherwise   = conSuma4 xs yss
    where menor as bs = and (zipWith (<=) as bs)
          menos       = zipWith (-)

-- 5ª solución
-- ===========

conSuma5 :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma5 xs []
  | all (==0) xs = [[]]
  | otherwise    = []
conSuma5 xs (y:ys) =
  map (y:) (conSuma5 (zipWith (-) xs y) ys) ++ conSuma5 xs ys

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

conSuma6 :: (Ord a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma6 objetivo yss = M.findWithDefault [] objetivo tablaFinal
  where
    -- El vector cero inicial (ej: [0,0,0])
    cero = replicate (length objetivo) 0

    -- Estado inicial: La suma cero se consigue con una lista vacía [[]]
    tablaInicial = M.singleton cero [[]]

    -- Procesamos cada vector uno a uno actualizando el mapa de sumas logradas
    tablaFinal = foldl actualizarTabla tablaInicial yss

    actualizarTabla tablaActual v =
      -- Combinamos la tabla actual con las nuevas sumas generadas al añadir 'v'
      M.unionWith (++) tablaActual nuevasSumas
      where
        nuevasSumas = M.fromListWith (++)
          [ (zipWith (+) s v, map (v:) caminos)
          | (s, caminos) <- M.toList tablaActual ]

-- Verificación
-- ============

verifica :: IO ()
verifica = hspec spec

specG :: ([Int] -> [[Int]] -> [[[Int]]]) -> Spec
specG conSuma = do
  it "e1" $
    sort (map sort (conSuma [9,10,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]))
    `shouldBe` [[[2,2,5],[3,1,4],[4,7,3]],[[4,7,3],[5,3,9]]]
  it "e2" $
    conSuma [9,11,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]
    `shouldBe` []

spec :: Spec
spec = do
  describe "def. 1" $ specG conSuma1
  describe "def. 2" $ specG conSuma2
  describe "def. 3" $ specG conSuma3
  describe "def. 4" $ specG conSuma4
  describe "def. 5" $ specG conSuma5
  describe "def. 6" $ specG conSuma6

-- La verificación es
--    λ> verifica
--    12 examples, 0 failures

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

-- -- Genera una matriz. Por ejemplo,
-- --    λ> generate genMatriz
-- --    [[15,22],[29,12],[-28,-1]]
-- genMatriz :: Gen [[Int]]
-- genMatriz = do
--   m <- choose (1, 20)
--   n <- choose (1, 20)
--   vectorOf m (vectorOf n (arbitrary :: Gen Int))
--
-- -- La propiedad es
-- prop_equivalencia :: Property
-- prop_equivalencia = forAll genMatriz $ \xss ->
--   all (== conSuma1 xss)
--       [conSuma2 xss,
--        conSuma4 xss,
--        conSuma5 xss,
--        conSuma6 xss,
--        conSuma7 xss]

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

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

-- La comparación es
--    λ> :set +s
--    λ> length (conSuma1 [5,5,5] (replicate 20 [1,1,1]))
--    15504
--    (3.00 secs, 2,927,447,376 bytes)
--    λ> length (conSuma2 [5,5,5] (replicate 20 [1,1,1]))
--    15504
--    (1.02 secs, 2,327,481,752 bytes)
--    λ> length (conSuma3 [5,5,5] (replicate 20 [1,1,1]))
--    15504
--    (0.47 secs, 1,668,908,664 bytes)
--    λ> length (conSuma4 [5,5,5] (replicate 20 [1,1,1]))
--    15504
--    (0.04 secs, 28,411,608 bytes)
--    λ> length (conSuma5 [5,5,5] (replicate 20 [1,1,1]))
--    15504
--    (1.32 secs, 1,051,793,824 bytes)
--    λ> length (conSuma6 [5,5,5] (replicate 20 [1,1,1]))
--    15504
--    (0.02 secs, 5,678,848 bytes)
--
--    λ> length (conSuma3 [5,5,5] (replicate 22 [1,1,1]))
--    26334
--    (1.92 secs, 7,308,667,976 bytes)
--    λ> length (conSuma4 [5,5,5] (replicate 22 [1,1,1]))
--    26334
--    (0.06 secs, 45,888,808 bytes)
--    λ> length (conSuma6 [5,5,5] (replicate 22 [1,1,1]))
--    26334
--    (0.02 secs, 9,516,680 bytes)
--
--    λ> length (conSuma4 [5,5,5] (replicate 45 [1,1,1]))
--    1221759
--    (2.29 secs, 1,721,519,448 bytes)
--    λ> length (conSuma6 [5,5,5] (replicate 45 [1,1,1]))
--    1221759
--    (0.35 secs, 647,077,000 bytes)