1
\$\begingroup\$

Utility to generate sequences of predetermined addenda that add up to a given number. There is also a function for orderly printing and one for converting list of lists in sequence of sequences.

The answer that Gurkenglas gave invites me to specify the objective that I set myself by defining these functions. The field of applications that I had in mind is music theory. I teach my students elements of analysis and musical composition. A fundamental dimension of music is the duration of the sounds. A rhythm is a particular sequence of durations, which in music are sometimes expressed as numerical relationships, sometimes as absolute values (seconds). The durations of a piece of music are normally grouped into "measures", that is, into sequences whose total duration is equal to a predetermined duration. By changing the order in the sequence you can get totally different musical objects. As far as musical analysis is concerned, it is interesting to measure the variety of the rhythms used in relation to the possible rhythms obtained combinatorically starting from the basic durations used in the piece or in a part of it.

From the compositional point of view, the combinatorial generation can be a source of inspiration for unusual rhythms.

To come to what Gurkenglas explained, the function proposed by him does not produce the results of mine since the lists or sequences of addends do not take into account the constraint of the order.

For instance:

ex3 (addendumSequences 10 (toSeqs [[3,1],[7]]) (fromList [2,4,3])) produce: [3,1,2,2,2] [3,1,2,4] [3,1,3,3] [3,1,4,2] [7,3]

Conversely knapsack 10 [2,4,3] [[3,1],[7]] produce:

[3,7] [4,2,3,1] [2,4,3,1] [3,3,3,1] [2,2,2,3,1]

In this case, not only the order of the elements is different, but the constraint that the sequences must start with [3,1] or [7], which is a request that has a musical sense, is absent. Just this problem has induced me to prefer the Sequence type to List.

(About the signature: I only reported what GHCi deduced from the functions.)

import Prelude hiding (null)
import Data.Sequence (Seq)
import Data.Sequence
import Data.Foldable (fold,toList)

import Data.Ratio -- library needed only for the example 

-- The numbers must all be positive
addendumSequences :: (Ord a, Num a) => a -> Seq (Seq a) -> Seq a -> Seq (Seq a) 
addendumSequences n bases addenda
  | null bases && null addenda = empty
  | null addenda = snd $ pruneAndStore n bases empty
  | null bases  = go n (fmap singleton addenda) addenda empty
  | otherwise      = go n bases addenda empty
    where
    go n bases addenda ok_bases
      | null bases = ok_bases
      | otherwise = let bases' = combinesBasesAndAddends bases addenda
                        (candidate_bases,ok_bases') = pruneAndStore n bases' ok_bases
                    in if null candidate_bases
                       then ok_bases'
                       else go n candidate_bases addenda ok_bases'

combinesBasesAndAddends
  :: (Monoid (f (Seq a)), Foldable t, Functor f) =>
     t (Seq a) -> f a -> f (Seq a)
combinesBasesAndAddends bases addenda =
    fold $ foldr (\base acc -> acc |> fmap (base |>) addenda) empty bases

pruneAndStore
  :: (Ord a, Foldable t1, Foldable t2, Num a) =>
     a -> t1 (t2 a) -> Seq (t2 a) -> (Seq (t2 a), Seq (t2 a))    
pruneAndStore n bases ok_bases =
    foldr (\base (candidate_bases,ok_bases) ->
               let tot = sum base
               in if tot == n
                  then (candidate_bases, base <| ok_bases)
                  else if tot < n
                       then (base <| candidate_bases, ok_bases)
                       else (candidate_bases, ok_bases)
          ) (empty,ok_bases) bases

-- ============================== Utilities ==============================

toSeqs :: [[a]] -> Seq (Seq a)
toSeqs = fromList . fmap fromList

pPrint :: (Ord a, Num a, Show a) => Seq (Seq a) -> IO ()
pPrint = mapM_ print . toList . fmap toList . sort

-- ============================== Examples ==============================

ex1 = pPrint $ addendumSequences 8 empty (fromList [1,2,4,3])

ex2 = pPrint $ addendumSequences (1%1) empty (fromList [1%2,1%3,1%4,1%8])

ex3 = pPrint $ addendumSequences 10 (toSeqs [[3,1],[7]]) (fromList [2,4,3])

ex4 = pPrint $ addendumSequences 2.0 (toSeqs [[1.1],[0.85]]) (fromList [0.25,0.1])
\$\endgroup\$
1
\$\begingroup\$

Order of anything never seems to matter, so I will use [] instead of Seq.

go needs no ok_bases accumulator - see foldl vs foldr.

The type signatures on your helper functions are needlessly general. In fact, I'd just localize the helpers.

knapsack :: (Ord a, Num a) => a -> [a] -> [[a]] -> [[a]]
knapsack n addenda bases
  | null addenda = fst $ prune bases
  | null bases = go $ grow [[]]
  | otherwise  = go bases
    where
      go [] = []
      go bases = let (yes, maybe) = prune $ grow bases
                 in yes ++ go maybe
      grow = concatMap $ \base -> map (:base) addenda
      prune = foldr partitioner (empty, empty)
      partitioner base = case compare n $ sum base of
        EQ -> first (base :)
        GT -> second (base :)
        LT -> id

| null bases = go $ grow [[]] can go away once the user recognizes that an empty list of starting bases means no solutions, while he probably wants an empty starting base. (Are you sure we shouldn't prune the singletons?)

| null addenda = fst $ prune bases <- when there's nothing to put in, you check whether the starting bases are already enough and then give up. Shouldn't you then always check whether the starting bases are already enough before involving addenda?

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.