Created
January 26, 2014 21:21
-
-
Save qnikst/8639653 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
У меня возникла следующая задача, не по работе, | |
а обучения ради, в результате которой возник | |
вопрос, а как правильно писать tying the knot | |
алгоритмы. (Сама задача решена, теперь остаётся вопрос как это сделать красиво) | |
Задача: | |
Полная задача это подсчёт очков в го, но она | |
разбита на подзадачи. | |
Текущая задача: Дана сетка в R^n, в узлах сетки или | |
стенка или пустое место, нужно на каждом пустом | |
месте поставить множество (Set) значений, куда | |
можно добраться из этой точки. | |
След задача, в дополнение к множеству записывать значение вычисленное на значений на границах. | |
Решить задачу хочется функционально, т.к. понятно, | |
что существует куча всем известных императивных | |
алгоритмов. | |
При решении этой задачи я столкнулся со следующей | |
проблемой (для простоты рассмотрим 1D), хочется | |
научить хацкель решать системы следующего вида: | |
a = 1 U b | |
b = 2 U a U c | |
c = 3 U b | |
Решение тут очевидное a = b = c = {1,2,3}, | |
но для хацкеля это цикл т.к. a = 1U2Ua... | |
Сразу же возникает идея разбить цикл, это | |
возможно если каждому множеству сопоставить | |
индекс, т.е.: | |
(a' = [1,b'], a = fromList $ concatMap (f [1]) a') | |
(b' = [2,a',c'], b = fromList $ concatMap (f [2] b') | |
Где f рекурсивно проходит выражения отфильтровывая | |
лишние элементы (переданные в параметре) | |
Но у этого решения достаточно высокая цена, для каждой | |
точки мы проводим вычисления заново т.е. заодно и тратится лишняя память, этого можно избежать двумя способами | |
1). Руками заменять b = concatMap.. на b=a, но это работает только для одномерных структур а так же для более сложных выражений | |
2). Делать таблицу кешей, но это тоже не идеальный вариант. | |
Другой вариант это использовать комбинатом неподвижной точки: | |
fa = fix (\f s -> | |
let s' = 1 U fb s | |
in if s == s' then s' else f s') | |
a = fa S.empty | |
Тут (если это сработает) мы вычисляем сразу все выражения, что является большим плюсом. | |
А как вообще обычно решают такие задачи? |
я хотел примерно такое:
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
loeb :: Functor a => a (a x -> x) -> a x
loeb x = fmap (\a -> a (loeb x)) x
data Nested c a
= Leaf [a]
| Inner c [Nested c a]
deriving (Show)
-- | removes only 1 cycle
flatten1 :: Eq c => c -> [Nested c a] -> [a]
flatten1 i xs = concatMap f xs
where
f (Leaf ys) = ys
f (Inner c ys)
| c == i = []
| otherwise = flatten1 i ys
-- | removes arbitrary number of cycles
flatten :: (Ord c) => Set c -> [Nested c a] -> [a]
flatten i xs = concatMap f xs
where
f (Leaf ys) = ys
f (Inner c ys)
| c `Set.member` i = []
| otherwise = flatten (c `Set.insert` i) ys
-- Одномерный пример
test = Map.fromList
[ (1, \m -> ([Leaf [1], g 2 m]))
, (2, \m -> ([Leaf [2], g 1 m, g 3 m]))
, (3, \m -> ([Leaf [3], g 2 m]))
]
where
g i m = Inner i (m Map.! i)
-- Многомерный пример
testE = Map.mapWithKey (\k v -> Set.fromList $ flatten (Set.singleton k) v)
$ loeb test
test2 = Map.fromList
[ ((1,1), \m -> ([Leaf [1], g (1,2) m, g (2,1) m]))
, ((1,2), \m -> ([Leaf [2], g (1,1) m, g (2,2) m]))
, ((2,1), \m -> ([Leaf [3], g (1,1) m, g (2,2) m]))
, ((2,2), \m -> ([Leaf [4], g (2,1) m, g (1,2) m]))
]
where
g i m = Inner i (m Map.! i)
testE2 = Map.mapWithKey (\k v -> Set.fromList $ flatten (Set.singleton k) v)
$ loeb test2
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Ах, да, возвращает вывернутые множества. То есть Map от элемента к множествам, которым этот элемент принадлежит: