diff --git a/app/Main.hs b/app/Main.hs index 33de990..b095fbb 100755 --- a/app/Main.hs +++ b/app/Main.hs @@ -841,46 +841,23 @@ progToPatIO = do return ctrlPat -retrieveTest :: Bolt.BoltActionT IO [(String, String)] +retrieveTest :: Bolt.BoltActionT IO [Cadence] retrieveTest = do records <- Bolt.query $ Text.pack " \ - \ match (n:Cadence) \ - \ with apoc.coll.randomItem(COLLECT(n)) AS n_0 \ - \ call { \ - \ with n_0 \ - \ call { \ - \ with n_0 \ - \ match (n_0)-[r]->(n_1) \ - \ return r, n_1 \ - \ order by (r.confidence*rand()) desc \ - \ limit 3 \ - \ union all \ - \ with n_0 \ - \ match (n_0)-[r]->(n_1) \ - \ return r, n_1 \ - \ order by r.confidence desc \ - \ limit 1 \ - \ } \ - \ return n_1 \ - \ order by rand() \ - \ limit 3 \ - \ } \ - \ return \ - \ n_1.movement, n_1.chord; \ + \ MATCH (n:Cadence{show:'( pedal -> min )'}) \ + \ WITH n \ + \ MATCH (n)-[r]->(to) \ + \ RETURN to.movement, to.chord \ + \ ORDER BY r.confidence DESC \ + \ LIMIT 30; \ \ " - m <- forM records $ \record -> Text.unpack <$> (record `Bolt.at` "n_1.chord") - c <- forM records $ \record -> Text.unpack <$> (record `Bolt.at` "n_1.movement") --- let cadences = constructCadence <$> zip m c - let cadences = zip m c + m <- forM records $ \record -> Text.unpack <$> (record `Bolt.at` "to.movement") + c <- forM records $ \record -> Text.unpack <$> (record `Bolt.at` "to.chord") + let cadences = constructCadence <$> zip m c +-- let cadences = zip m c return cadences --- m1 <- forM records $ \record -> Text.unpack <$> (record `Bolt.at` "n_1.movement") --- c1 <- forM records $ \record -> Text.unpack <$> (record `Bolt.at` "n_1.chord") --- let cadence1 = head (constructCadence <$> zip m1 c1) :: Cadence --- return $ cadence1 : [] - - --progTest :: (Show a, Num a, Integral a) => IO [[a]] --progTest = do -- pipe <- Bolt.connect $ def { Bolt.version = 3 } @@ -903,4 +880,32 @@ retrieveTest = do progTest = do pipe <- Bolt.connect $ def { Bolt.version = 3 } r <- Bolt.run pipe retrieveTest - return r \ No newline at end of file + return r + + + +---- |representation of a Cadence as a transition to a stucture by an interval +--data Cadence = Cadence (Functionality, (Movement, [PitchClass])) +-- deriving (Eq, Ord) +-- +---- |customised Show instance for readability +--instance Show Cadence where +-- show :: Cadence -> String +-- show (Cadence (functionality, (dist, ps))) = +-- "( " ++ show dist ++ " -> " ++ functionality ++ " )" + + +-- |initialise a 'cadence state' +--initCadenceState +--initCadenceState approach root quality + + + +-- |recieve a 'cadence state' and return a new 'cadence state' +--nextCadence +--nextCadence entropy state + + +-- |generate a sequence of 'cadence states' from an init state +--chainCadence :: (Show a, Num a, Integral a) => a -> IO [[a]] +--chainCadence n init \ No newline at end of file diff --git a/graphdb/dev.cql b/graphdb/dev.cql index e7d75fe..f23914d 100644 --- a/graphdb/dev.cql +++ b/graphdb/dev.cql @@ -2,7 +2,7 @@ match (n:Cadence{show:"( pedal -> min )"}) with n match (n)-[r]->(to) return r, to - order by (r.confidence) desc + order by r.confidence desc limit 10; @@ -11,7 +11,7 @@ WITH n MATCH (n)-[r]->(to) RETURN to.chord, to.movement, r.confidence ORDER BY r.confidence DESC - LIMIT 20; + LIMIT 30; match (n:Cadence{show:"( pedal -> min )"}) diff --git a/src/Lib.hs b/src/Lib.hs index 049731e..ae13f32 100755 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -8,6 +8,7 @@ Chord (Chord), Cadence, i, pitchClass, +readNoteName, mostConsonant, possibleTriads'', toTriad, @@ -20,6 +21,7 @@ sharp, showTriad, dissonanceLevel, toCadence, +initCadenceState, pc, pcSet, simpleInversions, @@ -27,6 +29,7 @@ intervalVector, fromCadence, fromCadence', movementFromCadence, +toMovement, fromMovement', movementFromCadence', transposeCadence, diff --git a/src/MusicData.hs b/src/MusicData.hs index 84883d1..bc0ecd2 100755 --- a/src/MusicData.hs +++ b/src/MusicData.hs @@ -591,6 +591,17 @@ instance Show Cadence where toCadence :: (Chord, Chord) -> Cadence toCadence ((Chord ((_, _), from@(x:_))), (Chord ((_, new), to@(y:_)))) = Cadence (new, (toMovement x y, zeroForm to)) + +type CadenceState = (Cadence, PitchClass) + +-- |interaction friendly interface to initialise a CadenceState +initCadenceState :: (Integral a, Num a) => a -> String -> [a] -> CadenceState +initCadenceState movement note quality = + let approach = toMovement 0 movement + from = toTriad flat [0] + to = toTriad flat $ (+ fromMovement' approach) <$> zeroForm quality + root = readNoteName note + in (toCadence (from, to), pitchClass $ root) -- |mapping from possible Cadence and Pitchclass into next Chord with transposition fromCadence :: (PitchClass -> NoteName) -> PitchClass -> Cadence -> Chord