tcalculus-1.0.0: A DSL prototype for structured realtime/reactive functional programing

Copyright(c) David Janin, Simon Archipoff, 2016
Licensesee the LICENSE file in the distribution
Maintainerjanin@labri.fr
Stabilityexperimental
Safe HaskellSafe
LanguageHaskell2010

Tile.Tile

Contents

Description

A handy data structure that generalizes Hudak's notion of Polymorphic Temporal Media (Tiled PTM). See Docs for a step by step introduction to tiles, with examples and pictures of tiles (recommanded).

Otherwise, denoting by (d) a delay of duration d and by (d,v) a value v of duration d, a tile can always be depicted as follows:

that is, a qlist (in black) extended with two synchronization marks (in blue), the input and output root of the tile, positioned over the underlying qlist by delays (in red).

Synopsis

Tile definition

data Tile d iv v Source #

A tile is build over duration type d, input value type iv and output value type v.

Constructors

Tile d d !(QList d iv v) 

Instances

(Tilable d v, (~) * d1 d) => Tilable d (Tile d1 iv v) Source #

Tile are tilable...

Methods

duration :: Tile d1 iv v -> d Source #

stretch :: d -> Tile d1 iv v -> Tile d1 iv v Source #

(Num d, Eq d, Lattice d) => Monad (Tile d iv) Source #

Yet not clear under what conditions Monad axioms are satisfied...

Methods

(>>=) :: Tile d iv a -> (a -> Tile d iv b) -> Tile d iv b #

(>>) :: Tile d iv a -> Tile d iv b -> Tile d iv b #

return :: a -> Tile d iv a #

fail :: String -> Tile d iv a #

Num d => Functor (Tile d iv) Source # 

Methods

fmap :: (a -> b) -> Tile d iv a -> Tile d iv b #

(<$) :: a -> Tile d iv b -> Tile d iv a #

(Num d, Eq d, Lattice d) => Applicative (Tile d iv) Source #

Yet not clear under what conditions Applicative axioms are satisfied...

Methods

pure :: a -> Tile d iv a #

(<*>) :: Tile d iv (a -> b) -> Tile d iv a -> Tile d iv b #

(*>) :: Tile d iv a -> Tile d iv b -> Tile d iv b #

(<*) :: Tile d iv a -> Tile d iv b -> Tile d iv a #

(Num d, Eq d, Lattice d) => Comonad (Tile d iv) Source #

Yet not clear under what conditions Comonad axioms are satisfied...

Methods

extract :: Tile d iv a -> a #

duplicate :: Tile d iv a -> Tile d iv (Tile d iv a) #

extend :: (Tile d iv a -> b) -> Tile d iv a -> Tile d iv b #

(Num d, Eq d, POrd d, POrd v) => Eq (Tile d iv v) Source #

Semantical equality, unfolds recursive definitions.

Methods

(==) :: Tile d iv v -> Tile d iv v -> Bool #

(/=) :: Tile d iv v -> Tile d iv v -> Bool #

(Fractional d, Eq d, Lattice d) => Fractional (Tile d iv v) Source #

For syntactic comfort (with partially defined inverse)

Methods

(/) :: Tile d iv v -> Tile d iv v -> Tile d iv v #

recip :: Tile d iv v -> Tile d iv v #

fromRational :: Rational -> Tile d iv v #

(Num d, Eq d, Lattice d) => Num (Tile d iv v) Source #

For syntactic comfort (with partially defined product)

Methods

(+) :: Tile d iv v -> Tile d iv v -> Tile d iv v #

(-) :: Tile d iv v -> Tile d iv v -> Tile d iv v #

(*) :: Tile d iv v -> Tile d iv v -> Tile d iv v #

negate :: Tile d iv v -> Tile d iv v #

abs :: Tile d iv v -> Tile d iv v #

signum :: Tile d iv v -> Tile d iv v #

fromInteger :: Integer -> Tile d iv v #

(Num d, Show d, Show v) => Show (Tile d iv v) Source # 

Methods

showsPrec :: Int -> Tile d iv v -> ShowS #

show :: Tile d iv v -> String #

showList :: [Tile d iv v] -> ShowS #

(Num d, Eq d, POrd d, POrd v) => POrd (Tile d iv v) Source #

Derived natural partial order, unfolds recursive definitions.

Methods

partialCompare :: Tile d iv v -> Tile d iv v -> Maybe Ordering Source #

pLeq :: Tile d iv v -> Tile d iv v -> Bool Source #

pOrdEq :: Tile d iv v -> Tile d iv v -> Bool Source #

pOrdMin :: [Tile d iv v] -> Maybe (Tile d iv v) Source #

pOrdMax :: [Tile d iv v] -> Maybe (Tile d iv v) Source #

pOrdReduceMin :: [Tile d iv v] -> [Tile d iv v] Source #

pOrdReduceMax :: [Tile d iv v] -> [Tile d iv v] Source #

Updatable (Tile d iv v) d iv Source #

For on-the fly updates

Methods

update :: UpdateData d iv -> Tile d iv v -> Tile d iv v Source #

Setters

Primitive setters

zeroT :: Num d => Tile d iv v Source #

The zero tile

fromValueT :: Tilable d v => v -> Tile d iv v Source #

Creates a tile from a tilable value.

Warning: tile made out of functions have default infinite duration (see Tile.Tilable for more details), that is, they'll be applicable at nauseam when applyed with evalT or evalOnV. For finite explicit applicability, use fromDurationAndValueT or setDurationT.

setDurationT :: d -> Tile d iv v -> Tile d iv v Source #

Sets the duration of a tile (unchanging its contents)

fromDurationT :: Num d => d -> Tile d iv v Source #

Creates a tile from a duration

fromDurationAndValueT :: Num d => d -> v -> Tile d iv v Source #

Creates a tile from a duration and a value

Conversion functions (qlist - tiles)

toQList :: (Num d, Lattice d) => Tile d iv v -> QList d iv v Source #

Turns a tile into a qlist

fromQList :: Num d => QList d iv v -> Tile d iv v Source #

Turns a qlist into a tile. The following properties are satisfied:

toQList . fromQList q == q
not (hasAnticipationT t) => fromQList . toQList t == re[t]

Explicit recursion

recT :: (Eq d, Num d, Lattice d, Updatable p d iv) => (p -> Tile d iv v1 -> Tile d iv v2) -> p -> Tile d iv v1 -> Tile d iv v2 Source #

Recursive call for the tile (f p t) with parameter p and tile t. The computation is frozen until the last moment, the parameter p being Updatable for on-the-fly updates till that moment.

Concerning anticipation, the following property is required:

delayToTailT (recT f p t) == 0

that is, any negative anticipation resulting from the recursion is discarded.

Concerning duration, the following property is always satisfied:

durationT (recT f p t) == durationT t

reduceT :: (Num d, Eq d, POrd d) => Tile d iv v -> Tile d iv v Source #

Reduces successive delays without atoms in a tile (may unfold immediate recursive definition)

Num and Fractional instance functions

plusT :: (Eq d, Lattice d, Num d) => Tile d iv v -> Tile d iv v -> Tile d iv v Source #

Sums two tiles, that is, synchronizes the output root of the first with the input root of the second and merges the underlying timed lists of temporal values.

t == t + 0, t == 0 + t and t1 + (t2 + t3) == (t1 + t2)+t3

Warning: the sum is not commutative as it places its arguments in time and time is not commutative.

Remark : tiles equiped with tile sum form an inverse with negation as semigroup inverse.

negateT :: Num d => Tile d iv v -> Tile d iv v Source #

Negates a tile, that is, permute its input and output root. It satisfies:

t == - (- t) and - (t1 + t2) == -t2 -t1

Warning: as sum is not commutative, the order of t1 and t2 above does matter.

Also, following inverse semigroup theory, -t is the unique tile such that

t == t - t + t and -t == -t + t -t

In particular, we have

re [t] == t - t, co [t] = - t + t

fromIntegerT :: Num d => Integer -> Tile d iv v Source #

converts integers into delays

fromIntegerT (n1 + n2) == fromIntegerT n1 + fromIntegerT n2

fromRationalT :: Fractional d => Rational -> Tile d iv v Source #

converts rationals into delays

fromRationalT (r1 + r2) == fromRationalT r1 + fromRationalT r2

stretchT :: (Num d, Lattice d) => d -> Tile d iv v -> Tile d iv v Source #

stretch the duration and content of a tile by the specified factor, taking first the negation when negative.

stretchT 1 t == t, stretchT (-1) t = -t
(0 <= d) => stretchT d (t1 + t2)  == stretchT d t1 + stretchT d t2
(d <= 0) => stretchT d (t1 + t2)  == stretchT d t2 + stretchT d t1

multT :: (Eq d, Num d, Lattice d) => Tile d iv v -> Tile d iv v -> Tile d iv v Source #

essentially defined by

multT t1 t2 = plusT (stretchT (durationT t2) t1) (stretchT (durationT t1) t2)

Warning: product may not distribute over sum while positive delays do.

if (durationT t >= 0 ) then delayT t * (t1 + t2) == delayT t * t1 + delayT t * t2
if (durationT t >= 0 ) then (t1 + t2) * delayT t == t1 * delayT t + t2 * delayT t

With negative duration, sums are switched.

if (durationT t <= 0 ) then delayT t * (t1 + t2) == delayT t * t2 + delayT t * t1
if (durationT t <= 0 ) then (t1 + t2) * delayT t == t2 * delayT t + t1 * delayT t

recipT :: (Fractional d, Lattice d) => Tile d iv v -> Tile d iv v Source #

Essentially defined by

recipT t = stretchT (1 / (durationT t) / (durationT t)) t

Fails when duration is not constant.

Warning : t/t may not be equal to 1. However, we have

(durationT t /= 0) => durationT (t/t) == 1 and t = t*t/t

Remark : tiles of non zero duration equipped with tile product form an inverse monoid with recipT as inverse. Then, the induced natural order coincide with the natural order induced by the additive inverse monoid.

Getters

Basic getters

isDelayT :: (Num d, Eq d) => Tile d iv v -> Bool Source #

True when is a delay

hasAnticipationT :: (Num d, Eq d, POrd d, Lattice d) => Tile d iv v -> Bool Source #

True when there is a negative anticipation

Delays and durations

delayT :: (Eq d, Num d) => Tile d iv1 v1 -> Tile d iv2 v2 Source #

Gets the (tile) delay defined from the input root to the ouput root of a tile

delayT (- t) == - delayT t
delayT (t1 + t2) == delayT t1 + delayT t2
delayT (t1 * t2) == delayT t1 * delayT t2

durationT :: Tile d iv v -> d Source #

Gets the duration of a tile, that is the (relative) distance from its input root to its output root.

delayT t == fromDurationT (durationT t)

Normalization operators

headT :: (Eq d, Num d, POrd d) => Tile d iv v -> Tile d iv v Source #

Gets the head of a tile, that is, the bundle (possibly empty) of atoms at the input root and the duration to the next earliest one, or, in the absence of any atoms in the tile, the duration of the tile.

tailT :: (Eq d, Num d, POrd d) => Tile d iv v -> Tile d iv v Source #

Gets the tail of a tile, that is, the remainder of the tile after the heads, or, in the absence of atoms, the zero tile.

Invariant property :

t == headT t + tailT t

atomsT :: (Eq d, Num d) => Tile d iv v -> [Tile d iv v] Source #

Gets the bundle of temporal values at the input root

delayToTailT :: (Eq d, Num d, POrd d) => Tile d iv v1 -> Tile d iv v2 Source #

Gets the non zero delay from the input root to the earliest bundle of temporal values, or to the ouput root if none.

Invariant properties

delayToTailT t == delayT (headT t)
headT t == re (atomsT t) + delayToTailT t
headT t == re (atomsT (headT t)) + delayT (headT t)

getAllFromAtomsT :: (Eq d, Num d) => Tile d iv v -> [(d, v)] Source #

Gets the duration and values of atomsT (usefull ?)

Inverse semigroup derived operators

re :: (Num d, Eq d, Lattice d) => [Tile d iv v] -> Tile d iv v Source #

Resets a list of tiles, that is, moves their output roots to their input roots and sum them up. Properties derived from inverse semigroup theory.

re []  == 0
re (t:ts)  == t - t + re ts
t is idempotent if and only if t == re [t]
re l == co (map negateT l)
Idempotents commute

co :: (Num d, Eq d, Lattice d) => [Tile d iv v] -> Tile d iv v Source #

Coresets a list of tiles, that is, moves their input roots to their output roots and sum them up. Properties derived from inverse semigroup theory.

co []  == 0
co (t:ts)  == - t + t + co ts
t is idempotent if and only if t == co [t]
co l == re (map negateT l)

Derived parallel operators

parForkT :: (Eq d, Num d, Lattice d) => Tile d iv v -> Tile d iv v -> Tile d iv v Source #

Starts two tiles in parallel

durationT (parForkT t1 t2) == durationT t2

parJoinT :: (Eq d, Num d, Lattice d) => Tile d iv v -> Tile d iv v -> Tile d iv v Source #

Ends two tiles in parallel

durationT (parJoinT t1 t2) == durationT t1

Taking, dropping and selecting

takeD :: (Eq d, Num d, Lattice d) => d -> Tile d iv v -> Tile d iv v Source #

Takes all bundles of notes that starts strictly before duration d from the input root

durationT (takeD d t) == d
takeD (durationT (headT t)) t == headT t

dropD :: (Eq d, Num d, Lattice d) => d -> Tile d iv v -> Tile d iv v Source #

Drops all bundles of temporal values that starts strictly before some duration d from the input root

durationT (dropT d t) == durationT t - d
dropD (durationT (headT t)) t == tailT t

Invariant property:

t == takeT d t + dropT d t

splitT :: Num d => (b -> Bool) -> Tile d iv b -> Tile d iv (Either b b) Source #

Splits a tile with a boolean function

Playing with delays

minDelayT :: (Num d, Lattice d) => Tile d iv1 v1 -> Tile d iv2 v2 -> Tile d iv v Source #

Take the minimum delay of two tiles. Implemented by:

minDelayT t1 t2 = fromDurationT $ meet [durationT t1, durationT t2]

maxDelayT :: (Num d, Lattice d) => Tile d iv1 v1 -> Tile d iv2 v2 -> Tile d iv v Source #

Take the maximum delay of two tiles. Implemented by:

maxDelayT t1 t2 = fromDurationT $ join [durationT t1, durationT t2]

Various control like class instances

Functor

fmapT :: Num d => (v1 -> v2) -> Tile d iv v1 -> Tile d iv v2 Source #

Maps a value function over all temporal values in a tile with associated Control.Functor instance:

instance Num d => Functor (Tile d iv) where
   fmap = fmapT

Applicative like

applyOnV :: (Eq d, Num d, Lattice d) => Tile d iv (v1 -> v2) -> Tile d iv v1 -> Tile d iv v2 Source #

Applies a tile of functions over values to a tile of values. This function is delay preserving in its second argument:

delayT (applyOnV tf t) == delayT t

The following property also holds:

fmap f t == applyOnV  (fromValueT f) t

however, values that lasts for an infinite time are not much exiting for application.

Remark: this does not lead to an Applicative instance because tile duration gets a bit lost failing to satisfies applicative axioms.

evalOnV :: (Eq d, Num d, Lattice d) => Tile d iv (Either (v1 -> v2) v1) -> Tile d iv v2 Source #

Reduces a tile of functions and arguements into a tile of results. The duration of a function gives the duration of the apply

Monad and comonad like

joinT :: (Eq d, Num d, Lattice d) => Tile d iv (Tile d iv v) -> Tile d iv v Source #

Reduces a tile of tiles into a tile through fmaps. This function is delay preserving.

delayT (joinT t) == joinT (delayT t)

Remark: despite the type of this reduction, this does not lead yet to a Monad instance. This could be solved turning every types into tilable types.

returnT :: Tilable d v => v -> Tile d iv v Source #

Turn a value into a tile

coJoinT :: (Num d, Eq d, Lattice d) => Tile d iv v -> Tile d iv (Tile d iv v) Source #

Turns every atom in a tile into a tile. This function is delay preserving.

delayT (coJoinT t) == coJoinT (delayT t)

The following property is satisfied:

joinT . coJoinT = id

coReturnT :: (Eq d, Num d) => Tile d iv v -> v Source #

Extracts the first value of the first atoms of a tile (fairly useless ?). The following property is satisfied:

coReturnT . returnT = id

Weak functors over duration

fmapDT :: Num d => (d -> d) -> Tile d iv v -> Tile d iv v Source #

Maps a duration function on a tile, though, in this case, the input and ouput duration type must be the same

fmapSigDT :: Num d => (d -> d) -> Tile d iv v -> Tile d iv v Source #

Maps a duration function on the time signature of a tile, not altering its contents

fmapContDT :: Num d => (d -> d) -> Tile d iv v -> Tile d iv v Source #

Maps a duration function on the sigcontent of a tile, not altering its signature.

Remark: In these three functions, the duration type is preserved. This is due to our aim at providing a realtime/reactive implementation of tiles. Changing duration types would mean changing time scale... This makes no difficulties in an out-of-time context (as for reverseT below) but, in realtime/reactive context, there is yet a lot more to be understood...

Reversing time

reverseT :: (Fractional d, Lattice d) => Tile d iv v -> Tile d iv v Source #

Reverses the flow of time, with time origin (center of symmetry) taken midway from input root to output root.

reverseT (fromValueT v) == fromValueT
reverseT (fromDurationT d) == (fromDurationT d)
reverseT (-t) == - reverseT t
reverseT (t1 + t2) == reverseT t2 + reverseT t1
reverseT (stretchT d t) == stretchT d $ reverseT t

Warning: in reactive usage, such a function hides plenty of non causal aspects... far beyond the obvious ones

Other functions (internal use / debug)

unfoldNowT :: (Num d, Eq d, POrd d) => Tile d iv v -> Tile d iv v Source #

Unfold immediately recursive definition in a tile

unfoldT :: Num d => Tile d iv v -> Tile d iv v Source #

Unfold all recursive definitions in a tile (for debug purpose)

normalizeT :: (Eq d, Num d, Lattice d, POrd v) => Tile d iv v -> Tile d iv v Source #

Normalizes a tile