Количество сравнений для быстрой сортировки

Question

Вот реализация быстрой сортировки, который считается «не очень быстро»:

qSort :: Ord a => [a] -> [a] 
qSort [] = [] 
qSort (p:xs) = (qSort $ filter (< p) xs) ++ (qSort $ filter (== p) xs) ++ [p] ++ (qSort $ filter (> p) xs) 

main = print $ qSort [15, 11, 9, 25, -3] 

Но, тем не менее, можно подсчитать количество сравнений, необходимых, чтобы сделать его сделанный? Я пытался подсчитать размер filter (< p) xs и filter (> p) xs, но я оказался не тем, что мне нужно.

UPDATE:

Вопрос не о сложности времени, это именно о подсчете числа сравнений.

Answer 1

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

import Control.Applicative 
import Control.Monad 
import Control.Monad.Writer.Strict 
import Data.Monoid 

type CountM a = Writer (Sum Int) a 

Тогда давайте определим функцию, которая оборачивает чистую значение в монадический тот, который получает приращение счетчика:

count :: Int -> a -> CountM a 
count c = (<$ tell (Sum c)) 

Теперь мы можем определить

qSortM :: Ord a => [a] -> CountM [a] 
qSortM [] = return [] 
qSortM (p:xs) = 
    concatM [ qSortM =<< filtM (< p) 
      , filtM (== p) 
      , return [p] 
      , qSortM =<< filtM (> p) 
      ] 
    where 
    filtM p = filterM (count 1 . p) xs 
    concatM :: (Monad m) => [m [a]] -> m [a] 
    concatM = liftM concat . sequence 

Это не так хорошо, как т он оригинальная версия, но все же пригодная для использования.

---

Обратите внимание, что вы сравниваете каждый элемент списка три раза, в то время как этого достаточно, чтобы сделать это один раз.Это имеет еще одно неудачное следствие того, что исходный список должен храниться в памяти до тех пор, пока все три фильтра не закончатся. Итак, давайте вместо этого определить

-- We don't care we reverse the order of elements in the buckets, 
-- we'll sort them later anyway. 
split :: (Ord a) => a -> [a] -> ([a], [a], [a], Int) 
split p = foldl f ([], [], [], 0) 
    where 
    f (ls, es, gs, c) x = case compare x p of 
     LT -> (x : ls, es, gs, c') 
     EQ -> (ls, x : es, gs, c') 
     GT -> (ls, es, x : gs, c') 
     where 
     c' = c `seq` c + 1 

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

Теперь наша быстрая сортировка станет немного компактнее

qSortM :: Ord a => [a] -> CountM [a] 
qSortM [] = return [] 
qSortM (p:xs) = count c =<< 
    concatM [ qSortM ls 
      , return (p : es) 
      , qSortM gs 
      ] 
    where 
    (ls, es, gs, c) = split p xs 
    concatM = liftM concat . sequence 

Мы могли бы достичь того же результата без использования Writer, только при наличии qSortM возвращения (Int, [a]) явно. Но тогда нам пришлось бы вручную обрабатывать результаты рекурсивного qSortM, что было бы более грязным. Более того, монадический способ позволяет нам добавлять более позднюю информацию, такую ​​как максимальная глубина, без какого-либо нарушения основной части.

Answer 2

Оценим Выражение qSort [15, 11, 9, 25, -3]:

qSort [15, 11, 9, 25, -3] 
    = qSort (15:[11, 9, 25, -3]) 
    = (qSort $ filter (< 15) [11, 9, 25, -3]) 
     ++ (qSort $ filter (== 15) [11, 9, 25, -3]) 
     ++ [p] 
     ++ (qSort $ filter (> 15) [11, 9, 25, -3]) 
    = (qSort [11, 9, -3]) ++ (qSort []) ++ [p] ++ (qSort [25]) 

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

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

Answer 3

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

Есть, конечно, глупый способ просто придерживаться сравнения в монаде State. Это будет просто скопировать все вызовы функции сравнения. Обратите внимание на использование действия count, которое просто преобразует предикат в действие, которое отслеживает каждый вызов указанного предиката, а затем применяет его к его аргументу.

{-# LANGUAGE ScopedTypeVariables #-} 
import Control.Monad.State 

qSortM :: Ord a => [a] -> State Int [a] 
qSortM [] = return [] 
qSortM (p:xs) = do h <- (qSortM =<< filterM (count (< p)) xs) 
        e <- (qSortM =<< filterM (count (== p)) xs) 
        t <- (qSortM =<< filterM (count (> p)) xs) 
        return $ h ++ e ++ [p] ++ t 
       where count :: (a -> Bool) -> (a -> State Int Bool) 
        count p a = modify (+1) >> return (p a) 

qSort :: Ord a => [a] -> ([a],Int) 
qSort l = runState (qSortM l) 0 

main :: IO() 
main = print $ (qSort [15, 11, 9, 25, -3]) 

Это на самом деле страшно Haskell, и может быть выражено без State монады, только с помощью рекурсивных функций. Хорошим упражнением было бы написать так. Разумеется, версия монады State сделает более интуитивный смысл людям, исходящим из императивного фона.

> qSort [10,9..1] 
([1,2,3,4,5,6,7,8,9,10],90) 

> qSort [15,11,9,25,-3] 
([-3,9,11,15,25],14) 

Answer 4

Мы можем просто написать функцию для расчета этого числа. Каждый filter p xs выполняет length xs сравнения, вот и все.

В данный момент ваш код выполняет 3 прохода для выполнения раздела; вы можете переписать его для выполнения трехстороннего раздела за один проход. Мы можем сделать число проходов параметром.

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

_NoSort = False 
_DoSort = True 

qsCount xs n midSortP = qs 0 xs id  -- return number of comparisons that 
where         -- n-pass `qSort xs` would perform 
    qs !i []  k = k i 
    qs !i (p:xs) k = 
    let (a,b,c) = (filter (< p) xs, filter (== p) xs, filter (> p) xs) 
    in qs (i+n*length xs) a (\i-> g i b (\i-> qs i c k)) 
    g i b k | midSortP = qs i b k 
      | otherwise = k i 

, как можно видеть, это займет больше 3х сравнение с 3 проходами, чем с 1, а средний сортировка может только сделать разницу, если есть более двух одинаковых элементов в списке:

*Main> qsCount (concat $ replicate 4 [10,9..1]) 3 _NoSort 
630 
*Main> qsCount (concat $ replicate 4 [10,9..1]) 3 _DoSort 
720 
*Main> qsCount (concat $ replicate 4 [10,9..1]) 1 _NoSort 
210 
*Main> qsCount (concat $ replicate 4 [10,9..1]) 1 _DoSort 
240 
*Main> qsCount [5,3,8,4,10,1,6,2,7,9] 1 _NoSort 
19 
*Main> qsCount [5,3,8,4,10,1,6,2,7,9] 1 _DoSort 
19 
*Main> qsCount (replicate 10 1) 1 _NoSort 
9 
*Main> qsCount (replicate 10 1) 1 _DoSort 
45 
*Main> qsCount [15, 11, 9, 25, -3] 3 _DoSort 
21