Прим. перев.: Это перевод истории о том, как нелегко оказалось написать параллельную быструю сортировку (quicksort) на Хаскеле. Оригинал статьи написан в 2010 году, но, мне кажется, он до сих пор поучительный и во многом актуальный.

Есть много примеров того, как Хаскель делает простые проблемы сложными. Вероятно, самый известный из них—это решето Эратосфена, которое легко написать на любом императивном языке, но настолько сложно написать на Хаскеле, что почти все решения, которые преподавались в университетах и использовались в исследованиях последние 18 лет, оказались неправильными. На их несостоятельность обратила внимание Мелисса О'Нил [Melissa O'Neill] в своей важной научной работе "Настоящее решето Эратосфена". В ней приводится прекрасное описание того, что не так в старых подходах, и как их надо исправить. Решением Мелиссы было использовать очередь с приоритетом [priority queue] для реализации решета. Правильное решение оказалось в 10 раз длиннее, чем намного более простое решение на F# и в целых 100 раз длиннее, чем оригинальный изуродованный алгоритм на Хаскеле.

Сегодня быстрая сортировка — это новое решето Эратосфена. И программисты на Хаскеле снова обошли неспособность языка выразить этот алгоритм уродованием последнего. Новый вариант медленнее на порядки, но зато его можно легко записать на Хаскеле.

qsort []     = []
qsort (x:xs) = qsort (filter (< x) xs) ++ [x] ++ qsort (filter (>= x) xs)

Этот код совершенно не соотносится с сущностью настоящего алгоритма быстрой сортировки, которая делает его таким эффективным (см. оригинальную статью Тони Хоара 1962 года о быстрой сортировке). А именно, перегруппировка [partitioning] массива без дополнительного выделения памяти [in-place partitioning using swaps].

Столкнувшись с проблемой написания паралелльной быстрой сортировки общего назначения на Хаскеле, Джим Эппл [Jim Apple] (который пишет кандидатскую по Хаскелю в Калифорнийском университете в Дейвисе, UC Davis) дал старт делу, написав следующий код:

import Data.HashTable as H
import Data.Array.IO
import Control.Parallel.Strategies
import Control.Monad
import System

exch a i r =
    do tmpi <- readArray a i
       tmpr <- readArray a r
       writeArray a i tmpr
       writeArray a i tmpi

bool a b c = if c then a else b

quicksort arr l r =
  if r <= l then return () else do
    i <- loop (l-1) r =<< readArray arr r
    exch arr i r
    withStrategy rpar $ quicksort arr l (i-1)
    quicksort arr (i+1) r
  where
    loop i j v = do
      (i', j') <- liftM2 (,) (find (>=v) (+1) (i+1)) (find (<=v) (subtract 1) (j-1))
      if (i' < j') then exch arr i' j' >> loop i' j' v
                   else return i'
    find p f i = if i == l then return i
                 else bool (return i) (find p f (f i)) . p =<< readArray arr i

main = 
    do [testSize] <- fmap (fmap read) getArgs
       arr <- testPar testSize
       ans <- readArray arr  (testSize `div` 2)
       print ans

testPar testSize =
    do x <- testArray testSize
       quicksort x 0 (testSize - 1)
       return x

testArray :: Int -> IO (IOArray Int Double)
testArray testSize = 
    do ans <- newListArray (0,testSize-1) [fromIntegral $ H.hashString $ show i | i <- [1..testSize]]
       return ans

Этот алгоритм использует параллельные "стратегии" Хаскеля. Эта концепция была разработана, чтоб дать программистам на Хаскеле больше контроля над параллелизацией, но оказалось, что в единственной доступной имплементации течёт память и никому не удалось заставить её работать в этом коде: решение Джима содержит ошибку многопоточности [concurrency], из-за которой оно возвращает неправильные результаты почти при каждом вызове.

Тогда Пикер [Peaker] предложил свое решение на Хаскеле:

import Data.Array.IO
import Control.Monad
import Control.Concurrent

bool t _f True = t
bool _t f False = f

swap arr i j = do
  (iv, jv) <- liftM2 (,) (readArray arr i) (readArray arr j)
  writeArray arr i jv
  writeArray arr j iv

parallel fg bg = do
  m <- newEmptyMVar
  forkIO (bg >> putMVar m ())
  fg >> takeMVar m

sort arr left right = when (left < right) $ do
  pivot <- read right
  loop pivot left (right - 1) (left - 1) right
  where
    read = readArray arr
    sw = swap arr
    find n pred i = bool (find n pred (n i)) (return i) . pred i =<< read i
    move op d i pivot = bool (return op)
                        (sw (d op) i >> return (d op)) =<<
                        liftM (/=pivot) (read i)
    loop pivot oi oj op oq = do
      i <- find (+1) (const (<pivot)) oi
      j <- find (subtract 1) (\idx cell -> cell>pivot && idx/=left) oj
      if i < j
        then do
          sw i j
          p <- move op (+1) i pivot
          q <- move oq (subtract 1) j pivot
          loop pivot (i + 1) (j - 1) p q
        else do
          sw i right
          forM_ (zip [left..op-1] [i-1,i-2..]) $ uncurry sw
          forM_ (zip [right-1,right-2..oq+1] [i+1..]) $ uncurry sw
          let ni = if left >= op then i + 1 else right + i - oq
              nj = if right-1 <= oq then i - 1 else left + i - op
          let thresh = 1024
              strat = if nj - left < thresh || right - ni < thresh
                      then (>>)
                      else parallel
          sort arr left nj `strat` sort arr ni right

main = do
  arr <- newListArray (0, 5) [3,1,7,2,4,8]
  getElems arr >>= print
  sort (arr :: IOArray Int Int) 0 5
  getElems arr >>= print

Это решение тоже оказалось с багами. Во-первых, оно содержит более тонкий баг многопоточности [concurrency], который приводит к неверным результатам лишь изредка. Пикер исправил этот баг в следующем коде:

import System.Time
import System.Random
import Data.Array.IO
import Control.Monad
import Control.Concurrent
import Control.Exception
import qualified Data.List as L

bool t _ True = t
bool _ f False = f

swap arr i j = do
  (iv, jv) <- liftM2 (,) (readArray arr i) (readArray arr j)
  writeArray arr i jv
  writeArray arr j iv

background task = do
  m <- newEmptyMVar
  forkIO (task >>= putMVar m)
  return $ takeMVar m

parallel fg bg = do
  wait <- background bg
  fg >> wait

sort arr left right = when (left < right) $ do
  pivot <- read right
  loop pivot left (right - 1) (left - 1) right
  where
    read = readArray arr
    sw = swap arr
    find n pred i = bool (find n pred (n i)) (return i) . pred i =<< read i
    move op d i pivot = bool (return op)
                        (sw (d op) i >> return (d op)) =<<
                        liftM (/=pivot) (read i)
    swapRange px x nx y ny = if px x then sw x y >> swapRange px (nx x) nx (ny y) ny else return y
    loop pivot oi oj op oq = do
      i <- find (+1) (const (<pivot)) oi
      j <- find (subtract 1) (\idx cell -> cell>pivot && idx/=left) oj
      if i < j
        then do
          sw i j
          p <- move op (+1) i pivot
          q <- move oq (subtract 1) j pivot
          loop pivot (i + 1) (j - 1) p q
        else do
          sw i right
          nj <- swapRange (<op) left (+1) (i-1) (subtract 1)
          ni <- swapRange (>oq) (right-1) (subtract 1) (i+1) (+1)
          let thresh = 1024000
              strat = if nj - left < thresh || right - ni < thresh
                      then (>>)
                      else parallel
          sort arr left nj `strat` sort arr ni right

timed act = do
  TOD beforeSec beforeUSec <- getClockTime
  x <- act
  TOD afterSec afterUSec <- getClockTime
  return (fromIntegral (afterSec - beforeSec) +
          fromIntegral (afterUSec - beforeUSec) / 1000000000000, x)

main = do
  let n = 1000000
  putStrLn "Making rands"
  arr <- newListArray (0, n-1) =<< replicateM n (randomRIO (0, 1000000) >>= evaluate)
  elems <- getElems arr
  putStrLn "Now starting sort"
  (timing, _) <- timed $ sort (arr :: IOArray Int Int) 0 (n-1)
  print . (L.sort elems ==) =<< getElems arr
  putStrLn $ "Sort took " ++ show timing ++ " seconds"

Это решение действительно работает на маленьких входных массивах, но увеличение размера массива до 1 000 000 элементов приводит к переполнению стека. Было сделано две попытки проанализировать этот баг, здесь и здесь, но обе оказались неправильными. На самом деле, это баг в функции getElems стандартной библиотеки Хаскеля, которая переполняет стек на больших массивах.

Как ни странно, исправления еще нескольких багов, судя по всему, привели к реализации первой в мире параллельной быстрой сортировки общего назначения, написанной на Хаскеле. Более того, финальное решение на Хаскеле всего примерно на 55% медленнее, чем эквивалентное решение на F#. Будьте внимательны, это решение требует последнюю версию GHC, которая была выпущена несколько недель назад (прим. перев.: статья 2010 года, так что читателю беспокоиться не о чем).

Первые комментарии к оригинальной статье


Ganesh Sittampalam:
Поздравляю с обучением тому, как делать fork и synchronise в Хаскеле!

Jon Harrop (автор оригинала):
Поздравляю с проверкой твоей теории о том, что это будет «тривиально»...
Поделиться с друзьями
-->

Комментарии (27)


  1. rikert
    12.12.2016 00:40
    +6

    Очередная демонизация Хаскеля, аплодирую стоя.


    1. sleeply4cat
      12.12.2016 00:52

      статья всё-таки почти семилетней давности.


    1. 0xd34df00d
      12.12.2016 01:53
      +3

      Блог автора статьи вообще состоит из подобной демонизации. Злые языки (для автора, для хаскеля — добрые) вообще говорят, что это всё потому, что он предлагает услуги по F#-консалтингу.


      1. rikert
        12.12.2016 02:08
        +1

        > что он предлагает услуги по F#-консалтингу.

        Вот на это очень похоже, потому что только из-за слов "Правильное решение оказалось в 10 раз длиннее, чем намного более простое решение на F# и в целых 100 раз длиннее, чем оригинальный изуродованный алгоритм на Хаскеле." можно сделать однозначный вывод, что автор до конца не разбирается в технической реализации Хаскеля, так как от F# он отличается кардинально, общее у них разве что функциональный принцип, с таким же успехом можно сказать что например на Scala это делается ещё проще, что то в этом роде.

        Особенно примечательно использование словосочетания «изуродованный алгоритм», так как вышеприведенный код на Хаскеле не читаемый в принципе, ни типов, имена переменных x xcv df sdf lj ahf as;dfh as;kldfh a;sdfj a'sdfj, какой то набор символов. Я вот одного не пойму, вот человек был нормальным писал на императивных языках но как только он взял в руки Хаскель то у него появляется неудержимое желание сделать спагетти совершенно неясного кода, а с переменные превратить в разбросанные куски различных сочетаний двух-трех букв испорченного генератора паролей.
        Спрашивается, ну вот почему ты в своем C# так не пишешь? Почему? Ужас какой то. Ну не въехал ты в Хаскель, ничего страшного, занимайся другими языками, но такие статьи похожи на бессильную злобу.


        1. 0xd34df00d
          12.12.2016 02:16

          Соглашусь с вами. Разве что, отвечу за себя на


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

          У меня в моём личном кодстайле для хаскеля есть правило писать сигнатуры для всех топ-левел-байндингов. И если у меня функция с сигнатурой типа


          toTF :: Context -> TokenMatcher -> [InputToken] -> State -> Result

          то я напишу


          toTF ctx TokenMatcher { .. } (t:ts) s = ...

          и даже воспользуюсь {-# LANGUAGE RecordWildCards #-}, как вы видите, потому что что эти буквы обозначают, видно из контекста, а тело функции — одна, максимум две строки. А не тот ужас, конечно, что в исходном посте.


          При всём при этом, у меня есть личные конкретные баттхёрты от quality of implementation в случае конкретного ghc — в сколь угодно нетривиальных параллельных программах GC начинает жрать непомерно много времени, потому что GC там хоть и параллельный, но не конкурентный, привет stop-the-world, если даже всего один HEC выжрал свой и соседние allocation area. Но это не свойство языка, впрочем. Либо, не отрицаю, я просто не умею писать многопоточные программы на хаскеле.


          1. qnikst
            12.12.2016 09:27

            При всём при этом, у меня есть личные конкретные баттхёрты от quality of implementation в случае конкретного ghc — в сколь угодно нетривиальных параллельных программах GC начинает жрать непомерно много времени, потому что GC там хоть и параллельный, но не конкурентный, привет stop-the-world, если даже всего один HEC выжрал свой и соседние allocation area. Но это не свойство языка, впрочем. Либо, не отрицаю, я просто не умею писать многопоточные программы на хаскеле.


            Проблема тут не в quality of implementation, а в tradeoff между throughput и latency и предсказуемости того, сколько памяти может отжирать программа на пустом месте. Если важна latency и пофиг на память, то можно идти путём go. Если не важен sharing структур между потоками, то можно делать как Erlang.
            В целом ветка non-blocking-gc есть, но те тесты, что были показали, что в большинстве случаев усложнение реализации не окупается. Ну и важно помнить, что до ghc 8.0 очень неудачные RTS опции по умолчанию. Так +RTS -A254m -qb0 -ki{size-of-l1-cache} зачастую очень сильно улучшает поведение (после 8.0 -qb0 не нужно, т.к. он выставляется динамически).


            1. 0xd34df00d
              12.12.2016 21:21

              У меня -A256m и в окрестности никогда не работали хорошо (MUT начинает жрать сильно больше, чем с меньшими размерами, и уменьшение времени GC это перестаёт компенсировать). Для меня как-то в среднем оказываются более оптимальными числа от 8 до 64, чаще ближе к 8.


              Ну и ещё помогает иногда per-core allocation area выставить.


              1. qnikst
                12.12.2016 21:27

                MUT это время работы «мутатора», т.е. самой программы, чем оно больше — тем лучше.


                1. 0xd34df00d
                  12.12.2016 21:30

                  Чем больше его доля, я бы сказал. А если оно было, условно, 30 секунд, а от увеличения -A стало 60 (причём, с учётом параллельности) — это уже как-то не очень круто, ИМХО.


        1. Bas1l
          12.12.2016 15:27
          +4

          Автор действительно предлагает услуги по F# консалтингу, но его аргументы обычно очень адекватные.

          Алгоритм на Хаскеле «изуродованный» (bastardized в оригинале), потому что это не решето Эратосфена, а совсем другой алгоритм. В упомянутой научной статье его называют поэтому кодовым именем «unfaithful sieve». Оказывается, он даже хуже, чем реализация «в лоб» на императивном языке («trial division»). В лоб—это для каждого числа искать все его делители. В статье есть и анализ сложности. У нормального решета ?(n log log n) (почти линейная, можно сказать). У unfaithful sieve—?(n^2/(log n)^2). У решения в лоб—?(n^(3/2)/(log n)^2). А на F# можно легко написать нормальный алгоритм, потому что в нем есть изменяемое состояние.

          Справедливости ради, весь код (кроме первого из двух строчек) взят из постов и комментов людей, которые пытались реализовать эту параллельную быструю сортировку. В статье есть ссылки, они все до сих пор рабочие. То есть там вообще нет кода автора. А люди эти вроде как апологеты Хаскеля (в отличие от автора, да).


          1. 0xd34df00d
            12.12.2016 21:21
            +1

            А на F# можно легко написать нормальный алгоритм, потому что в нем есть изменяемое состояние.

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


          1. develop7
            12.12.2016 21:37
            -1

            люди эти вроде как апологеты Хаскеля

            «апологеты из интернетиков не смогли — значит не может никто» — так себе аргумент


  1. ababo
    12.12.2016 01:01
    -6

    Просто, Haskell по факту не является языком общего назначения. Глупо, к примеру, требовать того же от SQL.


    1. 0xd34df00d
      12.12.2016 01:54
      +7

      Является не более и не менее, чем, скажем, Python или C++.


    1. Romaboy
      12.12.2016 02:09
      +1

      Справедливости ради, SQL невероятно мощный язык, после очень долгого туториала по Postgres'у кажется, что там в десятки раз больше всяческих типов, конструкций, чем в любом другом. Что-то, а сортировку на SQL точно сделать проще =)


      1. raacer
        12.12.2016 22:41

        Через order by, что ли? Это нечестно :) Я так тоже могу написать сортировку на питоне одной командой: sorted().


  1. qnikst
    12.12.2016 10:05
    +4

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

    Но тут интереснее спросить у автора, а насколько у него глубокий уровень экспертизы в Haskell для того, чтобы оставлять подобные
    [quote]Прим. перев.: Это перевод истории о том, как нелегко оказалось написать параллельную быструю сортировку (quicksort) на Хаскеле. Оригинал статьи написан в 2010 году, но, мне кажется, он до сих пор поучительный и во многом актуальный.[/quote]

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


    1. Bas1l
      13.12.2016 13:58
      +3

      Мой пост, мне хочется верить, тоже полезный, потому что дает возможность сформировать более взвешенное мнение о чисто функциональных языках и их ограничениях. А так же о том, как осторожно надо относиться к хайпу по поводу какой бы то ни было технологии.

      Я на Хаскеле не пишу. Тем не менее, если я правильно понимаю, правильное решето Эратосфена без priority queue в нем, скорее всего, до сих реализовать нельзя. И занимает оно все равно больше строчек, чем решето на любом императивном языке.


      1. qnikst
        13.12.2016 14:21
        +2

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


        Не уверен ни про взвешенное, ни про ограничия. Мнение Харропа никогда взвешенным не было, хотя некоторые вещи он подмечает хорошо. Но, чтобы отделить зерна от плевел в его потах нужно понимать как и почему, все работает, т.е. разбираться в функциональных языках на хорошем уровне.

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


        Вот с этим согласен, в т.ч. и про функциональные языки и там не все идеально.

        Тем не менее, если я правильно понимаю, правильное решето Эратосфена без priority queue в нем, скорее всего, до сих реализовать нельзя.
        Более-менее осмысленное императивное (а решето эратосфена это императивный алгоритм) решение можно было получить, когда появились массивы (array), библиотека от 2007 года, статью искать лень. С появлением пакета vector 2008 год, но не входит в стандарт, стало ещё проще. Учитывая, что ST уже было, то можно даже изолировать алгоритм и получить чистый результат как er n = V.toList $ runST $ do { x <- new 0; run x ; return $ unsafeFreeze x }.

        При этом строчек будет столько же или меньше, вот некоторые будут выглядеть хуже, т.к. вместо привычного всем a[i] = 0 будет unsafeWrite a i, в случае не возникающего в задаче a[i] = b[j] будет ещё хуже unsafeWrite a i =<< unsafeRead b j. Для меня учитывая количество получаемых плюсов этот синтаксис большой проблемой не является.

        Почему там был использован prioity queue я не знаю, видимо кому-то хотелось получить алгоритм полностью в функциональном стиле, но я не знаю как это можно сделать эффективно без хорошей поддержи компилятора и более продвинутой системы типов, которой в ghc ещё нет. И главное я не знаю зачем нужно пиать полностью функциональную версию в чисто императивном алгоритме, если в языке есть прекрасная поддержка императивности и локализуемой изменяемости.


  1. Akon32
    12.12.2016 12:10

    Лучше бы TimSort написали.


    1. qnikst
      12.12.2016 13:23

      Не параллельный уже написали:

      https://hackage.haskell.org/package/vector-algorithms-0.7.0.1/docs/Data-Vector-Algorithms-Tim.html


  1. koldyr
    12.12.2016 17:44
    -1

    За всё надо платить. То что, например, системы реального времени медленнее систем общего назначения никого не удивляет. А то что иммутабельность порождает сложности в некоторых алгоритмах это прямо трагедия. К тому же автор слукавил, параллельность пока


    1. develop7
      12.12.2016 21:21

      остаток комментария после «пока» съелся


  1. raacer
    18.12.2016 18:40
    +1

    А Вы не думали о том, что императивный алгоритм по определению не ложится на функциональный стиль? Попробуйте сделать наоборот: реализовать функциональное решение на императивном языке, и скорее всего оно будет очень кривым, если его вообще можно будет реализовать.

    По-моему, вся эта история именно об этом: о том, что ФЯ — для ФП, а ИЯ — для ИП.


    1. Bas1l
      19.12.2016 02:15

      А у вас есть пример алгоритма, который не ложится на императивный стиль?


      1. raacer
        19.12.2016 16:37
        +2

        Я не могу выполнить Вашу просьбу, потому что она некорректна. Любой алгоритм ложится на императивное программирование по определению. Термины в данном вопросе имеют ключевое значение. Чтобы понимать, в чем суть, надо разобраться, что из себя представляет ФП вообще, и почему оно не об алгоритмах в принципе.

        Тем не менее, перефразирую ваш вопрос и отвечу на него. А есть ли пример функционального решения (то есть вычислительного выражения, так сказать), который не ложится на императивный стиль? Думаю, полно. Например, факториал:

        factorial 0 = 1
        factorial n = n * factorial (n - 1)
        

        или поиск чисел в списке по фильтру
        divisibleBy x n = n `rem` x == 0
        intsDivisibleBy x list = filter (divisibleBy x) list
        

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

        Тут стоит сразу поднять еще один вопрос, обсуждаемый в данной статье: оптимизация. Ведь приведенный в статье алгоритм является примером оптимизации, учитывающей особенности машины. Если нужна оптимизация — надо спускаться по уровням абстракций вплоть до ассемблера, и мы неизбежно переходим на императивный стиль, потому что создаем приложение для императивной машины. Если бы машины была функциональной, все было бы с точностью до наоборот: необходимость оптимизации толкала бы нас на спуск к функциональному стилю, а императивный был бы лишь абстракцией поверх него.

        Вывод — сама идея переносить алгоритмы в ФП является абсурдной. Если нужна оптимизация под императивную машину — надо писать императивный код на императивном языке. И наоборот. Использовать ФП на императивной машине имеет смысл только в том случае, если его абстракции будут удобны для решения конкретной задачи. Но нужно помнить, что абстракции — это перенос работы с программиста на компьютер, и кому-то всё равно придётся работать.

        Напомню, что императивное программирование основано на машине Тьюринга, которыми по своей сути являются современные компьютеры. А функциональное программирование — на лямбда-исчислениях, родившихся в качестве чисто математической абстракции, и реализованных на железе, наверное, только в Lisp-машине (насколько там честная реализация — я не в курсе).


  1. raacer
    19.12.2016 16:33

    не туда