Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Ronald C. Read. "Every one a winner or how to avoid isomorphism search when cataloguing combinatorial configurations." /Annals of Discrete Mathematics/ 2:107–20, 1978.
Synopsis
- type Code = Word64
- code_len :: Num n => n
- type Bit_Array = [Bool]
- bit_array_complement :: Bit_Array -> Bit_Array
- bit_array_pp :: Bit_Array -> String
- bit_array_parse :: String -> Bit_Array
- bit_array_to_code :: Bit_Array -> Code
- code_to_bit_array :: Int -> Code -> Bit_Array
- bit_array_to_set :: Integral i => Bit_Array -> [i]
- set_to_bit_array :: Integral i => i -> [i] -> Bit_Array
- set_to_code :: Integral i => i -> [i] -> Code
- bit_array_is_prime :: Bit_Array -> Bool
- bit_array_augment :: Bit_Array -> [Bit_Array]
- enumerate_half :: (Bit_Array -> Bool) -> Int -> [(Int, [Bit_Array])]
- set_coding_validate :: [t] -> [t]
- set_encode :: Integral i => [i] -> Code
- set_decode :: Integral i => Int -> Code -> [i]
- set_encode_prime :: Integral i => Z i -> [i] -> [i]
Documentation
bit_array_complement :: Bit_Array -> Bit_Array Source #
Logical complement.
bit_array_parse :: String -> Bit_Array Source #
Parse PP of Bit_Array
.
bit_array_parse "01001" == [False,True,False,False,True]
MSB (BIG-ENDIAN)
bit_array_to_code :: Bit_Array -> Code Source #
code_to_bit_array :: Int -> Code -> Bit_Array Source #
Inverse of bit_array_to_code
.
code_to_bit_array 13 6428 == bit_array_parse "1100100011100"
bit_array_to_set :: Integral i => Bit_Array -> [i] Source #
Bit_Array
to set.
bit_array_to_set (bit_array_parse "1100100011100") == [0,1,4,8,9,10] set_to_code 13 [0,1,4,8,9,10] == 6428
set_to_bit_array :: Integral i => i -> [i] -> Bit_Array Source #
Inverse of bit_array_to_set
, z is the degree of the array.
set_to_code :: Integral i => i -> [i] -> Code Source #
bit_array_to_code
of set_to_bit_array
.
set_to_code 12 [0,2,3,5] == 2880 map (set_to_code 12) (Sro.z_sro_ti_related (flip mod 12) [0,2,3,5])
bit_array_is_prime :: Bit_Array -> Bool Source #
The prime form is the maximum
encoding.
bit_array_is_prime (set_to_bit_array 12 [0,2,3,5]) == False
bit_array_augment :: Bit_Array -> [Bit_Array] Source #
The augmentation rule adds 1
in each empty slot at end of array.
map bit_array_pp (bit_array_augment (bit_array_parse "01000")) == ["01100","01010","01001"]
enumerate_half :: (Bit_Array -> Bool) -> Int -> [(Int, [Bit_Array])] Source #
Enumerate first half of the set-classes under given prime function. The second half can be derived as the complement of the first.
import Music.Theory.Z.Forte_1973 length scs == 224 map (length . scs_n) [0..12] == [1,1,6,12,29,38,50,38,29,12,6,1,1]
let z12 = map (fmap (map bit_array_to_set)) (enumerate_half bit_array_is_prime 12) map (length . snd) z12 == [1,1,6,12,29,38,50]
This can become slow, edit z to find out. It doesn't matter about n. This can be edited so that small n would run quickly even for large z.
fmap (map bit_array_to_set) (lookup 5 (enumerate_half bit_array_is_prime 16))
LSB - LITTLE-ENDIAN
set_encode :: Integral i => [i] -> Code Source #
Encoder for encode_prime
.
map set_encode [[0,1,3,7,8],[0,1,3,6,8,9]] == [395,843]
map (set_to_code 12) [[0,1,3,7,8],[0,1,3,6,8,9]] == [3352,3372]
set_decode :: Integral i => Int -> Code -> [i] Source #
Decoder for encode_prime
.
map (set_decode 12) [395,843] == [[0,1,3,7,8],[0,1,3,6,8,9]]
set_encode_prime :: Integral i => Z i -> [i] -> [i] Source #
Binary encoding prime form algorithm, equalivalent to Rahn.
set_encode_prime Z.z12 [0,1,3,6,8,9] == [0,2,3,6,7,9] Music.Theory.Z.Rahn_1980.rahn_prime Z.z12 [0,1,3,6,8,9] == [0,2,3,6,7,9]