Ad
JohanWiltink

Composite substrings

module CompositeSubstrings (check) where

primes :: (Integral a) => [a]
primes = 2 : ([3..] `minus` composites)

composites :: (Integral a) => [a]
composites = union $ map multiples primes

multiples :: (Integral a) => a -> [a]
multiples n = map (*n) [n..]

minus :: (Integral a) => [a] -> [a] -> [a]
(x:xs) `minus` (y:ys) | x < y  = x : (xs `minus` (y:ys))
                      | x == y = xs `minus` ys
                      | x > y  = (x:xs) `minus` ys

union :: (Integral a) => [[a]] -> [a]
union = foldr merge undefined

merge :: (Integral a) => [a] -> [a] -> [a]
merge (x:xs) ys = x : merge' xs ys

merge' :: (Integral a) => [a] -> [a] -> [a]
merge' (x:xs) (y:ys) | x < y  = x : merge' xs (y:ys)
                     | x == y = x : merge' xs ys
                     | x > y  = y : merge' (x:xs) ys

tails1 :: [a] -> [[a]]
tails1 = takeWhile (not . null) . iterate tail

inits1 :: [a] -> [[a]]
inits1 = foldr ( \ x z -> (x :) <$> [] : z ) []

isComposite n = foldr go undefined composites where
  go composite z | composite > n = False
                 | composite == n = True
                 | otherwise = z

check :: Int -> Bool
check n = not $ any (isComposite . read) $ concatMap tails1 $ inits1 $ show n
JohanWiltink

O(1) snoc?

snoc actually seems to make a faster list than cons

C = \ f x y . f y x
K = \ x _ . x

cons = \ x xs . \ c n . c x (xs c n)
nil = \ _c n . n
snoc = \ xs x . \ c n . xs c (c x n)

succ = \ n . \ s z . s (n s z)

xs = 15 2 (C snoc ()) nil
xs = 15 2 (  cons ()) nil

result = xs (K succ) 0
JohanWiltink

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 [];
}
JohanWiltink

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]
JohanWiltink

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
JohanWiltinkvs.hobovsky

TDD Game: sum

Code
Diff
  • module Sum (Sum.sum) where

import Control.Monad.State (State,execState,modify)
import Data.Foldable (for_)

sum :: [Int] -> Int
sum xs = execState (for_ xs add) 0 where
  add :: Int -> State Int ()
  add = modify . (+)
    • module Sum (Sum.sum) where
    • import Control.Monad.State (State,execState,put, get)
    • import Control.Monad.State (State,execState,modify)
    • import Data.Foldable (for_)
    • sum :: [Int] -> Int
    • sum xs = execState (for_ xs add) 0 where
    • add :: Int -> State Int ()
    • add x = do
    • -- modify (+x)
    • y <- get
    • put (y + x)
    • return ()
    • add = modify . (+)
JohanWiltinkvs.hobovskyFailed 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 Control.Monad.State (State,execState)
import Data.Foldable (for_)

sum :: [Int] -> Int
sum xs = execState (for_ xs add) 0 where
  add :: Int -> State Int ()
  add x = do
    return ()
    • module Sum (Sum.sum) where
    • import Prelude hiding (sum)
    • import Control.Monad.State (State,execState)
    • 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 ()
    • add x = do
    • return ()
JohanWiltinkvs.JohanWiltink

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
JohanWiltinkvs.NunoOliveira

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
JohanWiltinkvs.hobovskyFailed 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
JohanWiltinkvs.hobovsky

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
JohanWiltinkvs.hobovsky

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
JohanWiltink

TDD Game: sum

Rules

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

Task

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 (+)
JohanWiltink

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
   )
JohanWiltinkvs.JohanWiltink

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 ) ;
    • }
Loading more items...