Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Marcus Castrén. RECREL: A Similarity Measure for Set-Classes. PhD thesis, Sibelius Academy, Helsinki, 1994.
Synopsis
- type Z12 = Int8
- inv_sym :: [Z12] -> Bool
- sc_t_ti :: [Z12] -> Maybe ([Z12], [Z12])
- t_sc_table :: [(SC_Name, [Z12])]
- t_sc_name :: [Z12] -> SC_Name
- t_sc :: SC_Name -> [Z12]
- t_scs :: [[Z12]]
- t_scs_n :: Integral i => i -> [[Z12]]
- t_subsets :: [Z12] -> [Z12] -> [[Z12]]
- ti_subsets :: [Z12] -> [Z12] -> [[Z12]]
- rle :: (Eq a, Integral i) => [a] -> [(i, a)]
- rle_decode :: Integral i => [(i, a)] -> [a]
- rle_length :: Integral i => [(i, a)] -> i
- t_n_class_vector :: (Num a, Integral i) => i -> [Z12] -> [a]
- ti_n_class_vector :: (Num b, Integral i) => i -> [Z12] -> [b]
- dyad_class_percentage_vector :: Integral i => [Z12] -> [i]
- rel :: Integral i => [Z12] -> [Z12] -> Ratio i
Documentation
inv_sym :: [Z12] -> Bool Source #
Is p symmetrical under inversion.
map inv_sym (Forte.scs_n 2) == [True,True,True,True,True,True] map (fromEnum.inv_sym) (Forte.scs_n 3) == [1,0,0,0,0,1,0,0,1,1,0,1]
t_sc_table :: [(SC_Name, [Z12])] Source #
Transpositional equivalence variant of Forte's sc_table
. The
inversionally related classes are distinguished by labels A
and
B
; the class providing the best normal order (Forte 1973) is
always the A
class. If neither A
nor B
appears in the name of
a set-class, it is inversionally symmetrical.
(length Forte.sc_table,length t_sc_table) == (224,352) lookup "5-Z18B" t_sc_table == Just [0,2,3,6,7]
t_sc_name :: [Z12] -> SC_Name Source #
Lookup a set-class name. The input set is subject to
t_prime
before lookup.
t_sc_name [0,2,3,6,7] == "5-Z18B" t_sc_name [0,1,4,6,7,8] == "6-Z17B"
t_sc :: SC_Name -> [Z12] Source #
Lookup a set-class given a set-class name.
t_sc "6-Z17A" == [0,1,2,4,7,8]
t_scs_n :: Integral i => i -> [[Z12]] Source #
Cardinality n subset of t_scs
.
map (length . t_scs_n) [2..10] == [6,19,43,66,80,66,43,19,6]
t_subsets :: [Z12] -> [Z12] -> [[Z12]] Source #
T-related q that are subsets of p.
t_subsets [0,1,2,3,4] [0,1] == [[0,1],[1,2],[2,3],[3,4]] t_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4]] t_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6]]
ti_subsets :: [Z12] -> [Z12] -> [[Z12]] Source #
T/I-related q that are subsets of p.
ti_subsets [0,1,2,3,4] [0,1] == [[0,1],[1,2],[2,3],[3,4]] ti_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4],[0,3,4]] ti_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6],[3,6,7]]
rle :: (Eq a, Integral i) => [a] -> [(i, a)] Source #
Trivial run length encoder.
rle "abbcccdde" == [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
rle_decode :: Integral i => [(i, a)] -> [a] Source #
Inverse of rle
.
rle_decode [(5,'a'),(4,'b')] == "aaaaabbbb"
rle_length :: Integral i => [(i, a)] -> i Source #
Length of rle encoded sequence.
rle_length [(5,'a'),(4,'b')] == 9
t_n_class_vector :: (Num a, Integral i) => i -> [Z12] -> [a] Source #
T-equivalence n-class vector (subset-class vector, nCV).
t_n_class_vector 2 [0..4] == [4,3,2,1,0,0] rle (t_n_class_vector 3 [0..4]) == [(1,3),(2,2),(2,1),(4,0),(1,1),(9,0)] rle (t_n_class_vector 4 [0..4]) == [(1,2),(3,1),(39,0)]
ti_n_class_vector :: (Num b, Integral i) => i -> [Z12] -> [b] Source #
T/I-equivalence n-class vector (subset-class vector, nCV).
ti_n_class_vector 2 [0..4] == [4,3,2,1,0,0] ti_n_class_vector 3 [0,1,2,3,4] == [3,4,2,0,0,1,0,0,0,0,0,0] rle (ti_n_class_vector 4 [0,1,2,3,4]) == [(2,2),(1,1),(26,0)]
dyad_class_percentage_vector :: Integral i => [Z12] -> [i] Source #
icv
scaled by sum of icv.
dyad_class_percentage_vector [0,1,2,3,4] == [40,30,20,10,0,0] dyad_class_percentage_vector [0,1,4,5,7] == [20,10,20,20,20,10]