もっともシンプルなソートアルゴリズム？
https://twitter.com/mootastic/status/1445543507158913025 より
https://arxiv.org/abs/2110.01111
なまえがついていないようなので、「ほげソート」と呼んでおく
命令プログラミングぽくならないように、書くのはちょっとしたパズルみたいになる。
Haskellプログラミングにおける「命令プログラミングぽさ」は、
do構文
インデックスによる配列要素へのアクセス
に現れる（個人的感想です）ので、これを排除する。
全然シンプルに書けてない！
かっこよくシンプルに書けたら教えてください。といってたら、キター
@cutseaさんによるカッコイイコード
code:ICBICSort.hs
module ICBICSort where
import Debug.Trace (trace)
debug = True
($?) :: Show a => (a -> b) -> a -> b
f $? x = if debug then trace (show x) (f x) else f x
-- I Can't Believe It Can Sort Algorithm.
icbics :: (Show a, Ord a) => a -> a
icbics xs = swapper $? ([], xs)
swapper :: (Show a, Ord a) => (a, a) -> a
swapper (xs, []) = xs
swapper (xs, y:ys) = swapper $? (zs++w, ws)
where (z, zs) = swp (y:xs)
(w, ws) = swp (z:ys)
swp :: Ord a => a -> (a, a)
swp xxs@(x:_) = case break (x<) xxs of
(xs, []) -> (x, tail xs)
(xs, ys) -> (z, tail xs++x++zs)
where (z, zs) = swp ys
sample = 1,3,2,5,4,7,6,0
カウンタを使う版
splitAtがインデックスアクセスに相当する
code:HogeSort.hs
{-# LANGUAGE LambdaCase #-}
module HogeSort where
-- for debug print
import Debug.Trace
import Text.Printf
tracing :: String -> a -> a
tracing = debug True
where
debug True = trace
debug _ = const id
-- ---
hogesort :: (Ord a, Show a) => a -> a
hogesort = \ case
[] -> []
xxs@(x:xs) -> hoge (length xs) 0 x [] xxs
hoge :: (Ord a, Show a) => Int -> Int -> a -> a -> a -> a
hoge n i m sy yys
= tracing (printf "hage %d %d %s %s %s" n i (show m) (show sy) (show yys))
(
case yys of
[] | n == i -> reverse (m : tail sy)
| otherwise -> case splitAt i (reverse sy) of
(ws, _:zs) -> hoge n (succ i) (head zs) [] (ws ++ m : zs)
y:ys | m < y -> hoge n i y (m : sy) ys
| otherwise -> hoge n i m (y : sy) ys
)
（整数の）カウンタを明示的に使わない版
code:haskell
{-# LANGUAGE LambdaCase #-}
module HogeSort where
-- for debug print
import Debug.Trace
import Text.Printf
tracing :: String -> a -> a
tracing = debug True
where
debug True = trace
debug _ = const id
--
hogesort = \ case
[] -> []
xxs@(_:_) -> hoge [] xxs [] xxs
hoge :: (Ord a, Show a) => a -> a -> a -> a -> a
hoge sx xxs sy yys = tracing (printf "huga %s %s %s %s" (show sx) (show xxs) (show sy) (show yys))
(
case yys of
[] -> case xxs of
x -> reverse (x : tail sy)
x:xs@(_:_) -> case splitBy sx (reverse sy) of
(ws,_:zs) -> case ws ++ x : zs of
vvs@(_:vs) -> hoge (x:sx) (dropBy sx vs) [] vvs
y:ys -> case xxs of
x:xs | x < y -> hoge sx (y:xs) (x:sy) ys
| otherwise -> hoge sx (x:xs) (y:sy) ys
)
sample :: Int
sample = 7,1,8,5,3,6,2,4
splitBy :: b -> a -> (a,a)
splitBy [] xs = ([], xs)
splitBy (_:ys) [] = ([],[])
splitBy (_:ys) (x:xs) = case splitBy ys xs of
(ws, zs) -> (x:ws, zs)
dropBy :: a -> a -> a
dropBy xs ys = snd (splitBy xs ys)