Cleanup combination accessing code

src/Multiset.hs

@@ -4,15 +4,42 @@ import qualified Data.Map.Strict as M
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import Control.Monad
-import Data.List (subsequences)
 
-powlistN :: Int -> [a] ->[[a]]
-powlistN _ [] = [[]]
-powlistN n (x:xs) 
+-- naive solution
+powlistUpToN' :: Int -> [a] ->[[a]]
+powlistUpToN' _ [] = [[]]
+powlistUpToN' n (x:xs) 
     | n <=0     = [[]]
-    | otherwise = ((x:) <$> powlistN (n-1) xs) ++ powlistN n xs
-powlistN' :: Int -> [a] ->[[a]]
-powlistN' k = filter ( ( k >= ) . length ) . subsequences
+    | otherwise = ((x:) <$> powlistUpToN' (n-1) xs) ++ powlistUpToN' n xs
+
+-- adapted from
+-- https://stackoverflow.com/questions/21265454/subsequences-of-length-n-from-list-performance/59932616#59932616
+-- uses dynamic programming: the important part is the use of "next" twice
+-- there is a (probably) faster SO answer that produces power lists of size
+-- exactly N, but that answer is harder to adapt
+powlistUpToN :: Int -> [a] -> [[a]]
+powlistUpToN n xs = 
+    let l = length xs
+    in if n > l then [] else concat $ drop (l-n) (subseqsBySize xs)
+  where
+    subseqsBySize [] = [[[]]]
+    subseqsBySize (y:ys) =
+        let next = subseqsBySize ys
+        in zipWith (++) ([]:next) (map (map (y:)) next ++ [[]])
+-- this is the code producing all exactly n length sublists
+combinationsOf :: Int -> [a] -> [[a]]
+combinationsOf 1 as        = map pure as
+combinationsOf k' as@(_:xs) = run (l-1) (k'-1) as $ combinationsOf (k'-1) xs
+  where
+    l = length as
+    run :: Int -> Int -> [a] -> [[a]] -> [[a]]
+    run n k ys cs 
+        | n == k    = map (ys ++) cs
+        | otherwise = map (q:) cs ++ run (n-1) k qs (drop dc cs)
+      where
+        (q:qs) = take (n-k+1) ys
+        dc     = product [(n-k+1)..(n-1)] `div` product [1..(k-1)]
+combinationsOf _ [] = []
 
 -- exponential, so don't use it on long lists
 powlist :: [a] -> [[a]]