Counting Horses .js

Counting horses without phase alignment

``````function countHorses(sounds) {
function* horsify(leg) { for ( let phase=0;; yield [leg+phase,phase++] ); }
function filter(leg,phase) {
const sounds_ = Array.from(sounds);
for ( let i=leg-1-phase; i in sounds; i += leg )
if ( sounds[i] )
sounds_[i]--;
else
return null;
return sounds_;
}
const leg = 1 + sounds.findIndex(Boolean);
if ( leg )
for ( const horse of horsify(leg) ) {
const r = filter(...horse);
if ( r )
return [ horse, ...countHorses(r) ];
}
else
return [];
}``````

Counting Horses .hs

Counting horses without phase alignment

``````module CountingHorses (countHorses) where

import Data.List (findIndex)
import Data.Foldable (asum)
import Data.Maybe (fromMaybe)

countHorses :: [Int] -> [(Int,Int)]
countHorses sounds = fromMaybe [] \$ ( \ leg -> asum \$ ( \ horse -> (horse :) . countHorses <\$> filter horse ) <\$> [ (leg+phase,phase) | phase <- [0..] ] ) =<< succ <\$> findIndex (/= 0) sounds where
filter (leg,phase) | all (>= 0) sounds' = Just sounds' | otherwise = Nothing where
sounds' = zipWith (-) sounds \$ drop phase \$ cycle \$ replicate (leg-1) 0 ++ [1]``````

Bubble sort .hs

efficient implementation of an inefficient algorithm

``````module BubbleSort where

bubbleSort :: (Ord a) => [a] -> [a]
bubbleSort xs@(_:_:_) = a : bubbleSort as where
a:as = foldr bubble [] xs
bubble x [] = [x]
bubble x (z:zs) | x <= z    = x : z : zs
| otherwise = z : x : zs
bubbleSort xs = xs

bubbleSortBy :: (a -> a -> Ordering) -> [a] -> [a]
bubbleSortBy cmp xs@(_:_:_) = a : bubbleSortBy cmp as where
a:as = foldr bubble [] xs
bubble x [] = [x]
bubble x (z:zs) | cmp x z /= GT = x : z : zs
| otherwise     = z : x : zs
bubbleSortBy _ xs = xs``````

TDD Game: sum

Code
Diff
• ``````module Sum (Sum.sum) where

import Data.Foldable (for_)

sum :: [Int] -> Int
sum xs = execState (for_ xs add) 0 where
add :: Int -> State Int ()
• module Sum (Sum.sum) where
• import Data.Foldable (for_)
• sum :: [Int] -> Int
• sum xs = execState (for_ xs add) 0 where
• add :: Int -> State Int ()
• -- modify (+x)
• y <- get
• put (y + x)
• return ()
• add = modify . (+)
Failed Tests

TDD Game: sum

`for_`: "Map each element of a structure to a monadic action, evaluate these actions from left to right, and ignore the results."

Evaluating the actions leads to a state that should hold the final result ( the sum ).

"Ignore the results" means `add` should always end with `return ()`.

Code
Diff
• ``````module Sum (Sum.sum) where

import Data.Foldable (for_)

sum :: [Int] -> Int
sum xs = execState (for_ xs add) 0 where
add :: Int -> State Int ()
return ()``````
• module Sum (Sum.sum) where
• import Prelude hiding (sum)
• import Data.Foldable (for_)
• sum :: [Word] -> Word
• sum xs = if xs == [] then 0 else foldr1 (+) xs
• sum :: [Int] -> Int
• sum xs = execState (for_ xs add) 0 where
• add :: Int -> State Int ()
• return ()

TDD Game: sum

`sum` is again a oneliner, with a correct but flexible signature.

`foldr` requires `t` to be `Foldable`, `(+)` requires `a` to be `Num`, `0` is also `Num`.

Explain that last test in the comments, or on Discord.

Code
Diff
• ``````module Sum (Sum.sum) where

import Prelude hiding (sum)

sum :: (Foldable t,Num a) => t a -> a
sum = foldr (+) 0``````
• module Sum (Sum.sum) where
• import Prelude hiding (sum)
• sum :: (Foldable t) => t Word -> Word
• sum xs | null xs = 0 | otherwise = foldr1 (+) xs
• sum :: (Foldable t,Num a) => t a -> a
• sum = foldr (+) 0

TDD Game: sum

Get rid of the warnings.

Code
Diff
• ``````module Sum (Sum.sum) where

import Prelude hiding (sum)

sum :: (Foldable t) => t Word -> Word
sum xs | null xs = 0 | otherwise = foldr1 (+) xs``````
• module Sum (Sum.sum) where
• import Prelude hiding (sum)
• sum :: Foldable t => t Word -> Word
• sum :: (Foldable t) => t Word -> Word
• sum xs | null xs = 0 | otherwise = foldr1 (+) xs
Failed Tests

TDD Game: sum

Code
Diff
• ``````module Sum (Sum.sum) where

import Prelude hiding (sum)

sum :: [Word] -> Word
sum xs | null xs = 0 | otherwise = foldr1 (+) xs``````
• module Sum (Sum.sum) where
• import Prelude hiding (sum)
• sum :: [Word] -> Word
• sum xs = if xs == [] then 0 else foldr1 (+) xs
• sum xs | null xs = 0 | otherwise = foldr1 (+) xs

TDD Game: sum

Code
Diff
• ``````module Sum (Sum.sum) where

import Prelude hiding (sum)

sum :: [Word] -> Word
sum xs | null xs = 0 | otherwise = foldr1 (+) xs``````
• module Sum (Sum.sum) where
• import Prelude hiding (sum)
• sum :: [Word] -> Word
• sum xs = if xs == [] then 0 else foldr1 (+) xs
• sum xs | null xs = 0 | otherwise = foldr1 (+) xs

TDD Game: sum

Code
Diff
• ``````module Sum (Sum.sum) where

import Prelude hiding (sum)

sum :: [Word] -> Word
sum [] = 0
sum xs = foldr1 (+) xs``````
• module Sum (Sum.sum) where
• import Prelude hiding (sum)
• sum :: [Word] -> Word
• sum = foldr1 (+)
• sum [] = 0
• sum xs = foldr1 (+) xs

Rules

https://discord.com/channels/846624424199061524/1204166960909127731/1204166965271207936

add all the numbers in the input. return this sum.

Restrictions

Do not use `Prelude.sum`.
I might, later, introduce frameworks ( recursion combinators, monoids, monads ) to work within.

``````module Sum (Sum.sum) where

import Prelude hiding (sum)

sum :: [Word] -> Word
sum = foldr1 (+)``````

Fibonacci .lc

``````#debug

#import combinators.lc
B = \ f g x . f (g x)
I = \ x . x
K = \ x _ . x
T = \ x f . f x

#import binary-scott-number.lc
#  0 =       \ end _even _odd . end
Bit0 = \ n . \ _end even _odd . even n
Bit1 = \ n . \ _end _even odd . odd  n
shift  = \ n . n 0 I I
dbl = \ n . n 0 (K (Bit0 n)) (K (Bit0 n))
succ = \ n . n 1 Bit1 (B Bit0 succ)
pred = \ n . n 0 (B Bit1 pred) dbl
add = \ m n . m n
( \ zm . n m (B Bit0 (add zm)) (B Bit1 (add zm)) )
( \ zm . n m (B Bit1 (add zm)) (B Bit0 (B succ (add zm))) )
mul = \ m n . m 0
( \ zm . n 0
( \ zn . Bit0 (Bit0 (mul zm zn)) )
( \ _z . Bit0 (mul zm n) )
)
( \ zm . n 0
( \ zn . Bit0 (mul m zn) )
( \ zn . Bit1 (add (dbl (mul zm zn)) (add zm zn)) )
)

#import scott-tree.lc
Tree = \ x left right . \ tree . tree x left right # Tree = Tree Number Tree Tree
map = \ fn tree . tree \ x left right . Tree (fn x) (map fn left) (map fn right)
index = \ tree i . tree \ x left right . i x (B (index right) pred) (index left)

tree = Tree 1 (map Bit0 tree) (map Bit1 tree)
memo = \ fn . index (map (B fn pred) tree)

# fibonacci :: Number -> Number
fibonacci = memo \ n .
T (shift (succ n))      \  n' .
T (fibonacci n')        \ fn  .
T (fibonacci (pred n')) \ fn' .
n 0                                            # n == 0
(K (mul fn (add fn (Bit0 fn'))))              # even n
( \ z . z 1                                   # n == 1
(K (add (mul fn fn) (mul fn' fn')))  # odd n
(K (add (mul fn fn) (mul fn' fn')))  # odd n
)``````

Shortest path

Code
Diff
• ``````function dijkstra(tolls,[y0,x0],[yn,xn]) {
const WIDTH = tolls[0].length;
tolls = tolls.flat();
const pos0 = y0 * WIDTH + x0, posN = yn * WIDTH + xn;
const costs = new Map(tolls.map( (_,i) => [i,Infinity] )).set(pos0,0);
const poss = new Heap([ new Entry(0,pos0) ]);
const res = new Map;
while ( poss.size ) {
let { priority: cost, payload: pos } = poss.minView();
if ( pos===posN )
poss.clear();
else if ( Number.isFinite(costs.get(pos)) ) {
costs.delete(pos);
cost += tolls[pos];
for ( const [pos1,dir] of [ [[pos-WIDTH,Up   ],
[pos+WIDTH,Down ]]      ,
pos%WIDTH         ? [[pos-    1,Left ]] : [] ,
pos%WIDTH+1-WIDTH ? [[pos+    1,Right]] : [] ].flat().filter( ([pos]) => costs.has(pos) ) )
if ( cost < costs.get(pos1) )
costs.set(pos1,cost),
poss.insert(new Entry(cost,pos1)),
res.set(pos1,dir);
}
}
return function massage(pos) {
return res.get(pos)===Up    ? [ ...massage(pos+WIDTH), Up    ] :
res.get(pos)===Down  ? [ ...massage(pos-WIDTH), Down  ] :
res.get(pos)===Left  ? [ ...massage(pos+1),     Left  ] :
res.get(pos)===Right ? [ ...massage(pos-1),     Right ] :
[] ;
} ( posN ) ;
}``````
• function path(tolls,[y0,x0],[yn,xn]) {
• function dijkstra(tolls,[y0,x0],[yn,xn]) {
• const WIDTH = tolls[0].length;
• tolls = tolls.flat();
• const pos0 = y0 * WIDTH + x0, posN = yn * WIDTH + xn;
• const costs = new Map(tolls.map( (_,i) => [i,Infinity] )).set(pos0,0);
• const poss = new Heap([ new Entry(0,pos0) ]);
• const res = new Map;
• while ( poss.length ) {
• while ( poss.size ) {
• let { priority: cost, payload: pos } = poss.minView();
• if ( pos===posN )
• poss.length = 0;
• poss.clear();
• else if ( Number.isFinite(costs.get(pos)) ) {
• costs.delete(pos);
• cost += tolls[pos];
• for ( const [pos1,dir] of [ [[pos-WIDTH,Up ],
• [pos+WIDTH,Down ]] ,
• pos%WIDTH ? [[pos- 1,Left ]] : [] ,
• pos%WIDTH+1-WIDTH ? [[pos+ 1,Right]] : [] ].flat().filter( ([pos]) => costs.has(pos) ) )
• if ( cost < costs.get(pos1) )
• costs.set(pos1,cost),
• poss.insert(new Entry(cost,pos1)),
• res.set(pos1,dir);
• }
• }
• return function massage(pos) {
• return res.get(pos)===Up ? [ ...massage(pos+WIDTH), Up ] :
• res.get(pos)===Down ? [ ...massage(pos-WIDTH), Down ] :
• res.get(pos)===Left ? [ ...massage(pos+1), Left ] :
• res.get(pos)===Right ? [ ...massage(pos-1), Right ] :
• [] ;
• } ( posN ) ;
• }

Shortest path

Code
Diff
• ``````function path(tolls,[y0,x0],[yn,xn]) {
const WIDTH = tolls[0].length;
tolls = tolls.flat();
const pos0 = y0 * WIDTH + x0, posN = yn * WIDTH + xn;
const costs = new Map(tolls.map( (_,i) => [i,Infinity] )).set(pos0,0);
const poss = new Heap([ new Entry(0,pos0) ]);
const res = new Map;
while ( poss.length ) {
let { priority: cost, payload: pos } = poss.minView();
if ( pos===posN )
poss.length = 0;
else if ( Number.isFinite(costs.get(pos)) ) {
costs.delete(pos);
cost += tolls[pos];
for ( const [pos1,dir] of [ [[pos-WIDTH,Up   ],
[pos+WIDTH,Down ]]      ,
pos%WIDTH         ? [[pos-    1,Left ]] : [] ,
pos%WIDTH+1-WIDTH ? [[pos+    1,Right]] : [] ].flat().filter( ([pos]) => costs.has(pos) ) )
if ( cost < costs.get(pos1) )
costs.set(pos1,cost),
poss.insert(new Entry(cost,pos1)),
res.set(pos1,dir);
}
}
return function massage(pos) {
return res.get(pos)===Up    ? [ ...massage(pos+WIDTH), Up    ] :
res.get(pos)===Down  ? [ ...massage(pos-WIDTH), Down  ] :
res.get(pos)===Left  ? [ ...massage(pos+1),     Left  ] :
res.get(pos)===Right ? [ ...massage(pos-1),     Right ] :
[] ;
} ( posN ) ;
}``````
• function path(tolls,[y0,x0],[yn,xn]) {
• const WIDTH = tolls[0].length;
• tolls = tolls.flat();
• const pos0 = y0 * WIDTH + x0, posN = yn * WIDTH + xn;
• const costs = new Map([ [pos0,0] ]);
• const costs = new Map(tolls.map( (_,i) => [i,Infinity] )).set(pos0,0);
• const poss = new Heap([ new Entry(0,pos0) ]);
• const unvisited = new Set(tolls.map( (_,i) => i ));
• const res = new Map;
• while ( poss.length ) {
• const { priority: cost, payload: pos } = poss.minView();
• let { priority: cost, payload: pos } = poss.minView();
• if ( pos===posN )
• poss.length = 0;
• else if ( unvisited.has(pos) ) {
• unvisited.delete(pos);
• const toll = tolls[pos];
• else if ( Number.isFinite(costs.get(pos)) ) {
• costs.delete(pos);
• cost += tolls[pos];
• for ( const [pos1,dir] of [ [[pos-WIDTH,Up ],
• [pos+WIDTH,Down ]] ,
• pos%WIDTH ? [[pos- 1,Left ]] : [] ,
• pos%WIDTH+1-WIDTH ? [[pos+ 1,Right]] : [] ].flat().filter( ([pos]) => unvisited.has(pos) ) )
• if ( ! costs.has(pos1) || cost + toll < costs.get(pos1) )
• costs.set(pos1, cost + toll),
• poss.insert(new Entry(cost+toll,pos1)),
• pos%WIDTH+1-WIDTH ? [[pos+ 1,Right]] : [] ].flat().filter( ([pos]) => costs.has(pos) ) )
• if ( cost < costs.get(pos1) )
• costs.set(pos1,cost),
• poss.insert(new Entry(cost,pos1)),
• res.set(pos1,dir);
• }
• }
• return function massage(pos) {
• return res.get(pos)===Up ? [ ...massage(pos+WIDTH), Up ] :
• res.get(pos)===Down ? [ ...massage(pos-WIDTH), Down ] :
• res.get(pos)===Left ? [ ...massage(pos+1), Left ] :
• res.get(pos)===Right ? [ ...massage(pos-1), Right ] :
• [] ;
• } ( posN ) ;
• }

Shortest path

Dijkstra and floodfill implementations

``````function path(tolls,[y0,x0],[yn,xn]) {
const WIDTH = tolls[0].length;
tolls = tolls.flat();
const pos0 = y0 * WIDTH + x0, posN = yn * WIDTH + xn;
const costs = new Map([ [pos0,0] ]);
const poss = new Heap([ new Entry(0,pos0) ]);
const unvisited = new Set(tolls.map( (_,i) => i ));
const res = new Map;
while ( poss.length ) {
const { priority: cost, payload: pos } = poss.minView();
if ( pos===posN )
poss.length = 0;
else if ( unvisited.has(pos) ) {
unvisited.delete(pos);
const toll = tolls[pos];
for ( const [pos1,dir] of [ [[pos-WIDTH,Up   ],
[pos+WIDTH,Down ]]      ,
pos%WIDTH         ? [[pos-    1,Left ]] : [] ,
pos%WIDTH+1-WIDTH ? [[pos+    1,Right]] : [] ].flat().filter( ([pos]) => unvisited.has(pos) ) )
if ( ! costs.has(pos1) || cost + toll < costs.get(pos1) )
costs.set(pos1, cost + toll),
poss.insert(new Entry(cost+toll,pos1)),
res.set(pos1,dir);
}
}
return function massage(pos) {
return res.get(pos)===Up    ? [ ...massage(pos+WIDTH), Up    ] :
res.get(pos)===Down  ? [ ...massage(pos-WIDTH), Down  ] :
res.get(pos)===Left  ? [ ...massage(pos+1),     Left  ] :
res.get(pos)===Right ? [ ...massage(pos-1),     Right ] :
[] ;
} ( posN ) ;
}``````