Last active
April 28, 2020 13:32
-
-
Save neilmayhew/3532d729a6c52b27e644fd307165662a to your computer and use it in GitHub Desktop.
Natural Sort Algorithm
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
import Data.Char (isDigit) | |
import Data.List (sortBy) | |
naturalCompare :: String -> String -> Ordering | |
naturalCompare s@(c:s') t@(d:t') | |
| isDigit c && isDigit d = numericCompare 0 s t | |
| otherwise = compare c d <> naturalCompare s' t' | |
naturalCompare s t = compare s t | |
numericCompare :: Int -> String -> String -> Ordering | |
numericCompare zCount ('0':s) t = numericCompare (zCount + 1) s t | |
numericCompare zCount s ('0':t) = numericCompare (zCount - 1) s t | |
numericCompare zCount s t = numericCompareNoZeros (compare zCount 0) EQ s t | |
numericCompareNoZeros :: Ordering -> Ordering -> String -> String -> Ordering | |
numericCompareNoZeros zOrder cOrder s@(c:s') t@(d:t') = | |
case (isDigit c, isDigit d) of | |
(True, True) -> numericCompareNoZeros zOrder (cOrder <> compare c d) s' t' | |
(a, b) -> compare a b <> cOrder <> naturalCompare s t <> zOrder | |
numericCompareNoZeros zOrder cOrder (c:_) "" = compare (isDigit c) False <> cOrder <> GT | |
numericCompareNoZeros zOrder cOrder "" (d:_) = compare False (isDigit d) <> cOrder <> LT | |
numericCompareNoZeros zOrder cOrder "" "" = cOrder <> zOrder | |
main :: IO () | |
main = interact $ unlines . sortBy naturalCompare . lines |
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 ViewPatterns #-} | |
{-# OPTIONS_GHC -Wno-unused-top-binds #-} | |
import Criterion.Main | |
import Data.Char (isDigit) | |
import Data.Text (Text, uncons) | |
import Data.Vector (Vector) | |
import qualified Data.Vector as V | |
import qualified Data.Vector.Algorithms.Intro as Intro | |
import qualified Data.Text as T | |
import qualified Data.Text.IO as T | |
naturalCompare :: Text -> Text -> Ordering | |
naturalCompare s@(uncons -> Just (c, s')) t@(uncons -> Just (d, t')) | |
| isDigit c && isDigit d = numericCompare 0 s t | |
| otherwise = compare c d <> naturalCompare s' t' | |
naturalCompare s t = compare s t | |
{-# INLINABLE naturalCompare #-} | |
numericCompare :: Int -> Text -> Text -> Ordering | |
numericCompare zCount (uncons -> Just ('0', s)) t = numericCompare (zCount + 1) s t | |
numericCompare zCount s (uncons -> Just ('0', t)) = numericCompare (zCount - 1) s t | |
numericCompare zCount s t = numericCompareNoZeros (compare zCount 0) EQ s t | |
{-# INLINABLE numericCompare #-} | |
numericCompareNoZeros :: Ordering -> Ordering -> Text -> Text -> Ordering | |
numericCompareNoZeros zOrder cOrder s@(uncons -> Just (c, s')) t@(uncons -> Just (d, t')) = | |
case (isDigit c, isDigit d) of | |
(True, True) -> numericCompareNoZeros zOrder (cOrder <> compare c d) s' t' | |
(a, b) -> compare a b <> cOrder <> naturalCompare s t <> zOrder | |
numericCompareNoZeros _ cOrder (uncons -> Just (c, _)) _ = compare (isDigit c) False <> cOrder <> GT | |
numericCompareNoZeros _ cOrder _ (uncons -> Just (d, _)) = compare False (isDigit d) <> cOrder <> LT | |
numericCompareNoZeros zOrder cOrder _ _ = cOrder <> zOrder | |
{-# INLINABLE numericCompareNoZeros #-} | |
fastSortBy :: (Text -> Text -> Ordering) -> Vector Text -> Vector Text | |
fastSortBy cmp = V.modify (Intro.sortBy cmp) | |
fastSortByIO :: (Text -> Text -> Ordering) -> Vector Text -> IO (Vector Text) | |
fastSortByIO cmp v = do | |
mv <- V.thaw v | |
Intro.sortBy cmp mv | |
V.freeze mv | |
mainBench :: IO () | |
mainBench = do | |
input <- V.fromList . T.lines <$> T.getContents | |
defaultMain | |
[ bgroup "Intro" | |
[ bench "IO" $ | |
nfAppIO (fastSortByIO naturalCompare) input | |
, bench "ST" $ | |
nf (fastSortBy naturalCompare) input | |
] | |
] | |
mainTest :: IO () | |
mainTest = T.interact $ T.unlines . V.toList . fastSortBy naturalCompare . V.fromList . T.lines | |
main :: IO () | |
main = mainBench |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment