Last active
January 3, 2019 09:09
-
-
Save L-TChen/55574a42087b49ed2c8aa2c0fdcafef8 to your computer and use it in GitHub Desktop.
The derivation of Quickselect from Quicksort, see my blog post https://xcycl.wordpress.com/2019/01/02/fromquicksorttoquickselect/
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
{-# LANGUAGE TypeApplications #-} | |
import Test.QuickCheck | |
import Data.List (sort) | |
selectOrigin k = (!! k) . sort | |
select :: (Ord a) => Int -> [a] -> a | |
select k (x:xs) = case compare k n of | |
LT -> select k ys | |
EQ -> x | |
GT -> select (k-n-1) zs | |
where | |
(n, ys, zs) = partition' (< x) xs | |
partition' :: (a -> Bool) -> [a] -> (Int, [a], [a]) | |
partition' p = foldr op (0, [], []) | |
where | |
op x (n, ys, zs) | |
| p x = (1+n, x:ys, zs) | |
| otherwise = (n, ys, x:zs) | |
prop1 :: Ord a => NonEmptyList a -> Int -> Bool | |
prop1 (NonEmpty xs) k = | |
let k' = k `mod` length xs | |
in selectOrigin k' xs == select k' xs | |
prop2 :: [Int] -> Int -> [Int] -> Int -> Bool | |
prop2 xs y ys n = | |
let m = length xs | |
n' = n `mod` (m + length (y:ys)) | |
in (xs ++ y:ys) !! n' == | |
case compare n' m of | |
LT -> xs !! n' | |
EQ -> y | |
GT -> ys !! (n' - m - 1) | |
main :: IO () | |
main = quickCheck (prop1 @Int) | |
>> quickCheck prop2 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment