fadno-braids-0.0.5: Braid representations in Haskell

Safe HaskellNone
LanguageHaskell2010

Fadno.Braids

Contents

Description

Braids represented as Haskell types with support for generation and transformations.

Braid Typeclass

Braid is a typeclass over the braid rep itself and its value type. Since a goal of this library is to use braids for non-mathematical purposes (ie music composition), a Braid can be indexed over any Integral type, to support braids representing pitch values in a register for instance.

Generators

All braids are represented using Artin generators as Gen, with Polarity defining the "power" of a generator as Over or Under.

Generator indexes are usually 0-indexed, which differs from the 1-indexed generators in the literature. However, again these braids can represent other ranges of numbers as branch indexes.

Braid instances

Artin creates canonical, "one-at-a-time", generator braids.

Artin [Gen 0 O,Gen 1 U]

MultiGen creates "compressed", "many-at-a-time" braids of Steps, which prevent invalid adjacent generators.

MultiGen [Step (Gen 1 U) [Gen 0 U],Step (Gen 1 O) []]

DimBraid is for creating "padded" braids, since generators cannot express the absence of a cross.

Birman/Ko/Lee generators.

bandGen creates Birman/Ko/Lee-style band generators.

Transformations/Moves

In addition to operations like merge etc, the type Move represents Reidemeister-type isotopy moves. makeTree unfolds a potentially-infinite tree representing all possible applications of a move.

Graphics

renderBraid, renderBraids and renderStrand allow drawings of braids, admitting extra functions for colorizing etc.

renderBraid 60 [colorStrands] "braid.png" $ bandGen 0 5

Synopsis

Braid Types

Braid find/merge/clear

find :: (Integral i, Braid a i, Braid b i) => a i -> b i -> [Loc i] Source #

Find all locations of a sub-braid within a braid.

find' :: (Integral i, Braid b i) => [[Gen i]] -> Int -> i -> b i -> [Loc i] Source #

Find all locations of a sub-braid within a braid, matrix version.

merge :: forall b a. (Integral a, Braid b a) => b a -> b a -> MultiGen a Source #

Merge one braid into another.

mergeAt :: (Integral a, Braid b a) => Int -> a -> b a -> b a -> MultiGen a Source #

Merge one braid into another at offsets.

mergeAt' :: forall a. Integral a => Int -> a -> [[Gen a]] -> [[Gen a]] -> MultiGen a Source #

Matrix version.

clear :: Integral a => Int -> a -> Int -> a -> [[Gen a]] -> [[Gen a]] Source #

Rectangular gen eraser.

clearMerge :: Integral a => [[Gen a]] -> Int -> a -> Int -> a -> [[Gen a]] -> MultiGen a Source #

clear generators and merge. TODO: doesn't clear adjacent gens.

Isotopy/Reidemeister moves

reidemeister2 :: Integral a => Move Artin a Source #

Reidemeister move 2, [s1,s1^-1] === flat

reidemeister3 :: Integral a => [Move Artin a] Source #

Reidemeister move 3, [s1,s2,s1^-1] === [s2^-1,s1,s2], and inverse polarity. Rule: a pattern of [(i,p),(i',p),(i,^p)] moves to [(i',^p),(i,p),(i',p)], where i' = i op i where op is plus or minus; with the reversed lists too.

findMoves :: (Integral i, Braid a i, Braid b i) => Move a i -> b i -> [Loc i] Source #

Locates all move location in a braid.

applyMove :: (Integral i, Braid a i, Braid b i) => Move a i -> Loc i -> b i -> MultiGen i Source #

Apply a move at a location.

moves :: (Integral i, Braid a i, Braid b i) => [Move a i] -> b i -> [(Move a i, [Loc i])] Source #

Test a collection of moves against a braid and pair results with location.

makeTree :: (Integral i, Braid a i, Braid b i) => [Move a i] -> b i -> Tree (MultiGen i, [(Move a i, Loc i)]) Source #

Unfold a tree of all possible move applications on a braid. A permutation is the permuted braid + the [(move,loc)]s that got us there. Thus the root is (original braid, []); children are [(b1,(move,loc))].

Band generators

bandGen :: Integral a => a -> a -> Artin a Source #

Birman, Ko, Lee "band generators" (sigma-s-t)

Braid Graphics