Как обобщить выбор подмножеств размера `n` из альтернатив` m` с состоянием между выборами в Haskell

Question

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

Загадку можно найти по адресу https://www.think-maths.co.uk/uniquedistance. Не читайте дальше, если хотите решить головоломку самостоятельно без спойлеров. Если вы просто хотите помочь мне решить имеющуюся проблему программирования Haskell, вам не нужно тратить время на изучение головоломки.

То, что я пытаюсь сделать в моем решении, показанном ниже , заключается в поиске подмножеств размера n из пула n^2 различных опций, так что некоторая двоичная функция metric дает уникальные результаты для всех пар опций из выбранного подмножества.

Сначала я написал решение в соответствии со строками

combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations _ [] = []
combinations n xs = [ a:rec | (a:as) <- tails xs, rec <- combinations (pred n) as ]

, которое дало мне все возможные подмножества, а затем проверило, удовлетворяет ли какое-либо отдельное подмножество требованию уникальности данного metric для всех возможных пар, выбранных из подмножество с использованием

import qualified Data.IntSet as IS

check :: [a] -> Bool
check = noDupes . metrics
  where metrics ps = [ metric a b | (a:bs) <- tails ps, b <- bs ]
        noDupes = go IS.empty
        go _ [] = True
        go s (x:xs) | IS.member x s = False
                    | otherwise = go (IS.insert x s) xs

Отсюда filter check (combinations n) даст мне правильные решения для любого заданного n. Однако для повышения производительности я хотел изменить свои вычисления таким образом, чтобы вместо того, чтобы сначала создавать все подмножества размера n и только потом проверять, выполняется ли мое ограничение для всего подмножества, вместо этого он отбрасывал бы подмножества меньше, чем n элементов ранее включено, что позволяет мне вычислять дорогостоящие metric реже.

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

import qualified Data.IntSet as IS
import Data.Maybe
import Control.Monad
import Data.List
import Linear.V2 (V2(..))

-- euclidean distance squared
metric :: V2 Int -> V2 Int -> Int
metric (V2 x1 y1) (V2 x2 y2) = ((x1-x2)^2) + ((y1-y2)^2)

-- metric of a new candidate point to all previous points
metrics p = map (metric p)

-- check if the previously seen set of metrics are compatible with the metrics
-- of a new candidate. Nothing if they're not, and Just the union of the
-- previous and new metrics.
checkCompatibility :: IS.IntSet -> [Int] -> Maybe IS.IntSet
checkCompatibility s [] = Just s
checkCompatibility s (x:xs) | IS.member x s = Nothing
                            | otherwise = checkCompatibility (IS.insert x s) xs

-- all combinations of choosing 1 points from the input
combinations1 :: [V2 Int] -> [[V2 Int]]
combinations1 xs = do
  (a:bs) <- tails xs
  let ret = [a]

  return ret

-- all combinations of choosing 2 points from the input
combinations2 :: [V2 Int] -> [[V2 Int]]
combinations2 xs = do
  (a:bs) <- tails xs
  let ret = [a]

  (b:cs) <- tails bs
  let sset = checkCompatibility IS.empty (metrics b ret)
  guard (maybe False (not . IS.null) sset)
  let ret' = b:ret

  return (reverse ret')

-- all combinations of choosing 3 points from the input, where the "metric" between any pair of points is unique
combinations3 :: [V2 Int] -> [[V2 Int]]
combinations3 xs = do
  (a:bs) <- tails xs
  let ret = [a]

  (b:cs) <- tails bs
  let sset = checkCompatibility IS.empty (metrics b ret)
  guard (maybe False (not . IS.null) sset)
  let ret' = b:ret

  (c:ds) <- tails cs
  let sset' = checkCompatibility (fromJust sset) (metrics c ret')
  guard (maybe False (not . IS.null) sset')
  let ret'' = c:ret'

  return (reverse ret'')

-- all combinations of choosing 4 points from the input, where the "metric" between any pair of points is unique
combinations4 :: [V2 Int] -> [[V2 Int]]
combinations4 xs = do
  (a:bs) <- tails xs
  let ret = [a]

  (b:cs) <- tails bs
  let sset = checkCompatibility IS.empty (metrics b ret)
  guard (maybe False (not . IS.null) sset)
  let ret' = b:ret

  (c:ds) <- tails cs
  let sset' = checkCompatibility (fromJust sset) (metrics c ret')
  guard (maybe False (not . IS.null) sset')
  let ret'' = c:ret'

  (d:es) <- tails ds
  let sset'' = checkCompatibility (fromJust sset') (metrics d ret'')
  guard (maybe False (not . IS.null) sset'')
  let ret''' = d:ret''

  return (reverse ret''')

combinations5 :: [V2 Int] -> [[V2 Int]]
combinations5 xs = do
  (a:bs) <- tails xs
  let ret = [a]

  (b:cs) <- tails bs
  let sset = checkCompatibility IS.empty (metrics b ret)
  guard (maybe False (not . IS.null) sset)
  let ret' = b:ret

  (c:ds) <- tails cs
  let sset' = checkCompatibility (fromJust sset) (metrics c ret')
  guard (maybe False (not . IS.null) sset')
  let ret'' = c:ret'

  (d:es) <- tails ds
  let sset'' = checkCompatibility (fromJust sset') (metrics d ret'')
  guard (maybe False (not . IS.null) sset'')
  let ret''' = d:ret''

  (e:fs) <- tails es
  let sset''' = checkCompatibility (fromJust sset'') (metrics e ret''')
  guard (maybe False (not . IS.null) sset''')
  let ret'''' = e:ret'''

  return (reverse ret'''')

combinations6 :: [V2 Int] -> [[V2 Int]]
combinations6 xs = do
  (a:bs) <- tails xs
  let ret = [a]

  (b:cs) <- tails bs
  let sset = checkCompatibility IS.empty (metrics b ret)
  guard (maybe False (not . IS.null) sset)
  let ret' = b:ret

  (c:ds) <- tails cs
  let sset' = checkCompatibility (fromJust sset) (metrics c ret')
  guard (maybe False (not . IS.null) sset')
  let ret'' = c:ret'

  (d:es) <- tails ds
  let sset'' = checkCompatibility (fromJust sset') (metrics d ret'')
  guard (maybe False (not . IS.null) sset'')
  let ret''' = d:ret''

  (e:fs) <- tails es
  let sset''' = checkCompatibility (fromJust sset'') (metrics e ret''')
  guard (maybe False (not . IS.null) sset''')
  let ret'''' = e:ret'''

  (f:gs) <- tails fs
  let sset'''' = checkCompatibility (fromJust sset''') (metrics f ret'''')
  guard (maybe False (not . IS.null) sset'''')
  let ret''''' = f:ret''''

  return (reverse ret''''')

bruteforce :: Int -> ([V2 Int] -> [[V2 Int]]) -> [[V2 Int]]
bruteforce n f = f positions
  where positions = [ V2 x y | x <- [0..pred n], y <- [0..pred n] ]

Обратите внимание как различные реализации для разных значений n чрезвычайно похожи так же, как и моя исходная функция combinations сверху, если бы я не написал ее рекурсивно с параметром n.

Я пытаюсь понять, как параметризовать свои функции combinations1, combinations2, combinations3 и т. Д., Например t что мне не нужно утомительно писать решение для каждого значения n.

-- all combinations of choosing n points from the input, where the "metric" between any pair of points is unique
combinationsN :: Int -> [V2 Int] -> [[V2 Int]]
combinationsN 0 _ = [[]]
combinationsN _ [] = []
combinationsN n xs = undefined

В образовательных целях, я думаю, меня в основном будет интересовать, как выполнить sh это вручную привязка состояния между шагами, чтобы позже я мог уточнить это до решения, использующего Control.Monad.State, но мне также было бы интересно увидеть другие подходы для поддержания состояния между шагами.

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

Спасибо!

Answer 1

Ну, идея у вас есть. Увеличьте от IntSet до combinations. Вы можете сделать это, добавив дополнительные параметры к combinations:

solve :: Int -> [V2 Int] -> [[V2 Int]]
solve n xs = go n xs IS.empty []
  where go :: Int -> [V2 Int] -> IntSet -> [V2 Int] -> [[V2 Int]]
        go 0 _  _       seen = [reverse seen]
        go n xs metrics seen = [ rec
                               | (a : as) <- tails xs
                               , metrics' <- maybeToList $ addMetrics a seen metrics
                               , rec <- go (pred n) as metrics' (a : seen)]
        addMetrics :: V2 Int -> [V2 Int] -> IntSet -> Maybe IntSet
        addMetrics _ [] i = Just i
        addMetrics a (b : bs) i = do
           i' <- addMetrics a bs i
           let m = metric a b
           guard $ m `IS.notMember` i'
           return $ IS.insert m i'

Это преобразование очень распространено: вы сохраняете некоторые дополнительные данные во внутренней, вероятно, рекурсивной функции, а затем выбрасываете их, когда вы сделано. Теперь, чтобы обобщить: V2 Int может стать a, IntSet может стать s, addMetrics и IS.empty стать параметрами, а Maybe обобщается до [].

-- realized that it's not really "pruning" if we're allowing [s] instead of just Maybe s, but meh
pruningCombs :: s -> (a -> [a] -> s -> [s]) -> Int -> [a] -> [[a]]
pruningCombs e grow n xs = go n xs e []
    where go 0 _  _ seen = [reverse seen]
          go n xs s seen = [ rec
                           | (a : as) <- tails xs
                           , s' <- grow a seen s
                           , rec <- go (pred n) as s' (a : seen)]

solve = pruningCombs IS.empty \a -> execStateT . traverse \b -> do
    let m = metric a b
    guard =<< gets (IS.notMember m)
    modify $ IS.insert m

Это выполняется примерно в то же время, что и combinations6.