Статьи

Haskell: впечатляющая неэффективная находка Союза

 

Большую часть последнего дня я потратил на отладку алгоритма кластеризации, который я написал в рамках курса « Алгоритмы 2» , и в итоге пришел к выводу, что используемая объединением структура данных поиска работает не так, как ожидалось.

В нашем алгоритме мы пытаемся сгруппировать точки, которые «близки» друг к другу, и структура данных особенно полезна для этого.

Перефразируя из моего предыдущего поста о том, как мы используем объединение, находим структуру данных :

Мы начинаем с n связанных компонентов, т.е. каждая точка находится в своем собственном связанном компоненте.

Затем мы объединяем эти компоненты вместе, чтобы вычислить соседей каждой точки, пока не проведем итерацию всех точек и не сгруппируем все точки в соответствующие компоненты.

Я наткнулся на 3 библиотеки, которые реализуют эту структуру данных — объединение-поиск , эквивалентность и постоянная эквивалентность .

Похоже, у union-find у него был самый простой для понимания API, поэтому я подключил его к своей программе только для того, чтобы в конечном итоге понять, что он не помещает точки в компоненты, как я ожидал.

В конце концов я сузил проблему до следующего примера:

> let uf = emptyEquivalence (0,9)
[(0,0),(1,1),(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),(8,8),(9,9)]
 
> components $ equate 0 1 uf
[(0,0),(1,0),(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),(8,8),(9,9)]
 
> components $ equate 8 9 $ equate 0 1 $ uf
[(0,0),(1,0),(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),(8,8),(9,8)]
 
> components $ equate 0 8 $ equate 8 9 $ equate 0 1 $ uf
[(0,0),(1,0),(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),(8,0),(9,8)]

Мы начинаем с объединения-поиска, где каждая точка находится в своем компоненте. Следующая строка помещает точки «0» и «1» в один и тот же компонент, что и делает, указав, что индексы «0» и «1» массива имеют одинаковое значение, в данном случае 0, которое известно как лидер компонента ,

Мы продолжаем делать это для точек ‘8’ и ‘9’, которые работают нормально, и наша профсоюзная находка теперь состоит из 8 компонентов — те, у которых есть лидеры 8 и 0, которые имеют два элемента, а затем — с лидерами 2,3,4,5, 6 и 7, которые содержат только себя.

На следующем шаге все идет не так, как мы пытаемся соединить узлы «0» и «8». Насколько я понимаю, что здесь должно произойти, так это то, что все точки, связанные с «0» или «8», должны оказаться в одном компоненте, поэтому у нас должен быть компонент, содержащий точки «0», «1», «8» и «9», но «9» пропущено в этом случае.

Реализация специально написана для такой работы, поэтому я решил попробовать написать свою собственную версию на основе следующей версии Ruby:

class UnionFind
  def initialize(n)
    @leaders = 1.upto(n).inject([]) { |leaders, i| leaders[i] = i; leaders }
  end
 
  def connected?(id1,id2)
    @leaders[id1] == @leaders[id2]
  end
 
  def union(id1,id2)
    leader_1, leader_2 = @leaders[id1], @leaders[id2]
    @leaders.map! {|i| (i == leader_1) ? leader_2 : i }
  end
end

Это мой эквивалент Haskell, который я адаптировал из union-find, который я упомянул выше:

module Leaders (UnionSet, create, components, numberOfComponents, indexes, inSameComponent, union) where
 
import Control.Concurrent.MVar
import Control.Monad
import Data.Array.Diff as ArrayDiff
import Data.IORef
import qualified Data.List
import Data.Maybe
import System.IO.Unsafe
import qualified Data.Set as Set
 
arrayFrom :: (IArray a e, Ix i) => (i,i) -> (i -> e) -> a i e
arrayFrom rng f = array rng [ (x, f x) | x <- range rng ]
 
ref :: a -> IORef a
ref x = unsafePerformIO (newIORef x)
 
data UnionSet i = UnionSet { leaders :: IORef (DiffArray i i) }
 
create :: Ix i => (i, i) -> UnionSet i
create is = UnionSet (ref (arrayFrom is id))
 
extractComponents :: Ix i => DiffArray i i -> [(i, i)]    
extractComponents  = Set.toList . Set.fromList . ArrayDiff.assocs
 
components :: Ix i => UnionSet i -> [(i,i)]
components (UnionSet leaders) = unsafePerformIO $ do
    l <- readIORef leaders
    return (extractComponents l)
 
numberOfComponents :: Ix i => UnionSet i -> Int
numberOfComponents (UnionSet leaders) = unsafePerformIO $ do
    l <- readIORef leaders
    return (length $ extractComponents l) 
 
indexes :: Ix i => UnionSet i -> [(i,i)]
indexes (UnionSet leaders) = unsafePerformIO $ do
    l <- readIORef leaders
    return (ArrayDiff.assocs l)       
 
inSameComponent :: Ix i => UnionSet i -> i -> i -> Bool
inSameComponent (UnionSet leaders) x y = unsafePerformIO $ do
    l <- readIORef leaders
    return (l ! x == l ! y)
 
union x y (UnionSet leaders)  = unsafePerformIO $ do
    ls <- readIORef leaders
    let leader1 = ls ! x 
        leader2 = ls ! y
        newLeaders = map (\(index, value) -> (index, leader2)) . filter (\(index, value) -> value == leader1) $ assocs ls        
    modifyIORef leaders (\l -> l // newLeaders)
    return $ UnionSet leaders

Мы можем воссоздать приведенный выше пример так:

> indexes $ Leaders.union 0 8 $ Leaders.union 8 9 $ Leaders.union 0 1 $ create (0,9)
[(0,9),(1,9),(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),(8,9),(9,9)]

К сожалению, выполнение занимает 44 секунды, что в основном связано с вызовом Assocs в строке 46. Assocs дает нам список всех индексов и их соответствующих значений, которые мы используем, чтобы определить, какие индексы необходимо обновить с новым лидером.

Остальная часть кода — это, в основном, основа для извлечения массива из IORef . IORef позволяет нам иметь изменяемый массив в этом случае. В c2 wiki есть страница, которая объясняет, как использовать IORef более подробно .

Хотя использование DiffArray позволяет нам обеспечить чистый внешний интерфейс для его использования, известно , что он в 10-100 раз медленнее, чем MArray .

Я играл с версией структуры данных union-find, которая вместо этого использует MArray и сократила время выполнения до 34 секунд.

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