Ir al contenido principal

Descomposiciones como sumas de n sumandos


Definir la función

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

tal que (sumas n ys x) es la lista de las descomposiciones de x como sumas de n sumandos en la lista ys. Por ejemplo,

sumas 2 [1,2] 3     == [[1,2]]
sumas 2 [-1] (-2)   == [[-1,-1]]
sumas 2 [-1,3,-1] 2 == [[-1,3]]
sumas 2 [1,2] 4     == [[2,2]]
sumas 2 [1,2] 5     == []
sumas 3 [1,2] 5     == [[1,2,2]]
sumas 3 [1,2] 6     == [[2,2,2]]
sumas 2 [1,2,5] 6   == [[1,5]]
sumas 2 [1,2,3,5] 4 == [[1,3],[2,2]]
sumas 2 [1..5] 6    == [[1,5],[2,4],[3,3]]
sumas 3 [1..5] 7    == [[1,1,5],[1,2,4],[1,3,3],[2,2,3]]
sumas 3 [1..200] 4  == [[1,1,2]]

Soluciones

import Data.List (nub, sort)
import Test.Hspec (Spec, describe, hspec, it, shouldBe)
import Test.QuickCheck

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

sumas1 :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]
sumas1 n ns x =
  [xs | xs <- combinacionesR n (nub (sort ns))
      , sum xs == x]

-- (combinacionesR k xs) es la lista de las combinaciones orden
-- k de los elementos de xs con repeticiones. Por ejemplo,
--    combinacionesR 2 "abc" == ["aa","ab","ac","bb","bc","cc"]
--    combinacionesR 3 "bc"  == ["bbb","bbc","bcc","ccc"]
--    combinacionesR 3 "abc" == ["aaa","aab","aac","abb","abc","acc",
--                               "bbb","bbc","bcc","ccc"]
combinacionesR :: Int -> [a] -> [[a]]
combinacionesR _ [] = []
combinacionesR 0 _  = [[]]
combinacionesR k (x:xs) =
  [x:ys | ys <- combinacionesR (k-1) (x:xs)] ++ combinacionesR k xs

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

sumas2 :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]
sumas2 n ns x = nub (sumasAux n ns x)
  where sumasAux :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]
        sumasAux 1 ns' x'
          | x' `elem` ns' = [[x']]
          | otherwise   = []
        sumasAux n' ns' x' =
          concat [[y:zs | zs <- sumasAux (n'-1) ns' (x'-y)
                        , y <= head zs]
                 | y <- ns']

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

sumas3 :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]
sumas3 n ns x = nub $ aux n (sort ns) x
  where aux 0 _ _  = []
        aux _ [] _ = []
        aux 1 ys x' | x' `elem` ys = [[x']]
                    | otherwise   = []
        aux n' (y:ys) x' = aux n' ys x' ++
                           map (y:) (aux (n' - 1) (y : ys) (x' - y))

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

verifica :: IO ()
verifica = hspec spec

specG :: (Int -> [Int] -> Int -> [[Int]]) -> Spec
specG sumas = do
  it "e1" $
    sumas' 2 [1,2] 3     `shouldBe` [[1,2]]
  it "e2" $
    sumas' 2 [-1] (-2)   `shouldBe` [[-1,-1]]
  it "e3" $
    sumas' 2 [-1,3,-1] 2 `shouldBe` [[-1,3]]
  it "e4" $
    sumas' 2 [1,2] 4     `shouldBe` [[2,2]]
  it "e5" $
    sumas' 2 [1,2] 5     `shouldBe` []
  it "e6" $
    sumas' 3 [1,2] 5     `shouldBe` [[1,2,2]]
  it "e7" $
    sumas' 3 [1,2] 6     `shouldBe` [[2,2,2]]
  it "e8" $
    sumas' 2 [1,2,5] 6   `shouldBe` [[1,5]]
  it "e9" $
    sumas' 2 [1,2,3,5] 4 `shouldBe` [[1,3],[2,2]]
  it "e10" $
    sumas' 2 [1..5] 6    `shouldBe` [[1,5],[2,4],[3,3]]
  it "e11" $
    sumas' 3 [1..5] 7    `shouldBe` [[1,1,5],[1,2,4],[1,3,3],[2,2,3]]
  where sumas' n ys x = sort (map sort (sumas n ys x))

spec :: Spec
spec = do
  describe "def. 1" $ specG sumas1
  describe "def. 2" $ specG sumas2
  describe "def. 3" $ specG sumas3

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

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

prop_equiv_sumas :: Positive Int -> [Int] -> Int -> Bool
prop_equiv_sumas (Positive n) ns x =
  all (== normal (sumas1 n ns x))
      [ normal (sumas2 n ns x)
      , normal (sumas3 n ns x)]
  where normal = sort . map sort

-- La verificación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_equiv_sumas
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    > sumas1 3 [1..200] 4
--    [[1,1,2]]
--    (2.52 secs, 1,914,773,472 bytes)
--    > sumas2 3 [1..200] 4
--    [[1,1,2]]
--    (0.17 secs, 25,189,688 bytes)
--    λ> sumas3 3 [1..200] 4
--    [[1,1,2]]
--    (0.08 secs, 21,091,368 bytes)