Category Archives: Uncategorized

Umeboshi – A Haskell Drum Machine

umeboshi

Umeboshi – A Haskell Drum Machine

Umeboshi is a drum machine written in Haskell and built from a Roland 808 sound bank. The drum machine is designed to facilitate poly-rhythmic percussion in non-standard time signatures. It relies heavily on Unboxed Vector types and the Data.WAVE library.

By design, most drum machines facilitate writing drum patterns in common 3/4 and 4/4 time signatures and render the ability to have more unusual rhythms such as an even pentuplet over three quarter notes nearly impossible. This limitation has a coercive effect on the forms of music typically made with drum machines. Umeboshi is an attempt to fill the gap left by such design choices.

Methods such as buildMeasure allow users to write a pentuplet over a three quarter note measure as easily as:

buildMeasure 122 (Time 3 4) [("xxxxx", conga)]

By passing a length five string of either '.' or 'x' and instrument type conga, umeboshi determines that a conga should be played evenly five times over the 3/4 measure. The function makeWavFile (thanks to the wonderful Data.WAVE library) then can produce a wav file of the constructed rhythm.

For a more elaborate example, let’s take a measure of 5/4 and layer a hi tom triplet evenly over the measure, a snare tuplet and otherwise maracas on every other of the underlying quarter notes:


layeredExample = do
  [hiTom, maracas, snare] <- roland808
  let ensemble1 = [("xxx", hiTom),("xx", snare),("x.x.x", maracas)]
  let measure = buildMeasure 122 (Time 5 4) ensemble1

  makeWavFile measure

For the gritty details see this project on GitHub: Umeboshi

Haskell Test Framework

Haskell Test Framework:

The Haskell Test Framework (HTF) supplies unit tests via HUnit and
property tests via QuickCheck. The following code describes some of the
functionality one may find in the test suite for the Attenuations project.
Some other useful tutorials can be found here:

At the top level one can safely disentangle functionality from testing
by creating a RayTracer directory for the former and a Tests directory
for the latter. Now by creating a TestMain.hs with the following lines,
one can import the tests and the modules independently as-well-as define
sub-suites to run individually.

{-# OPTIONS_GHC -F -pgmF htfpp #-}

module AttenuationTest where
import RayTracer.RayLength
import RayTracer.Lattice
import RayTracer.Rhythm
import Test.Framework

import {-@ HTF_TESTS @-} Tests.IndexerTests
import {-@ HTF_TESTS @-} Tests.SymmetryTests
import {-@ HTF_TESTS @-} Tests.XRegionTests

main = htfMain htf_importedTests

symmetryTests = htfMain htf_Tests_SymmetryTests_thisModulesTests
indexerTests = htfMain htf_Tests_IndexerTests_thisModulesTests
xRegionTests = htfMain htf_Tests_XRegionTests_thisModulesTests

Some Subtleties.

QuickCheck versus HUnit:

From ghci one can perform a quickCheck on any property test, prop_ prefixed,
by running something akin to quickCheck prop_someProperty. To run a specific unit
test, simply call the test method directly:

test_rabbits :: IO ()
test_rabbits = do
  let rhythm = take 15 $ rabbits (5,3)
  assertEqual rhythm ".rLrrLr.rLrrLr."

In some cases, one may wish to build a small unit test suite:

import Test.HUnit

test1 = TestCase test_rabbits
test2 = TestCase test_someotherFunction

tests = TestList [TestLabel "rabbits" test1,
                  TestLabel "another" test2]

runSmallSuite = runTestTT tests

Which then returns something like:

Cases: 2  Tried: 2  Errors: 0  Failures: 0
Counts {cases = 2, tried = 2, errors = 0, failures = 0}

Limiting the Range of Test Data:

It may often be the case that a functions domain of validity is limited
to a small subset of its range and testing outside of that range isn’t
very useful. The choose function makes it possible to limit the range
of test values while maintaining statistical randomness. For instance,
verifying that cos (π/2-θ) is the same as sin θ for values between
0 and 2π can be tested:

tol :: Double -> Integer
tol d = round $ d * 10^12

prop_cosToSin = do
  θ <- choose (0, 2*pi)
  return $ (tol.cos) (pi/2 - θ) == (tol.sin) θ

where tol allows for some wiggle room in the approximation.

Playing and then Replaying a test.

Occasionally a test will fail. Along with the error when a test fails
will be a Replay string allowing intentional seeding when replaying
a given test.

replayArg = "Just (TFGenR 15067B55359906C0776B9C0A73ACEE7D9C124B4AE3DAC3AFCB451E04B1EF7BD1 0 31 5 0,28)"

Now, to replay the failed prop_cosToSin test above one only needs to supply
the replayArg above in a new method, prop_cosToSinReplay:

prop_cosToSinReplay =
  withQCArgs (\a -> a { replay = read replayArg })
  prop_cosToSin

main = htfMain htf_Tests_SymmetryTests_thisModulesTests

Fairly General Algebraic Testing:

One of the coolest examples I have seen this far concerns testing
algebraic properties like the associativity of function composition
By importing Text.Show.Functions one can even test this property
with amazingly clean style:

import Text.Show.Functions

prop_ComposeAssoc f g h x =
  ((f . g) . h) x == (f . (g . h)) x
  where types = [f, g, h] :: [Int->Int]

Havel-Hakimi Graphs

Graph: a library for Havel Hakimi Tournaments

The Graph module offers data structures and methods for working with
direct graphs in Haskell. The library is then extended to working examples
of the Havel-Hakimi algorithm.

:l ./../Helpers -- mostly for hhsort

data Vertex = V { name::String, degree::Int} deriving Eq
data Edge = E { source::Vertex, target::Vertex } deriving Eq
data Graph = G { edges::[Edge] } | BadGraph deriving (Eq, Show)
type Degrees = [Int]

vertices :: Graph -> [Vertex]
vertices (G es) = let totV = [target, source] <*> es in f totV []
  where
    f [] acc = acc
    f ((V n d):vs) acc | any (\v -> name v == n) acc = f vs acc
                       | otherwise = f vs ((V n d):acc)

degreesToVerts :: Degrees -> [Vertex]
degreesToVerts ds =  [V (show ss) d | (ss, d) <- zip [1..] ds]

instance Show Vertex where
  show (V a b) = a
instance Show Edge where
  show (E a b) = show a ++ "->" ++ show b

instance Ord Vertex where
  (<=) (V ss n) (V tt m) = n <= m
  (>=) (V ss n) (V tt m) = n >= m

The above data types VertexEdge and Graph are the heart of Graph module.
Each comes with some default methods for accessing sub-types. Being defined explicitly,
vertices :: Graph -> [Vertex] and degreesToVerts :: Degrees -> [Vertex]
appear to be the odd methods out. vertices returns the vertices for a graph,
while degreesToVerts allows us to build a vertex set with expectations for the degree
of each vertex. Next, Some instances of Show are a included to keep things pretty.
Lastly, Ord is extended to Vertex so that we can sort on them.

Now the work horse functions:

havelHakimi :: [Int] -> Bool
havelHakimi (a:[]) = a == 0
havelHakimi (a:as) = havelHakimi.hhsort $
  map (subtract 1) (take a as) ++ drop a as

vertsToGraph :: [Vertex] -> Graph
vertsToGraph verts = rebuildDegs.G $ hh verts []
  where
    havel ((V ss n):as) =
        hhsort $ snd_map (+ (-1)) (take n as) ++ drop n as
    toEdges ((V ss n):as) = [E (V ss n) vert | vert <- take n as]
    snd_map f xs = [V a (f b) | (V a b) <- xs]

    hh [] edgeAccum = edgeAccum
    hh verts edgeAccum =
      let sorted = hhsort verts in
      hh (havel sorted) (edgeAccum ++ toEdges sorted)

rebuildDegs :: Graph -> Graph
rebuildDegs (G es) = G $ map (buildE es) es
  where
    buildV (V n d) tars = V n $ (length.filter (== n)) tars
    buildE es (E v1 v2) =
      let totalV = [name.target, name.source] <*> es in
      E (buildV v1 totalV) (buildV v2 totalV)

degreesToGraph :: Degrees -> Graph
degreesToGraph degs | havelHakimi degs = 
                        vertsToGraph.degreesToVerts $ degs
                    | otherwise = BadGraph

vertsToGraph relies on some not so obvious methods, hhsort and rebuildDegs.
The first is a specialized quicksort which orders vertices from largest degree
to smallest. The algorithm deincrements on the degrees given for the vertices, and so
rebuildDeg is needed to rebuild the degrees of each vertex.
The method degreesToGraph checks that a given set of degrees is graphic in the sense of
Erdős–Gallai, via the Havel-Hakimi algorithm. BadGraph is returned if the given set
of degrees is not graphic, and returns a realization if the set of degrees is graphic.
For example a list of n+1 n’s ought to represent an n-simplex in our scheme.

simplex n = degreesToGraph.take (n+1) $ repeat n
simplex 4
G {edges = [1->2,1->3,1->4,1->5,2->3,2->4,2->5,3->4,3->5,4->5]}

We then see that a 4-simplex is in fact graphic.

Abelian Actions

Abelian Actions on a Zipper

The goal here is to write an Action class which depends on an Abelian data type
and acts on a Zipper type. Composition of left Abelian actions Ab x G -> G and
evaluation are then given in the instance declaration for Action (Zipper v).

I begin by importing some useful modules and then defining a Zipper.

import System.Random
import Text.Printf
import Data.Char

data Zipper a = Z {left :: [a], focus :: a, right :: [a]} deriving (Eq, Ord)

shiftLeft :: Zipper a -> Zipper a
shiftLeft (Z (a:as) b cs) = Z as a (b:cs)

shiftRight :: Zipper a -> Zipper a
shiftRight (Z as b (c:cs)) = Z (b:as) c cs

instance Show a => Show (Zipper a) where
   show (Z a b c) = printf format (ff reverse a) (show b) (ff id c)
    where
      format = "[..%s { %s } %s..]\n"
      ff f = unwords.(map show).f.(take 10)

Notice that we can shiftLeft and shiftRight along our Zipper and further
there is a homespun Show instance so that these potentially infinite Zippers
can be displayed easily.

integers :: Zipper Integer
integers = Z (map negate [1..]) 0 [1..]

alphabet :: Zipper Char
alphabet = Z sahpla 'a' (tail alphas)
  where
    alphas = [chr $ mod n 26 + 97  | n<- [0..]]
    sahpla = [chr $ 122 - mod n 26 | n<- [0..]]
alphabet
[..'u' 'v' 'w' 'x' 'y' 'z' { 'a' } 'b' 'c' 'd' 'e' 'f' 'g' 'h'..]

Ok, so now there are Zippers. Now for an Abelian data type which can be extended
naturally to the Monoid class.

data Abelian = P Int | N Int

instance Eq Abelian where
  (==) (P n) (N m) = (n==m) && (n==0)
  (==) (P n) (P m) = n == m
  (==) (N n) (N m) = n == m

instance Monoid Abelian where
  mappend (P n) (P m) = P $ n + m
  mappend (P n) (N m) | n - m >= 0 = P $ n - m
                      | otherwise = N $ n - m
  mappend (N n) (P m) | m - n >= 0 = P $ m - n
                      | otherwise = N $ m - n
  mappend (N n) (N m) = P $ n + m
  mempty = P 0

Underlying Abelian is the type Int, which can be immediately recognized
as the de facto Abelian Object. Abelian is first extended to the Eq class
so that we can tell when two elements are the same. Next, instances for what is
meant by mempty and mappend are given for Abelian objects. mappend is really
just addition and mempty just 0.

Next, the Action class is defined so that given some Action v one can
compose Abelian operations and evaluate with respect to v. In other words,
the Action class characterizes left actions on v.

Lastly, I give an instance of Action Zipper.

class Action v where -- actions: Ab x G -> G
  compose :: [Abelian] -> v a -> v a
  eval :: Abelian -> v a -> v a

instance Action Zipper where
  compose abs = eval (foldr mappend mempty abs)
  eval (P n) = (!! n).iterate shiftRight
  eval (N n) = (!! n).iterate shiftLeft

Now to test it out! Let’s apply shortRandomWalk :: [Abelian], a list of random Abelian operations, to alphabet and return the zipper’s focus.

shortRandomWalk :: [Abelian]
shortRandomWalk = take (2^15) $ run.(randomRs (-10, 10)).mkStdGen $ 32
  where
    run (x:xs) | x >= 0 = P x : run xs
               | otherwise = N (abs x) : run xs

focus.compose shortRandomWalk $ alphabet
'j'

nice.

Sortable

From Listable to Sortable

Once there is a notion of Listable with its methods acting on its instances like lists,
the notion of Sortable is a natural extension. Here I extend Listables to have behaviors such as sort and shuffle. The sort is a quicksort and the shuffle is a key shuffle.

import System.Random
:l Listable

System.Random is imported here as a method for producing a stream of random numbers is required for a key shuffle.

The next few lines gives a function which produces such a stream. Notice, I am not yet concerned about a random seed.

randos :: [Integer]
randos = randomRs (0, 10^6) $ mkStdGen 32

take 10 randos
[279768,3864,196758,671882,495589,457372,652070,194519,28935,96049]

Next, I introduce the class Sortable. Notice that most ‘special’ methods are supplied by Listable. The Sortable methods are gotten ‘for free’. Lastly, instances of Sortable [a] and Integers are given. The one caveat being that Ord a => [a].

class (Ord s, Listable s) => Sortable s where
  sort, shuffle :: s -> s

  sort ns | ns == unit = unit
          | otherwise = branch smaller ns +++ headL ns +++ branch larger ns
    where
      branch f xs = sort.f (headL xs) $ tailL xs
      smaller n = filterL (<= n)
      larger  n = filterL (>  n)

  shuffle = eval . map snd . sort . zipS randos
    where
      eval = foldr cons unit
      zipS [] s = []
      zipS (x:xs) s | s == unit = []
                    | otherwise = (x, headL s) : zipS xs (tailL s)
                    
instance Sortable Integer where
instance Ord a => Sortable [a] where
sort 23478662345
shuffle 23423423
shuffle [1..10]
sort.shuffle $ [1..10]
22334456678
33243422
[2,9,8,3,1,6,5,7,4,10]
[1,2,3,4,5,6,7,8,9,10]

 

Haskell on Jupyter

HaskellToSpreadsheet

Haskell on Jupyter

Recently, I have found myself leading a Haskell programming meet-up in Santa Fe, New Mexico. We meet downtown at HQ or at Desert Dogs, Mondays around 6pm. This meet-up has been a great opportunity to actually learn to program Haskell well. In an effort to archive our work as a group, I am publishing meet-up notes here.

Haskell Test Framework.

Having a reliable test framework is an amazing thing. Here is a brief collection of notes describing some of the features and organizational structure of the Haskell Test Framework​ (HTF). Most of the examples are designed for my recent work developing a ray tracing algorithm.

Listable.

Here we write some methods for treating Integers as lists in the sense that
we can define notions of take, drop, (:), (++), and unit on Integers. From these we derive further functionality, namely: length, reverse, head, tail, and (!!). Since clearly both Integers and Lists are both instances of the same functionality, we define a class Listable handling both.

Sortable.

Now that there is a Listable class, we extend Listable things to be Sortable things. Put another way, given (Ord a, Listable a) => a we define a class whose instances can be sorted via sort and shuffled via shuffle. The sort is a quick-sort and the shuffle is a key-shuffle.

Vector.

Vector is a module designed to facilitate mathematical vector operations in the hermitian-style. For simplicity, I model only 3 dimensional vectors but allow the underlying fields to be arbitrary. Complex and Double serve as example fields throughout.

Abelian Actions on a Zipper.

The goal here is to write an Action class which depends on an Abelian data type
and acts on a Zipper type. Composition of left Abelian actions Ab x G -> G and
evaluation are then given in the instance declaration for Action (Zipper v).

Havel Hakimi Graphs.

The Swiss-McMahon tournament can be seen as a special case of the Erdős–Gallai theorem and as such, the Havel-Hakimi algorithm can be used to produce graphic tournaments. This module is designed to facilitate the production of these graphs.

Umeboshi – A Haskell Drum Machine.

Umeboshi is a drum machine written in Haskell and built from a Roland 808 sound bank. The drum machine is designed to facilitate poly-rhythmic percussion in non-standard time signatures. It relies heavily Unboxed Vector types and the Data.WAVE library.

Vector

Vector

Vector is a module designed to facilitate mathematical vector operations in the hermitian-style. For simplicity, I model only 3 dimensional vectors but allow the underlying fields to be arbitrary. Complex and Double serve as example fields throughout. The data type ThreeVector has a vector constructor: V3 x x x and a scalar constructor: S xThreeVector then extends the Functor class with fmap mapping over the components in the obvious way.

import Data.Complex

data ThreeVector a = V3 a a a | S a deriving (Eq, Show)

instance Functor ThreeVector where
  fmap f (V3 x y z) = V3 (f x) (f y) (f z)
  fmap f (S x) = S $ f x

The Comp class introduces conjugation for ThreeVectors. Complex types are conjugated while Double types are left invariant.

class Comp c where
    conj :: c -> c

instance Num a => Comp (Complex a) where
    conj = conjugate

instance Comp Double where
    conj = id

instance Comp a => Comp (ThreeVector a) where
  conj = fmap conj
conj (2 :+ 3)
conj $ V3 (1 :+ 2) (3 :+ (-3)) (0 :+ 1)
conj $ V3 1 2 3
2 :+ (-3)
V3 (1 :+ (-2)) (3 :+ 3) (0 :+ (-1))
V3 1.0 2.0 3.0

Now for the heart and soul of any module daring enough to call itself Vector.

The class Vector provides for the four base methods:

  • innerproduct, ()
  • norm, norm
  • evaluation, eval
  • projections, prs

Simultaneously, I extend Num to include ThreeVector. Extending provides meaning for summing, differencing, multiplying and taking the absolute value wrt ThreeVector. Notice that abs relies on and norm relies and abs. This mutual dependency simplifies the code, but requires that both extensions are present at the time of compilation.

instance (Floating a, Num a, Comp a) => Num (ThreeVector a) where
  (+) (V3 a b c) (V3 x y z) = V3 (a+x) (b+y) (c+z)
  (-) (V3 a b c) (V3 x y z) = V3 (a-x) (b-y) (c-z)
  (*) (V3 a b c) (S x) = V3 (a*x) (b*x) (x*x)
  (*) (S x) (V3 a b c) = V3 (a*x) (b*x) (x*x)
  abs vect = fmap sqrt (vect  vect)

class Vector v where
  (<|>) :: (Num a, Comp a) => v a -> v a -> v a
  norm :: (Floating a, Comp a) => v a -> v a
  eval :: Num a => v a -> v a
  prs :: v a -> [a]

instance Vector ThreeVector where
  (<|>) (V3 a b c) (V3 x y z) = V3 (conj a *x) (conj b *y) (conj c*z) -- Hermitian
  eval (V3 a b c) = S $ a + b + c
  prs (V3 a b c) = [a, b, c]
  norm = eval.abs

Now we can take the Hermitian innerproduct of two complex vectors and return their evaluation.

x = V3 (1 :+ 2) (3 :+ (-3)) (0 :+ 1)
y = V3 (3 :+ 2) (1 :+ 2) (5 :+ (-2))
eval $ x <|> y
S (2.0 :+ 0.0)