Фильтровать подмножества на основе длины? - PullRequest
Новая
       61

Фильтровать подмножества на основе длины?

7 голосов
/ 07 октября 2019

Попытка извлечь подмножества с длиной k, используя фильтр. Не знаете, как к нему подойти? В списке есть 100 элементов . 

subsets :: [a] -> [[a]]
subsets [] = [[]]
subsets (x:xs) = [zs | ys <- subsets xs, zs <- [ys, (x:ys)]]

Если я использую фильтр, то, как я и думал, это будет: 

filter (length(3)) subsets [1,2,3,4,5]

Но я, вероятно, ошибаюсь. Если есть другой подход, а не фильтр? Я новичок в Хаскеле, так что не совсем уверен.

Ответы [ 3 ]

6 голосов
/ 07 октября 2019

Когда я зацикливаюсь на фильтрации, я поднимаюсь на уровень выше и использую foldr, в этом случае будет просто: 

filterLength3 = foldr (\x rs -> if (length x) == 3 then  x : rs else rs) [] 

filterLength3 (subsets [1,2,3,4,5])

output 

=> [[1,2,3],[1,2,4],[1,3,4],[2,3,4],[1,2,5],[1,3,5],[2,3,5],[1,4,5],[2,4,5],[3,4,5]]

С filter должно быть: 

filter ((==3) . length) (subsets [1,2,3,4,5])

=> [[1,2,3],[1,2,4],[1,3,4],[2,3,4],[1,2,5],[1,3,5],[2,3,5],[1,4,5],[2,4,5],[3,4,5]]

Редактировать

После долгих раздумий и с помощью ци изадаю этот вопрос Я смог его решить: 

import Data.List

subsetsOfThree ws = [ [x,y,z] | (x:xs) <- tails ws, (y:ys) <- tails xs, z <- ys ]

несколько примеров: 

  subsetsOfThree [1..3]
=> [[1,2,3]]
   subsetsOfThree [1..4]
=> [[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
   subsetsOfThree [1..5]
=> [[1,2,3],[1,2,4],[1,2,5],[1,3,4],[1,3,5],[1,4,5],[2,3,4],[2,3,5],[2,4,5],[3,4,5]]
   subsetsOfThree [1..10]
=> [[1,2,3],[1,2,4],[1,2,5],[1,2,6],[1,2,7],[1,2,8],[1,2,9],[1,2,10],[1,3,4],[1,3,5],[1,3,6],[1,3,7],[1,3,8],[1,3,9],[1,3,10],[1,4,5],[1,4,6],[1,4,7],[1,4,8],[1,4,9],[1,4,10],[1,5,6],[1,5,7],[1,5,8],[1,5,9],[1,5,10],[1,6,7],[1,6,8],[1,6,9],[1,6,10],[1,7,8],[1,7,9],[1,7,10],[1,8,9],[1,8,10],[1,9,10],[2,3,4],[2,3,5],[2,3,6],[2,3,7],[2,3,8],[2,3,9],[2,3,10],[2,4,5],[2,4,6],[2,4,7],[2,4,8],[2,4,9],[2,4,10],[2,5,6],[2,5,7],[2,5,8],[2,5,9],[2,5,10],[2,6,7],[2,6,8],[2,6,9],[2,6,10],[2,7,8],[2,7,9],[2,7,10],[2,8,9],[2,8,10],[2,9,10],[3,4,5],[3,4,6],[3,4,7],[3,4,8],[3,4,9],[3,4,10],[3,5,6],[3,5,7],[3,5,8],[3,5,9],[3,5,10],[3,6,7],[3,6,8],[3,6,9],[3,6,10],[3,7,8],[3,7,9],[3,7,10],[3,8,9],[3,8,10],[3,9,10],[4,5,6],[4,5,7],[4,5,8],[4,5,9],[4,5,10],[4,6,7],[4,6,8],[4,6,9],[4,6,10],[4,7,8],[4,7,9],[4,7,10],[4,8,9],[4,8,10],[4,9,10],[5,6,7],[5,6,8],[5,6,9],[5,6,10],[5,7,8],[5,7,9],[5,7,10],[5,8,9],[5,8,10],[5,9,10],[6,7,8],[6,7,9],[6,7,10],[6,8,9],[6,8,10],[6,9,10],[7,8,9],[7,8,10],[7,9,10],[8,9,10]]

И теперь вы можете сделать своего монстра маленькой марионеткой:

  length $ subsetsOfThree [1..10]
=> 120
   length $ subsetsOfThree [1..20]
=> 1140
   length $ subsetsOfThree [1..50]
=> 19600
   length $ subsetsOfThree [1..100]
=> 161700
length $ subsetsOfThree [1..500]
=> 20708500
2 голосов
/ 14 октября 2019

Количество подмножеств для списка из 100 элементов составляет около 2 100 ≃ 1,26 * 10 30 , действительно огромное количество. Таким образом, подход filter не кажется практичным. Проблема должна быть решена путем манипулирования списками, содержащими всего несколько чисел от 1 до 100.

Таким образом, мы стремимся написать функцию с именем kSubsets, которая возвращает список всех подмножеств мощности k: 

kSubsets :: Int -> [a] -> [[a]]

где k - первый аргумент.

Решение, основанное на рекурсивной обработке списка:

Возможный способ создания функциональности kSubsets состоит в использовании вспомогательной функции kIndexSubsets, которая вычисляет основанные на нулях индексы элементоввместо самих элементов. Функция kIndexSubsets может быть написана рекурсивно.

В этом случае функция kSubsets, по сути, является оберткой, которая отображает индексы элементов на фактические элементы списка. Это дает следующий код: 

import qualified  Data.Map    as  M
import qualified  Data.Maybe  as  Mb
import qualified  Data.List   as  L

kIndexSubsets :: Int -> Int -> [[Int]]
kIndexSubsets 0 _  = [[]]
kIndexSubsets k nn =
    -- first element chosen must leave room for (k-1) elements after itself
    let lastChoice = if (k > nn)
                     then error "k above nn in kIndexSubsets"
                     else (nn -k)
        choices = [0 .. lastChoice]
        -- for each possible first element, recursively compute
        -- all the possible tails:
        fn hd   = let tails1 = kIndexSubsets (k-1) (nn - (hd+1))
                      -- rebase subsequent indexes:
                      tails2 = map (map (\x -> (x+hd+1))) tails1
                  in  -- add new leftmost element:
                      map  (\ls -> hd:ls)  tails2
    in
        concatMap fn choices


-- return the list of all subsets of ls having k elements:
kSubsets :: Int -> [a] -> [[a]]
kSubsets 0 _  = [[]]
kSubsets k ls = 
    let  nn = length ls
         -- need a map for fast access to elements of ls:
         ma = M.fromList $ zip [0..] ls
         extractor ix = Mb.fromJust(M.lookup ix ma)
         indexSubSets = kIndexSubsets k nn
    in
         map  (map extractor)  indexSubSets

Теперь мы можем проверить нашу функцию kSubsets. Это включает проверку того, что длина результирующего списка вывода соответствует классической формуле комбинаторики, то есть n! / (K! * (Nk)!), Где n - длина списка ввода. 

*Main> let ls = "ABCDEFGH"
*Main> kSubsets 0 ls
[""]
*Main> kSubsets 1 ls
["A","B","C","D","E","F","G","H"]

*Main> kSubsets 2 ls
["AB","AC","AD","AE","AF","AG","AH","BC","BD","BE","BF","BG","BH","CD","CE","CF","CG","CH","DE","DF","DG","DH","EF","EG","EH","FG","FH","GH"]

*Main> kSubsets 3 ls
["ABC","ABD","ABE","ABF","ABG","ABH","ACD","ACE","ACF","ACG","ACH","ADE","ADF","ADG","ADH","AEF","AEG","AEH","AFG","AFH","AGH","BCD","BCE","BCF","BCG","BCH","BDE","BDF","BDG","BDH","BEF","BEG","BEH","BFG","BFH","BGH","CDE","CDF","CDG","CDH","CEF","CEG","CEH","CFG","CFH","CGH","DEF","DEG","DEH","DFG","DFH","DGH","EFG","EFH","EGH","FGH"]

*Main> 
*Main> kSubsets 7 ls
["ABCDEFG","ABCDEFH","ABCDEGH","ABCDFGH","ABCEFGH","ABDEFGH","ACDEFGH","BCDEFGH"]
*Main> 
*Main> kSubsets 8 ls
["ABCDEFGH"]
*Main> 
*Main> 
*Main> div ((100*99*98)::Integer)  ((2*3)::Integer)
161700
*Main> 
*Main> length $ kSubsets 3 [ 1 .. 100 ]
161700
*Main> 
*Main> div ((100*99*98*97*96)::Integer)  ((2*3*4*5)::Integer)
75287520
*Main> length $ kSubsets 5 [ 1 .. 100 ]
75287520
*Main>

Оценка kSubsets 3 [ 1 .. 100 ] занимает менее 50 мсек на обычной ванильной машине x86-64 Linux.

Альтернативное решение на основе конечного автомата:

(перевернутый) список выбранныхза индексы принимается состояние автомата, и мы продвигаем состояние шаг за шагом, пока это больше не станет возможным, и на этом этапе список подсписков завершен.

В основном, если есть место дляпередвиньте самый правый индекс, хорошо, в противном случае мы повторяем, чтобы продвинуть остальную часть списка, а затем переместим самый правый указатель как можно дальше влево.

Подход дает этот альтернативный исходный код для kIndexSubsets, в которомключевым элементом является ksAdvance пошаговая функция: 

import qualified  Data.Map    as  M
import qualified  Data.Maybe  as  Mb
import qualified  Data.List   as  L


-- works on the *reversed* list of chosen indexes:
ksAdvance :: Int -> Int -> Maybe [Int] -> Maybe [Int]
ksAdvance k nn Nothing        = Nothing
ksAdvance k nn (Just [])      = Nothing
ksAdvance k nn (Just (h:rls)) =
    if (h == (nn-1))
    then -- cannot advance rightmost index, so must recurse
        let mbols2 = ksAdvance (k-1) (nn-1) (Just rls)
        in
            case mbols2 of
            Nothing   -> Nothing
            Just ols2 -> let  y = ((head ols2)+1)  in  Just (y:ols2)
    else -- just advance rightmost index:
        Just ((h+1):rls)


kIndexSubsets :: Int -> Int -> [[Int]]
kIndexSubsets 0 _  = [[]]
kIndexSubsets k nn =
    let startList = reverse  $  [ 0 .. (k-1) ]
        cutList = takeWhile  Mb.isJust
        mbls    = cutList $ iterate  (ksAdvance k nn)  (Just startList)
    in
        map  (reverse . Mb.fromJust)  mbls

Этот алгоритм кажется менее требовательным к памяти и более быстрым, чем первый.

Использование этой маn программа для быстрого теста производительности, с подмножествами из 5 элементов из 100, генерирующими 75287520 подмножеств: 

kSubsets :: Int -> [a] -> [[a]]
kSubsets 0 _  = [[]]
kSubsets k ls = 
    let  nn = length ls
         -- need a map for fast access to elements of ls:
         ma = M.fromList $ zip [0..] ls
         eltFromIndex = \ix -> Mb.fromJust (M.lookup ix ma)
         indexSubSets = kIndexSubsets k nn
    in
         map  (map eltFromIndex)  indexSubSets


main = do
    let nn  = 100
    let  k  = 5
    let ls  = [ 1 .. nn ]::[Int]
    let str = "count of " ++ (show k) ++ " out of " ++ (show nn) ++
          " elements subsets = " ++ (show $ length (kSubsets k ls))
    putStrLn $ str

Улучшена производительность памяти: 

$ /usr/bin/time ./kSubsets03.x +RTS -s
    count of 5 out of 100 elements subsets = 75287520
       4,529,861,272 bytes allocated in the heap
             623,240 bytes copied during GC
              44,504 bytes maximum residency (2 sample(s))
              29,224 bytes maximum slop
                   2 MB total memory in use (0 MB lost due to fragmentation)
 ...
      Productivity  98.4% of total user, 98.5% of total elapsed

    0.70user 0.00system 0:00.72elapsed 99%CPU (0avgtext+0avgdata 4724maxresident)k
    0inputs+0outputs (0major+436minor)pagefaults 0swaps
$

Пока не так хорошо, как Fortranно уже близко: -)

2 голосов
/ 10 октября 2019

Вот общее решение для подмножеств длины n, не использующих фильтр.

Если наш начальный список равен x:xs, обратите внимание, что мы можем разделить эти подмножества на те, которые содержат x, и те, которые не содержат x. Это показывает нам хорошую рекурсивную структуру;первый раздел x добавляется к каждому подмножеству длины (n-1) xs, а второй - только подмножеству длины n xs. 

subsetsOfLength n (x:xs) = map (x:) (subsetsOfLength (n-1) xs) ++ subsetsOfLength n xs

Все, что нам нужноБазовые случаи. Существует одно подмножество длины 0, и ни одно подмножество не больше исходного: 

subsets 0 _  = [[]]
subsets _ [] = []

Прикрепите эти базы выше рекурсивного шага и добавьте на него соответствующую сигнатуру типа, и все готово. 

λ> subsetsOfLength 3 [1..5]
[[1,2,3],[1,2,4],[1,2,5],[1,3,4],[1,3,5],[1,4,5],[2,3,4],[2,3,5],[2,4,5],[3,4,5]]

λ> length $ subsetsOfLength 5 [1..100]
252

Приятно.

Будь осторожен. (++) медленно;если во время компиляции вы знаете, какую длину вы будете использовать, подход tails Дамиана Рафаэля Латтенеро может быть более производительным. Хотя не совсем уверен в этом. Кроме того, в зависимости от значений, вы могли бы хорошо поменять местами операнды (++). Я еще не сделал математику.

...