module DeBruijn where

import Midi ;
import ListLive ;
import List ;
import Pitch ;
import Bool ;
import Integer ;
import Prelude ( Integer, fromInteger, fromIntegral, ($), (.), (+), (-), (<), mod ) ;


{-
main :: [Event Message] ;
main =
   [Event (On 60 64), Wait 1000, Event (Off 60 64)]
   ++
   [Event (On 64 64), Wait 1000, Event (Off 64 64)] ;
-}

main :: [ Event (Channel Message) ] ;
main :: [Event (Channel Message)]
main =
   Integer -> [Event Message] -> [Event (Channel Message)]
forall a. Integer -> [Event a] -> [Event (Channel a)]
channel Integer
0 ([Event Message] -> [Event (Channel Message)])
-> [Event Message] -> [Event (Channel Message)]
forall a b. (a -> b) -> a -> b
$ Integer -> [Event Message] -> [Event Message]
forall a. Integer -> [Event a] -> [Event a]
changeTempo Integer
timeUnit ([Event Message] -> [Event Message])
-> [Event Message] -> [Event Message]
forall a b. (a -> b) -> a -> b
$
   (Integer -> [Event Message]) -> [Integer] -> [Event Message]
forall a b. (a -> [b]) -> [a] -> [b]
concatMap (Integer -> Integer -> [Event Message]
note Integer
qn (Integer -> [Event Message])
-> (Integer -> Integer) -> Integer -> [Event Message]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
makePitch) ([Integer] -> [Event Message]) -> [Integer] -> [Event Message]
forall a b. (a -> b) -> a -> b
$
   [Integer] -> [Integer]
forall a. [a] -> [a]
cycle ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [Integer]
deBruijnSequence Integer
4 Integer
2 ;

makePitch :: Integer -> Pitch ;
makePitch :: Integer -> Integer
makePitch Integer
0 = Integer -> Integer
c Integer
4 ;
makePitch Integer
1 = Integer -> Integer
e Integer
4 ;
makePitch Integer
2 = Integer -> Integer
g Integer
4 ;
makePitch Integer
_ = Integer -> Integer
c Integer
5 ;


-- * De Bruijn sequence generation based on lists

nextLyndonWord :: Integer -> Integer -> [Integer] -> [Integer] ;
nextLyndonWord :: Integer -> Integer -> [Integer] -> [Integer]
nextLyndonWord Integer
n Integer
k =
   (Integer -> [Integer] -> [Integer])
-> [Integer] -> [Integer] -> [Integer]
forall b a. (b -> a -> a) -> a -> [b] -> a
foldr (Integer -> Integer -> [Integer] -> [Integer]
checkLyndonElement Integer
n) [] ([Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
k) ([Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Integer]
forall a. [a] -> [a]
cycle ;

checkLyndonElement :: Integer -> Integer -> [Integer] -> [Integer] ;
checkLyndonElement :: Integer -> Integer -> [Integer] -> [Integer]
checkLyndonElement Integer
n Integer
x [] = Bool -> [Integer] -> [Integer] -> [Integer]
forall a. Bool -> a -> a -> a
ifThenElse (Integer
xInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) [Integer
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1] [] ;
checkLyndonElement Integer
_ Integer
x [Integer]
xs = Integer
xInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
xs ;

deBruijnSequence :: Integer -> Integer -> [Integer] ;
deBruijnSequence :: Integer -> Integer -> [Integer]
deBruijnSequence Integer
n Integer
k =
   [[Integer]] -> [Integer]
forall a. [[a]] -> [a]
concat ([[Integer]] -> [Integer]) -> [[Integer]] -> [Integer]
forall a b. (a -> b) -> a -> b
$
   ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Bool
isZero (Integer -> Bool) -> ([Integer] -> Integer) -> [Integer] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
k (Integer -> Integer)
-> ([Integer] -> Integer) -> [Integer] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> ([Integer] -> Int) -> [Integer] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Int
forall a. [a] -> Int
length) ([[Integer]] -> [[Integer]]) -> [[Integer]] -> [[Integer]]
forall a b. (a -> b) -> a -> b
$
   ([Integer] -> Bool) -> [[Integer]] -> [[Integer]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> ([Integer] -> Bool) -> [Integer] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Bool
forall a. [a] -> Bool
null) ([[Integer]] -> [[Integer]]) -> [[Integer]] -> [[Integer]]
forall a b. (a -> b) -> a -> b
$
   ([Integer] -> [Integer]) -> [Integer] -> [[Integer]]
iterateIntegerList (Integer -> Integer -> [Integer] -> [Integer]
nextLyndonWord Integer
n Integer
k) [Integer
0] ;


-- Another efficient approach might be encoding the Lyndon words as integers.


-- * auxiliary

timeUnit :: Time ;
timeUnit :: Integer
timeUnit = Integer
150 ;

qn :: Integer ;
qn :: Integer
qn = Integer
1 ;