diff --git a/ClassicDSD/ClassicDSD.sln b/ClassicDSD/ClassicDSD.sln
new file mode 100644
index 0000000..7ff90f8
--- /dev/null
+++ b/ClassicDSD/ClassicDSD.sln
@@ -0,0 +1,109 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio Version 16
+VisualStudioVersion = 16.0.29215.179
+MinimumVisualStudioVersion = 10.0.40219.1
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CRNEngineDotNet", "..\CRNEngine\CRNEngineDotNet\CRNEngineDotNet.fsproj", "{AE45211A-A65D-4827-A1F9-07A20EB0F154}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Filzbach.FSharp.Portable", "..\Filzbach.FSharp\Filzbach.FSharp.Portable.fsproj", "{2849368F-AC32-4D1E-B6D6-9C52261A5F2D}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "ParserCombinators", "..\ParserCombinators\ParserCombinators\ParserCombinators.fsproj", "{DD8FEC26-6D1D-4642-A706-04070B6D5494}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "ClassicDSDDotNet", "ClassicDSDDotNet\ClassicDSDDotNet.fsproj", "{2A76AA39-6B92-4CDF-8548-A7E9C1833373}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "ClassicDSDCLI", "ClassicDSDCLI\ClassicDSDCLI.fsproj", "{338AFBFF-2D1D-4BE5-B50E-1FD47684C166}"
+ ProjectSection(ProjectDependencies) = postProject
+ {866880DC-BF1E-4C12-8238-72E7EFF44AFB} = {866880DC-BF1E-4C12-8238-72E7EFF44AFB}
+ EndProjectSection
+EndProject
+Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "SundialsSolver15", "..\SundialsSolver\SundialsSolver15\SundialsSolver15.vcxproj", "{866880DC-BF1E-4C12-8238-72E7EFF44AFB}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "ClassicDSDTests", "ClassicDSDTests\ClassicDSDTests.fsproj", "{B88754BD-6CB3-470C-96EF-82A77EB9637E}"
+ ProjectSection(ProjectDependencies) = postProject
+ {866880DC-BF1E-4C12-8238-72E7EFF44AFB} = {866880DC-BF1E-4C12-8238-72E7EFF44AFB}
+ EndProjectSection
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "ReactionDiffusion", "..\PDESolvers\ReactionDiffusion\ReactionDiffusion.fsproj", "{529BEDB7-C73A-4A77-BFD9-1628D75C321B}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CRNEngineTests", "..\CRNEngine\CRNEngineTests\CRNEngineTests.fsproj", "{8E0427CB-DD8F-46BE-A5BC-C02CF55F152D}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CliLibrary", "..\CRNEngine\CliLibrary\CliLibrary.fsproj", "{EEF843A3-43F8-4E6B-AB7F-9ADE3A5AF022}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "RulesDSD", "..\RulesDSD\RulesDSD\RulesDSD.fsproj", "{BA8017D3-FECC-4675-8529-BF66858E01DC}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "MomentClosure", "..\MomentClosure\MomentClosure\MomentClosure.fsproj", "{27E47617-CDB7-41D0-BE9A-2E2A4B8A1538}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "CRNEngineCloudLib", "..\CRNEngine\CRNEngineCloudLib\CRNEngineCloudLib.fsproj", "{BB912929-38DD-4736-899A-1FCC2BF0781A}"
+EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "ClassicDSDRunAllExamples", "ClassicDSDRunAllExamples\ClassicDSDRunAllExamples.fsproj", "{4984BA62-0817-4D38-A158-513F078B8204}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|x64 = Debug|x64
+ Release|x64 = Release|x64
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {AE45211A-A65D-4827-A1F9-07A20EB0F154}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {AE45211A-A65D-4827-A1F9-07A20EB0F154}.Debug|x64.Build.0 = Debug|Any CPU
+ {AE45211A-A65D-4827-A1F9-07A20EB0F154}.Release|x64.ActiveCfg = Release|Any CPU
+ {AE45211A-A65D-4827-A1F9-07A20EB0F154}.Release|x64.Build.0 = Release|Any CPU
+ {2849368F-AC32-4D1E-B6D6-9C52261A5F2D}.Debug|x64.ActiveCfg = Debug|x64
+ {2849368F-AC32-4D1E-B6D6-9C52261A5F2D}.Debug|x64.Build.0 = Debug|x64
+ {2849368F-AC32-4D1E-B6D6-9C52261A5F2D}.Release|x64.ActiveCfg = Release|x64
+ {2849368F-AC32-4D1E-B6D6-9C52261A5F2D}.Release|x64.Build.0 = Release|x64
+ {DD8FEC26-6D1D-4642-A706-04070B6D5494}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {DD8FEC26-6D1D-4642-A706-04070B6D5494}.Debug|x64.Build.0 = Debug|Any CPU
+ {DD8FEC26-6D1D-4642-A706-04070B6D5494}.Release|x64.ActiveCfg = Release|Any CPU
+ {DD8FEC26-6D1D-4642-A706-04070B6D5494}.Release|x64.Build.0 = Release|Any CPU
+ {2A76AA39-6B92-4CDF-8548-A7E9C1833373}.Debug|x64.ActiveCfg = Debug|x64
+ {2A76AA39-6B92-4CDF-8548-A7E9C1833373}.Debug|x64.Build.0 = Debug|x64
+ {2A76AA39-6B92-4CDF-8548-A7E9C1833373}.Release|x64.ActiveCfg = Release|x64
+ {2A76AA39-6B92-4CDF-8548-A7E9C1833373}.Release|x64.Build.0 = Release|x64
+ {338AFBFF-2D1D-4BE5-B50E-1FD47684C166}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {338AFBFF-2D1D-4BE5-B50E-1FD47684C166}.Debug|x64.Build.0 = Debug|Any CPU
+ {338AFBFF-2D1D-4BE5-B50E-1FD47684C166}.Release|x64.ActiveCfg = Release|Any CPU
+ {338AFBFF-2D1D-4BE5-B50E-1FD47684C166}.Release|x64.Build.0 = Release|Any CPU
+ {866880DC-BF1E-4C12-8238-72E7EFF44AFB}.Debug|x64.ActiveCfg = Debug|x64
+ {866880DC-BF1E-4C12-8238-72E7EFF44AFB}.Debug|x64.Build.0 = Debug|x64
+ {866880DC-BF1E-4C12-8238-72E7EFF44AFB}.Release|x64.ActiveCfg = Release|x64
+ {866880DC-BF1E-4C12-8238-72E7EFF44AFB}.Release|x64.Build.0 = Release|x64
+ {B88754BD-6CB3-470C-96EF-82A77EB9637E}.Debug|x64.ActiveCfg = Debug|x64
+ {B88754BD-6CB3-470C-96EF-82A77EB9637E}.Debug|x64.Build.0 = Debug|x64
+ {B88754BD-6CB3-470C-96EF-82A77EB9637E}.Release|x64.ActiveCfg = Release|x64
+ {B88754BD-6CB3-470C-96EF-82A77EB9637E}.Release|x64.Build.0 = Release|x64
+ {529BEDB7-C73A-4A77-BFD9-1628D75C321B}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {529BEDB7-C73A-4A77-BFD9-1628D75C321B}.Debug|x64.Build.0 = Debug|Any CPU
+ {529BEDB7-C73A-4A77-BFD9-1628D75C321B}.Release|x64.ActiveCfg = Release|Any CPU
+ {529BEDB7-C73A-4A77-BFD9-1628D75C321B}.Release|x64.Build.0 = Release|Any CPU
+ {8E0427CB-DD8F-46BE-A5BC-C02CF55F152D}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {8E0427CB-DD8F-46BE-A5BC-C02CF55F152D}.Debug|x64.Build.0 = Debug|Any CPU
+ {8E0427CB-DD8F-46BE-A5BC-C02CF55F152D}.Release|x64.ActiveCfg = Release|Any CPU
+ {8E0427CB-DD8F-46BE-A5BC-C02CF55F152D}.Release|x64.Build.0 = Release|Any CPU
+ {EEF843A3-43F8-4E6B-AB7F-9ADE3A5AF022}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {EEF843A3-43F8-4E6B-AB7F-9ADE3A5AF022}.Debug|x64.Build.0 = Debug|Any CPU
+ {EEF843A3-43F8-4E6B-AB7F-9ADE3A5AF022}.Release|x64.ActiveCfg = Release|Any CPU
+ {EEF843A3-43F8-4E6B-AB7F-9ADE3A5AF022}.Release|x64.Build.0 = Release|Any CPU
+ {BA8017D3-FECC-4675-8529-BF66858E01DC}.Debug|x64.ActiveCfg = Debug|x64
+ {BA8017D3-FECC-4675-8529-BF66858E01DC}.Debug|x64.Build.0 = Debug|x64
+ {BA8017D3-FECC-4675-8529-BF66858E01DC}.Release|x64.ActiveCfg = Release|x64
+ {BA8017D3-FECC-4675-8529-BF66858E01DC}.Release|x64.Build.0 = Release|x64
+ {27E47617-CDB7-41D0-BE9A-2E2A4B8A1538}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {27E47617-CDB7-41D0-BE9A-2E2A4B8A1538}.Debug|x64.Build.0 = Debug|Any CPU
+ {27E47617-CDB7-41D0-BE9A-2E2A4B8A1538}.Release|x64.ActiveCfg = Release|Any CPU
+ {27E47617-CDB7-41D0-BE9A-2E2A4B8A1538}.Release|x64.Build.0 = Release|Any CPU
+ {BB912929-38DD-4736-899A-1FCC2BF0781A}.Debug|x64.ActiveCfg = Debug|Any CPU
+ {BB912929-38DD-4736-899A-1FCC2BF0781A}.Debug|x64.Build.0 = Debug|Any CPU
+ {BB912929-38DD-4736-899A-1FCC2BF0781A}.Release|x64.ActiveCfg = Release|Any CPU
+ {BB912929-38DD-4736-899A-1FCC2BF0781A}.Release|x64.Build.0 = Release|Any CPU
+ {4984BA62-0817-4D38-A158-513F078B8204}.Debug|x64.ActiveCfg = Debug|x64
+ {4984BA62-0817-4D38-A158-513F078B8204}.Debug|x64.Build.0 = Debug|x64
+ {4984BA62-0817-4D38-A158-513F078B8204}.Release|x64.ActiveCfg = Release|x64
+ {4984BA62-0817-4D38-A158-513F078B8204}.Release|x64.Build.0 = Release|x64
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+ GlobalSection(ExtensibilityGlobals) = postSolution
+ SolutionGuid = {56C29614-B08E-4040-9786-80684A0CD3AE}
+ EndGlobalSection
+EndGlobal
diff --git a/ClassicDSD/ClassicDSDBrowserIntegrationTests/ClassicDSDBrowserIntegrationTests.fsproj b/ClassicDSD/ClassicDSDBrowserIntegrationTests/ClassicDSDBrowserIntegrationTests.fsproj
new file mode 100644
index 0000000..5ea3ad3
--- /dev/null
+++ b/ClassicDSD/ClassicDSDBrowserIntegrationTests/ClassicDSDBrowserIntegrationTests.fsproj
@@ -0,0 +1,24 @@
+
+
+
+
+ netcoreapp3.1
+ Exe
+ x64
+ x64
+ true
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/ClassicDSD/ClassicDSDBrowserIntegrationTests/Program.fs b/ClassicDSD/ClassicDSDBrowserIntegrationTests/Program.fs
new file mode 100644
index 0000000..36da6c2
--- /dev/null
+++ b/ClassicDSD/ClassicDSDBrowserIntegrationTests/Program.fs
@@ -0,0 +1,35 @@
+module Program
+
+open System
+open System.Diagnostics
+open Expecto
+open canopy
+open canopy.types
+open canopy.classic
+open Microsoft.Research.CRNIntegrationTestLib
+
+[]
+let main args =
+ let(dir,groups,timeout,args) = Program.separateArgsDist args
+
+ // Start a web server
+ printfn "Starting 'dotnet serve' on %s" dir
+ let serverProcess = Process.Start("dotnet", sprintf "serve -d %s" dir)
+ printfn "'dotnet serve' started, PID = %d" serverProcess.Id
+
+ let result =
+ try
+ let url = "http://localhost:8080"
+ BrowserSetup.configureCanopy timeout
+ let tests = Tests.tests groups Tests.Worker url
+ Program.run args tests
+ finally
+ printfn "Shutting down 'dotnet serve'..."
+ try serverProcess.Kill() with _ -> ()
+ canopy.classic.quit()
+
+ if System.Diagnostics.Debugger.IsAttached then
+ printf "Press any key to exit"
+ System.Console.ReadKey() |> ignore
+
+ result
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDBrowserIntegrationTests/paket.references b/ClassicDSD/ClassicDSDBrowserIntegrationTests/paket.references
new file mode 100644
index 0000000..0d34aef
--- /dev/null
+++ b/ClassicDSD/ClassicDSDBrowserIntegrationTests/paket.references
@@ -0,0 +1,9 @@
+group DOTNETCORE
+
+Canopy
+Expecto
+FSharp.Core
+Selenium.WebDriver
+Selenium.WebDriver.ChromeDriver
+Selenium.WebDriver.GeckoDriver.Win64
+Selenium.WebDriver.MicrosoftWebDriver
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDCLI/App.config b/ClassicDSD/ClassicDSDCLI/App.config
new file mode 100644
index 0000000..e576da0
--- /dev/null
+++ b/ClassicDSD/ClassicDSDCLI/App.config
@@ -0,0 +1,106 @@
+
+
+
+
+
+
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+ True
+
+
+
+
+
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDCLI/ClassicDSDCLI.fsproj b/ClassicDSD/ClassicDSDCLI/ClassicDSDCLI.fsproj
new file mode 100644
index 0000000..25f416f
--- /dev/null
+++ b/ClassicDSD/ClassicDSDCLI/ClassicDSDCLI.fsproj
@@ -0,0 +1,43 @@
+
+
+
+ netcoreapp3.1
+ Exe
+ x64
+ True
+ true
+ ClassicDSD
+
+
+
+
+ PreserveNewest
+
+
+ PreserveNewest
+
+
+ Always
+
+
+
+
+
+
+
+
+
+
+
+ ..\..\Lib\Oslo.FSharp\Oslo.FSharp.dll
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDCLI/Program.fs b/ClassicDSD/ClassicDSDCLI/Program.fs
new file mode 100644
index 0000000..a124c53
--- /dev/null
+++ b/ClassicDSD/ClassicDSDCLI/Program.fs
@@ -0,0 +1,138 @@
+module Microsoft.Research.DSD.Classic
+
+open Microsoft.Research.CliLibrary
+open Microsoft.Research.CRNEngine
+open Microsoft.Research.DNA
+open Argu
+
+type DSDArgs =
+ | Svg
+with
+ interface IArgParserTemplate with
+ member s.Usage =
+ match s with
+ | Svg -> "Create SVG image of the species"
+
+[]
+let main args =
+ // Enforce invariant culture (prevents issues with decimal separators on international systems).
+ System.Threading.Thread.CurrentThread.CurrentCulture <- System.Globalization.CultureInfo.InvariantCulture
+
+ let dsd_parser = ArgumentParser.Create(programName = "ClassicDSD")
+ let dsd_results = dsd_parser.Parse(args, ignoreUnrecognized=true)
+ let export_svg = dsd_results.Contains Svg
+
+ let parser code : Microsoft.Research.CRNEngine.InferenceSiteGraph.IGraph =
+ let crn = Dsd.compile code
+
+ // DSD-specific actions on a compiled program
+ if export_svg
+ then
+ let svg = crn.to_svg() |> Svg.to_string Crn.default_svg_style
+ let name = if crn.name = "" then System.IO.Path.GetFileNameWithoutExtension (Array.last args) else crn.name
+ System.IO.File.WriteAllText (name + "_initials.svg", svg)
+ printfn "Wrote file %s_initials.svg" name
+
+ // Must return InferenceSiteGraph type for generic CLI tool
+ { task = None
+ ; nodes = Map.ofList ["DSDmodel", { top = crn; systems = [] }]
+ ; edges = Map.empty
+ ; expanded = false
+ }
+
+ let parsedArgs = Program.args_results args
+ match Program.get_program_name parsedArgs with
+ | None -> -1
+ | Some path ->
+ let code = Program.string_of_file path
+ let bundle = code |> Dsd.parse
+ if Dsd.is_jit bundle
+ then
+ if Program.hasSimulate parsedArgs
+ then
+ let results =
+ match Dsd.to_jit bundle with
+ | Choice1Of2 classicJit ->
+ let calculus = Dsd.makeDsdCalculus bundle
+ Microsoft.Research.CRNEngine.Jit.simulate classicJit calculus |> snd
+
+ | Choice2Of2 logicJit ->
+ let calculus = Dsd.to_rules_calculus bundle
+ Microsoft.Research.CRNEngine.Jit.simulate logicJit calculus |> snd
+ let _, fileOptions = Program.getFileOptions path parsedArgs
+ let to_file = if fileOptions.horizontal then Io.to_file_horizontal else Io.to_file_vertical
+ let outDir = Simulation.prepareOutputDirectory fileOptions.name fileOptions.copy
+ // let simDir = Simulation.prepareSimulationDirectory outDir i.model i.sweep
+ to_file (System.IO.Path.Combine (outDir, "instance.tsv")) "\t" string results
+ 0
+ else -1
+ else
+ let ret = Program.main parser args
+ ret
+
+ (*
+ let do_rg = ref true
+ let limit = ref 0
+ let do_ss = ref false
+ let do_ss_interactive = ref false
+ let trace_input = ref None
+ let limit_ss = ref 0
+ let animate_reactions = ref false
+ let pause = ref false
+ let in_file = ref ""
+ let verbose = ref false
+ let switches = [ ArgInfo ("-no_rg", ArgType.Clear do_rg, "Do not compute reaction graph")
+ ; ArgInfo ("-limit", ArgType.Int (fun i -> limit := i), "Limit exploration of reaction graph")
+ ; ArgInfo ("-ss", ArgType.Set do_ss, "Compute state space")
+ ; ArgInfo ("-limit_ss", ArgType.Int (fun i -> limit_ss := i), "Limit exploration of state space")
+ ; ArgInfo ("-ss_interactive", ArgType.Set do_ss_interactive, "Explore state space interactively")
+ ; ArgInfo ("-animate_reactions", ArgType.Set animate_reactions, "Generate animated reactions")
+ ; ArgInfo ("-trace_input", ArgType.String (fun s -> trace_input := Some s), "Read interactive input from file")
+ ; ArgInfo ("-pause", ArgType.Set pause, "Pause after execution")
+ ; ArgInfo ("-v", ArgType.Set verbose, "Print .dot to screen") ]
+ let anon_fun s = in_file := s
+ let message = "provide one filename followed by options:"
+ try
+ ArgParser.Parse (switches, anon_fun, message);
+ with Failure s -> printfn "%s" s
+
+ if !in_file = "" then ArgParser.Usage (switches, message); 1
+ else
+ // run_rudimentary ();
+ let program = System.IO.File.ReadAllText(!in_file)
+ let enzymes, toehold_map, strands, ss = SiteGraphReactor.Sitegraphs.compile program
+
+ if !do_rg then
+ let dot = SiteGraphReactor.Sitegraphs.reaction_graph_to_svgdot !limit enzymes toehold_map strands (ss |> Seq.map snd |> List.ofSeq)
+ // let dot = Sitegraphs.to_dot strands ss
+ let out_file = System.IO.Path.ChangeExtension(!in_file, "dot")
+ System.IO.File.WriteAllText(out_file, dot);
+ printfn "Wrote file %s" out_file;
+ if !verbose then printfn "%s" dot
+
+ if !do_ss then
+ let state_space = SiteGraphReactor.States.state_space !limit_ss enzymes toehold_map strands ss
+ let ss_dot = SiteGraphReactor.Sitegraphs.state_space_to_svgdot strands state_space ss
+ let ss_out_file = System.IO.Path.Combine(System.IO.Path.GetDirectoryName !in_file, sprintf "%s_ss.dot" (System.IO.Path.GetFileNameWithoutExtension !in_file))
+ System.IO.File.WriteAllText(ss_out_file, ss_dot);
+ printfn "Wrote state space file %s" ss_out_file;
+ if !verbose then printfn "%s" ss_dot
+
+ if !do_ss_interactive then
+ let next_choice =
+ match !trace_input with
+ | None -> System.Console.ReadLine
+ | Some tf ->
+ let choices = System.IO.File.ReadAllLines tf
+ let n = ref 0
+ fun () ->
+ let c = choices.[!n]
+ n := 1 + !n
+ c
+ SiteGraphReactor.States.state_space_interactive next_choice !limit_ss !animate_reactions enzymes toehold_map strands ss
+
+ if !pause then System.Console.ReadLine () |> ignore;
+
+ 0 // return an integer exit code
+ *)
+
diff --git a/ClassicDSD/ClassicDSDCLI/crossover_individual.dna b/ClassicDSD/ClassicDSDCLI/crossover_individual.dna
new file mode 100644
index 0000000..bce580b
--- /dev/null
+++ b/ClassicDSD/ClassicDSDCLI/crossover_individual.dna
@@ -0,0 +1,99 @@
+directive simulation { final=8.0; points=1000; plots=[] }
+(*directive time h*)
+directive polymers
+directive compilation infinite
+directive simulator deterministic
+directive deterministic {stiff=true}
+directive localconcentrations [ (l1,local); (l2,local); (l3,local); (l4,local) ]
+directive parameters [
+ ka=1.85769618581392;
+ kx=1.25308366310491;
+ kyl=2.06410688539547;
+ ky2=2.06410688539547, {interval=Log; distribution=Uniform(0.005,10.0); variation=Random };
+ kf=1.50017620467483;
+ kl=0.00839768267566365, {interval=Log; distribution=Uniform(0.0001,1.0); variation=Random };
+ local=66041.5482535977;
+ ro=0.154750673030718;
+
+ full=0.75, { interval=Real; distribution=Uniform(0.5, 1.0); variation=Random };
+ NI_A=2.5, { interval=Real; distribution=Uniform(1.0,5.0); variation=Random };
+ NI_B=2.5, { interval=Real; distribution=Uniform(1.0,5.0); variation=Random };
+ T0_A=0.2, { interval=Real; distribution=Uniform(0.1,0.25); variation=Random };
+ T0_B=0.2, { interval=Real; distribution=Uniform(0.1,0.25); variation=Random };
+
+ ZA=0.0; ZB=0.0;
+ T0=0.1; NS=50.0; NF=100.0; NO=0.0; NR=20.0
+]
+directive sweeps [ cA = [ ZA = [1.0]; NO=[5.0] ]; cB = [ ZB = [1.0]; NO=[4.0] ] ]
+directive data [wireA_FAM_170312; wireB_Cy5_170312]
+
+directive inference { burnin = 50000; samples = 50000; thin = 20 }
+
+dom a0 = { colour = "blue"; bind = ka; unbind = 0.0 }
+dom b0 = { colour = "blue"; bind = ka; unbind = 0.0 }
+dom f = { colour = "green"; bind = kf; unbind = 0.0 }
+dom fc = { colour = "purple"; bind = kf; unbind = 0.0 }
+dom x' = { colour = "orange"; bind = kx*ro; unbind = 0.0 }
+dom xc' = { colour = "darkorange"; bind = kx*ro; unbind = 0.0 }
+dom i = { colour = "orange"}
+dom x = { colour = "orange"; bind = kx; unbind = 0.0; subdomains = [x';i] }
+dom xc = { colour = "darkorange"; bind = kx; unbind = 0.0; subdomains = [xc';i] }
+dom y = { colour = "red"; bind = kyl; unbind = 0.0 }
+dom y2 = { colour = "red"; bind = ky2; unbind = 0.0 }
+dom Q = { colour = "black" }
+dom F = { colour = "yellow" }
+new s
+
+(* Species *)
+def input(a0) = {a0^* s*}
+def inter(x,i) = {i^* x^* s*}
+def output(x,r) = {t*}[s]{r^>
+def fuel(f,x,i) = {f^*}[s*]{i^* x^*>
+def rep(y) = {y^*}[s*]{F^}
+def rept(y) = {y^*}[s* t*]{F^}
+def signal() =
+def trigger(y) =
+def start(l,a0,f) = [s]{f^>
+def start_input(l,a0,f) = [a0^ s]
+def start_input_fuel(l,a0,f,x,i) = [a0^ s]::[f^ s*]{i^* x^* s*}
+(*def leaked(l,x,y) = {TOP}:[x^ s]*)
+def mid(l1,l2,x,f) = [s]{f^>
+def end(l,x,y) = {t*}[s]{y^>
+def wireA() =
+ [[ start(l1,a0,f)
+ | mid(l1,l2,x',f)
+ | mid(l2,l3,x',f)
+ | end(l3,x',y) ]]
+def wireB() =
+ [[ start(l1,b0,fc)
+ | mid(l1,l2,xc',fc)
+ | mid(l2,l3,xc',fc)
+ | mid(l3,l4,xc',f)
+ | end(l4,x',y2) ]]
+
+(*def Addition3(NI,NO,full,y,l) =
+( NI * (1.0-full) * [[ start(l,a0,f) ]]
+| (NO - (NI*full)) * [[ mid(l2,l,x',f) | end(l,x',y) ]]
+| rxn [[ start_input_fuel(l,a0,f,x',i) ]] + [[ mid(l2,l,x',f) | end(l,x',y) ]] ->{kl*ro + kl} [[ leaked(l,x',y) ]]
+)*)
+
+(* Modules *)
+def circuitA() =
+( NI_A * full * wireA()
+(*| Addition3(NI_A,NO,full,y,l1)*)
+| NS * input(a0) @ T0_A
+| NF * fuel(f,x',i)
+| NF * fuel(fc,xc',i)
+| NR * rept(y)
+)
+def circuitB() =
+( NI_B * full * wireB()
+(*| Addition3(NI_B,NO,full,y2,l1)*)
+| NS * input(b0) @ T0_B
+| NF * fuel(f,x',i)
+| NF * fuel(fc,xc',i)
+| NR * rept(y2)
+)
+
+(* Program *)
+circuitA()
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDCLI/paket.references b/ClassicDSD/ClassicDSDCLI/paket.references
new file mode 100644
index 0000000..9b0c590
--- /dev/null
+++ b/ClassicDSD/ClassicDSDCLI/paket.references
@@ -0,0 +1,4 @@
+group DOTNETCORE
+
+FSharp.Core
+argu
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDCLI/test_dom_keyword.dna b/ClassicDSD/ClassicDSDCLI/test_dom_keyword.dna
new file mode 100644
index 0000000..2fc64ca
--- /dev/null
+++ b/ClassicDSD/ClassicDSDCLI/test_dom_keyword.dna
@@ -0,0 +1,9 @@
+directive simulation {initial=0; final=7000}
+
+dom 3 = {bind=4.2E-4; unbind=4.0E-2}
+new 5@ 6.5E-4 , 4.0E-3
+
+( 13 * <2 3^ 4>
+| 10 * <4 5^>
+| 10 * <1>[2]:<6>[3^ 4]{5^*}
+)
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDCLI/test_sequencerates.dna b/ClassicDSD/ClassicDSDCLI/test_sequencerates.dna
new file mode 100644
index 0000000..612beba
--- /dev/null
+++ b/ClassicDSD/ClassicDSDCLI/test_sequencerates.dna
@@ -0,0 +1,14 @@
+directive simulation {initial=0; final=7000}
+directive sequenceRates
+
+dom 1 = { seq = CCCAAAACAAAACAAAACAA }
+dom 2 = { seq = CCCTTTTCTAAACTAAACAA }
+dom 3 = { bind = 4.2E-4; unbind = 4.0E-2; seq = TATTCC }
+dom 4 = { seq = CCCTTATCATATCAATACAA }
+dom 5 = { bind = 6.5E-4; unbind = 4.0E-3; seq = GCTA }
+dom 6 = { seq = CCCTTTACATTACATAACAA }
+
+( 13 * <2 3^ 4>
+| 10 * <4 5^>
+| 10 * <1>[2]:<6>[3^ 4]{5^*}
+)
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/AssemblyInfo.fs b/ClassicDSD/ClassicDSDDotNet/AssemblyInfo.fs
new file mode 100644
index 0000000..cb93812
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/AssemblyInfo.fs
@@ -0,0 +1,43 @@
+namespace ClassicDSDDotNet.AssemblyInfo
+
+open System.Reflection
+open System.Runtime.CompilerServices
+open System.Runtime.InteropServices
+
+// General Information about an assembly is controlled through the following
+// set of attributes. Change these attribute values to modify the information
+// associated with an assembly.
+[]
+[]
+[]
+[]
+[]
+[]
+[]
+[]
+
+// Setting ComVisible to false makes the types in this assembly not visible
+// to COM components. If you need to access a type in this assembly from
+// COM, set the ComVisible attribute to true on that type.
+[]
+
+// The following GUID is for the ID of the typelib if this project is exposed to COM
+[]
+
+// Version information for an assembly consists of the following four values:
+//
+// Major Version
+// Minor Version
+// Build Number
+// Revision
+//
+// You can specify all the values or you can default the Build and Revision Numbers
+// by using the '*' as shown below:
+// []
+[]
+[]
+
+[]
+
+do
+ ()
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/ClassicDSDDotNet.fsproj b/ClassicDSD/ClassicDSDDotNet/ClassicDSDDotNet.fsproj
new file mode 100644
index 0000000..11da838
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/ClassicDSDDotNet.fsproj
@@ -0,0 +1,74 @@
+
+
+
+ netstandard2.0
+ true
+ x64
+ x64
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ..\..\Lib\Oslo.FSharp\Oslo.FSharp.dll
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/DSDParser.fs b/ClassicDSD/ClassicDSDDotNet/DSDParser.fs
new file mode 100644
index 0000000..b7c5597
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/DSDParser.fs
@@ -0,0 +1,547 @@
+[]
+module Microsoft.Research.DNA.DSDParser
+
+open Parser
+open Syntax
+open Microsoft.Research.CRNEngine
+open RulesDSD
+open Microsoft.Research.DNA.LogicDSD
+
+(*
+module Expression = Microsoft.Research.CRNEngine.Expression
+module Options = Options
+*)
+type 'site strand = 'site list
+
+(* Syntax *)
+type domain =
+ { name : string
+ ; complemented : bool
+ ; toehold : bool }
+
+type normal_site =
+ { domain : domain
+ ; doc : Value.t }
+
+type tether =
+ { tags : string list
+ ; pos : Types.pos }
+
+type site = Site of normal_site | Tether of tether
+
+type toehold =
+ { name : string
+ ; bind_rate : float
+ ; unbind_rate : float }
+
+type 'site hpl =
+ { loop : 'site strand
+ ; middle : 'site strand
+ ; upper_right : 'site strand
+ ; lower_right : 'site strand }
+
+type 'site m =
+ { upper_left : 'site strand
+ ; lower_left : 'site strand
+ ; middle : 'site strand
+ ; upper_right : 'site strand
+ ; lower_right : 'site strand }
+
+type 'site hpr =
+ { loop : 'site strand
+ ; middle : 'site strand
+ ; upper_left : 'site strand
+ ; lower_left : 'site strand }
+
+type 'site segment =
+ | HairpinLeft of 'site hpl
+ | Middle of 'site m
+ | HairpinRight of 'site hpr
+
+type 'site gate =
+ | Singleton of 'site segment
+ | JoinLower of 'site gate * 'site gate
+ | JoinUpper of 'site gate * 'site gate
+
+type 'site species =
+ | StrandUpper of 'site strand
+ | StrandLower of 'site strand
+ | Gate of 'site gate
+ | LogicDsdProcess of RulesDSD.Syntax.Process // CS: horrible hack: I'm adding this string field to host Logic DSD species, and still be compatible/reuse with the existing parser/process conversion
+
+type 'site complex = int * 'site species list
+
+type 'site t = toehold list * 'site complex list
+
+//let dummy_range = None
+let to_range pos : Value.range = Some (pos, pos)
+
+let to_float pos f = Microsoft.Research.DNA.Value.Float(f, to_range pos)
+//let to_int pos i = Microsoft.Research.DNA.Value.Int(i, to_range pos)
+
+let map_site pos =
+ function
+ | Site s ->
+ let d = Value.Variable(s.domain.name, to_range pos)
+ if s.domain.toehold then
+ Domain.Toe(d, s.doc, s.domain.complemented, None)
+ else
+ Domain.Normal(d, s.domain.complemented, None)
+ | Tether tether ->
+ let domain_tags = tether.tags |> List.map (fun t -> t, 1.0)
+ Domain.Normal(Value.Variable("tether", to_range pos), false, Some (domain_tags, 0))
+
+let to_domains pos = List.map (map_site pos)
+
+let to_segment pos = function
+ | HairpinLeft hpl ->
+ Segment.Hairpin
+ ( to_domains pos hpl.lower_right
+ , to_domains pos hpl.upper_right
+ , to_domains pos hpl.middle
+ , to_domains pos hpl.loop
+ , Segment.Left)
+ | Middle m ->
+ Microsoft.Research.DNA.Segment.Double
+ ( to_domains pos m.lower_left
+ , to_domains pos m.upper_left
+ , to_domains pos m.middle
+ , to_domains pos m.upper_right
+ , to_domains pos m.lower_right)
+ | HairpinRight hpr ->
+ Microsoft.Research.DNA.Segment.Hairpin
+ ( to_domains pos hpr.lower_left
+ , to_domains pos hpr.upper_left
+ , to_domains pos hpr.middle
+ , to_domains pos hpr.loop
+ , Microsoft.Research.DNA.Segment.Right)
+
+let rec to_gate pos = function
+ | Singleton segment -> [[to_segment pos segment]]
+ | JoinLower (gl, gr) ->
+ let ssl = to_gate pos gl
+ let ssr = to_gate pos gr
+ match List.rev ssl, ssr with
+ | (last::l_rest_rev), (first::r_rest) -> (List.rev l_rest_rev)@((last@first)::r_rest)
+ | _,_ -> failwith "malformed gate"
+ | JoinUpper (gl, gr) -> to_gate pos gl @ to_gate pos gr
+
+let start_time pos = to_float pos 0.0
+let starting_at t f x = f (x, t)
+let at_start pos f = starting_at (start_time pos) f
+
+let to_species pos = function
+ | StrandUpper sites -> sites |> List.map (map_site pos) |> Microsoft.Research.DNA.Strand.Upper |> Microsoft.Research.DNA.Species.STRAND
+ | StrandLower sites -> sites |> List.map (map_site pos) |> Microsoft.Research.DNA.Strand.Lower |> Microsoft.Research.DNA.Species.STRAND
+ | Gate gate -> gate |> to_gate pos |> Microsoft.Research.DNA.Species.GATE
+ | LogicDsdProcess p -> Microsoft.Research.DNA.Species.LogicDsdProcess p
+
+let to_process pos (s,t) =
+ match s with
+ | StrandUpper sites -> sites |> List.map (map_site pos) |> Microsoft.Research.DNA.Strand.Upper |> starting_at t Microsoft.Research.DNA.Process.Strand
+ | StrandLower sites -> sites |> List.map (map_site pos) |> Microsoft.Research.DNA.Strand.Lower |> starting_at t Microsoft.Research.DNA.Process.Strand
+ | Gate gate -> gate |> to_gate pos |> starting_at t Microsoft.Research.DNA.Process.Gate
+ | LogicDsdProcess p -> Microsoft.Research.DNA.Process.LogicDsdProcess (p, t)
+
+(* Parsing *)
+let mk_domain ((n, t), c) =
+ { name = n
+ ; complemented = c
+ ; toehold = t }
+
+let mk_site pos (d, doco) =
+ { domain = d
+ ; doc = match doco with Some doc -> doc | None -> to_float pos 1.0 }
+ |> Site
+
+let mk_tether pos tags = Tether { tags = tags; pos = pos }
+
+let pname allowDots = many1Satisfy (fun c -> isLetter c || isDigit c || c = '_' || c = '\'' || (if allowDots then c = '.' else false)) "an identifier"
+let parse_name = pname false
+
+let after p s = p .>>. opt (pstring s) |>> function n, None -> (n, false) | n,_ -> (n,true)
+
+let op_plus pos a b = Value.Op (a, Value.Plus, b, to_range pos)
+let op_minus pos a b = Value.Op (a, Value.Minus, b, to_range pos)
+let op_mul pos a b = Value.Op (a, Value.Mul, b, to_range pos)
+let op_div pos a b = Value.Op (a, Value.Div, b, to_range pos)
+let op_power pos a b = Value.Op (a, Value.Power, b, to_range pos)
+let op_modulo pos a b = Value.Op (a, Value.Modulo, b, to_range pos)
+
+let rec map_value pos = function
+ | Expression.Float f -> Value.Float (f, to_range pos)
+ | Expression.Key s -> Value.Variable (s, to_range pos)
+ | Expression.Plus (e::es) -> es |> List.map (map_value pos) |> List.fold (op_plus pos) (map_value pos e)
+ | Expression.Minus {sub1=a; sub2=b} -> op_minus pos (map_value pos a) (map_value pos b)
+ | Expression.Times (e::es) -> es |> List.map (map_value pos) |> List.fold (op_mul pos) (map_value pos e)
+ | Expression.Divide {div1=a; div2=b} -> op_div pos (map_value pos a) (map_value pos b)
+ | Expression.Power {base_=a; exponent=b} -> op_power pos (map_value pos a) (map_value pos b)
+ | Expression.Modulo {div=a; modulo=b} -> op_modulo pos (map_value pos a) (map_value pos b)
+ | Expression.Ceiling x -> Value.Ceiling (map_value pos x, to_range pos)
+ | Expression.Floor x -> Value.Floor (map_value pos x, to_range pos)
+ | _ -> failwith "unsupported expression"
+
+(*
+ CS: The lookahead of a parenthesis '(' in parse_value disambiguates
+ some ambiguities of the DSD grammar in dealing with expressions,
+ initializations and modules.
+
+ Consider this program P with a module N:
+ P = def N() = <_>
+ ( 3 * N ())
+
+ The inner process in P is supposed to be parsed as:
+ 3 * ( N () )
+
+ However, the Expression parser is greedy and tries to parse 'N' as a value:
+ ( 3 * N ) ()
+
+ and then fails, because "()" is not a valid species.
+ The lookahead verifies that a name is not followed by a parenthesis
+ (and therefore it is not a module).
+ It would be better to restrict the grammar to either change '*' with 'of'
+ in the initialization, or to force composite expressions to be wrapped
+ by parentheses (i.e. 2*3* N() must be written as ( (2*3) * N() )
+*)
+let parse_value_orig = parse_name .>> spaces
+ |> Expression.parse
+ |~> map_value
+let pValue = (pTry (parse_name .>> spaces >>= fun x -> (kw "(" >>. failParser "") <|> preturn x ) )
+ |> Expression.parse
+let parse_value = pValue |~> map_value
+
+let map_values pos = List.map (map_value pos)
+let tuple p = sepBy p (skw ",") |> paren
+
+let rec parse_values st : Parser.Result =
+ let x = parse_value <|> (parse_values |~> fun pos vs -> Value.Tuple (vs, to_range pos) )
+ x |> tuple <| st
+
+let (&>) s p = kw s >>. p
+
+let parse_doc st =
+ (* According to the grammar, an integer can be both an identifier and a float.
+ This introduces an ambiguity when parsing strands. Consider for example:
+ <1^ 2>
+ This can be parsed either as the strand with two sites <(1^) (2)>,
+ or as the strand with a single site with rate 2 <(1^(2))>.
+ If the "pfloat" parser is used in the code below, the grammar always gives
+ precedence to the second interpretation. However, the grammar should
+ prioritize the first interpretation instead. Therefore we have to implement
+ a lookup in the grammar: if we have an integer that is *not* followed by a dot,
+ then the integer is actually an identifier, and the doc parser should return the
+ default value. Otherwise it is a float and should be parsed as such. *)
+ let pdefault pos = to_float pos 1.0
+ choice
+ [ pTry (pint32 >>.
+ choice [ kw "." >>. failParser "" // Float found: fail the current parser and
+ // let the float be parsed by "pfloat"
+ ; fun _ -> OkEmpty (pdefault (snd st), st)]) // Identifier found: return
+ ; pfloat |~> to_float
+ ; parse_value |> paren
+ ; preturn () |~> fun pos () -> pdefault pos]
+ st
+
+let parse_site allowUnderscores name =
+ let domainname_doc = name +>>+ opt (kw "^" >>. parse_doc)
+ let site = after domainname_doc "*" >>= fun ((n, doco), c) (str, pos) ->
+ if n = "_" && not allowUnderscores
+ then Parser.failParser "domain name \"_\" not allowed" (str, pos)
+ else let dom = (mk_domain ((n, doco.IsSome), c), doco) |> mk_site pos
+ Parser.preturn dom (str, pos)
+ let int_name = (name <|> (pint32 |>> string)) +>> spaces
+ let tether = "tether" &> (sepBy1 int_name (skw ",") |> paren) |~> mk_tether
+ (tether .>> spaces) <|> pTry (site .>> spaces )
+
+let sep_by_bars p = sepBy1 p (skw "|")
+
+let mk_hpl loop m (u, l) =
+ { loop = loop
+ ; middle = m
+ ; upper_right = u
+ ; lower_right = l }
+ |> HairpinLeft |> Singleton
+
+let mk_m (ul, ll) m (ur, lr) =
+ { upper_left = ul
+ ; lower_left = ll
+ ; middle = m
+ ; upper_right = ur
+ ; lower_right = lr }
+ |> Middle |> Singleton
+
+let mk_hpr (u, l) m loop =
+ { loop = loop
+ ; middle = m
+ ; upper_left = u
+ ; lower_left = l }
+ |> HairpinRight |> Singleton
+
+let alternatives l =
+ match List.rev (List.map pTry l) with
+ | [] -> choice []
+ | h::t ->
+ h :: (t |> List.map attempt) |> List.rev |> choice
+
+let strand_gate site upperSep lowerSep =
+ let sites = Parser.many1 site
+
+ let upper = sites |> bracket "<" ">"
+ let lower = sites |> bracket "{" "}"
+ let double = sites |> bracket "[" "]"
+ let left_hp = sites |> bracket "<" "}"
+ let right_hp = sites |> bracket "{" ">"
+
+ let overhangs =
+ choice
+ [ upper .>>. (lower <|> preturn [])
+ ; lower .>>. (upper <|> preturn []) >>= fun (b, a) -> preturn (a, b)
+ ; preturn ([], []) ]
+
+ let hpl = pipe3 left_hp double overhangs mk_hpl
+ let hpr = pipe3 overhangs double right_hp mk_hpr
+ let m = pipe3 overhangs double overhangs mk_m
+ let segment = alternatives [hpl; hpr; m]
+
+ let connect_upper = upperSep |>> fun _ l r -> JoinUpper (l, r)
+ let connect_lower = lowerSep |>> fun _ l r -> JoinLower (l, r)
+ let connect = (attempt connect_upper) <|> connect_lower
+ let gate = chainl1 segment connect |>> Gate
+
+ let strand = (upper |>> StrandUpper) <|> (lower |>> StrandLower)
+
+ strand, gate
+
+let do_parse_molecule upperSep lowerSep allowDots allowUnderscore =
+ let strand, gate = pname allowDots |> parse_site allowUnderscore |> fun x -> strand_gate x upperSep lowerSep
+
+ // CS: new: parse a Logic DSD process
+ let logicDsdComplex =
+ let cache = RulesDSD.Syntax.makeProvider ()
+ let siteParser = Microsoft.Research.DNA.LogicDSD.psite Microsoft.Research.DNA.LogicDSD.engine cache true
+ Parser.sqBrackets (RulesDSD.Parser.psystem siteParser)
+ |>> LogicDsdProcess
+
+ Parser.plookAheadWith (
+ Parser.choice [
+ Parser.pTry (Parser.kw "[" >>. Parser.kw "<" >>= fun _ -> preturn true)
+ preturn false
+ ])
+ >>= fun isLogicDSD ->
+ if isLogicDSD
+ then logicDsdComplex
+ else (attempt gate) <|> strand
+
+let parse_molecule_dots = do_parse_molecule (kw "::") (kw ":") true
+let parse_molecule = do_parse_molecule (kw "::") (kw ":") false
+
+
+let at_time = ("@" &> parse_value) |> Parser.opt
+
+let parse_ground_species allowUnderscore =
+ [ parse_name .>>. parse_values .>>. at_time |>> fun ((n, vs), t) -> Process.Instance(n,None,vs,t)
+ ; parse_molecule allowUnderscore .>>. at_time |~> to_process
+ ] |> choice
+
+let parse_species allowUnderscore =
+ [ (parse_ground_species allowUnderscore |> sep_by_bars |> bracket "[[" "]]") +>>+ at_time |>> Process.Origami // NB: currently this allows timed species inside an origami, whereas the original parser does not
+ ; parse_ground_species allowUnderscore
+ ] |> choice
+
+let parse_string = manySatisfy ((<>) '\"') |> bracket "\"" "\""
+
+let subdomain = pTry (parse_name .>> pstring "*" |>> sprintf "%s*") <|> parse_name
+
+let binding =
+ [ "seq" &> ("=" &> parse_name |~> fun pos name -> "seq", Process.DNA (name, to_range pos))
+ ; "colour" &> ("=" &> parse_string |~> fun pos name -> "colour", Process.Colour (name, to_range pos))
+ //; parse_name +>>+ ("=" &> parse_name) |~> fun pos (name, var) -> name, Process.Rate (Value.Variable (var, to_range pos)) TODO: Is this case redundant?
+ ; parse_name +>> kw "=" >>= fun name ->
+ choice [ pTry (after (list_of1 subdomain) "*") |~> fun pos (doms, short) -> name, Process.Subdomains ((doms, short), to_range pos)
+ ; parse_value |>> fun var -> name, Process.Rate var ]
+ ] |> choice
+
+let record = sepEndBy1 binding (skw ";") |> bracket "{" "}"
+
+
+let int_name = parse_name <|> (pint32 |>> string)
+
+let restriction =
+ int_name .>> spaces >>= fun n ->
+ choice [ "@" &> parse_value +>>+ ("," &> parse_value_orig) |>> fun (b, u) -> n, [("bind", Process.Rate(b)); ("unbind", Process.Rate(u))]
+ ; kw "=" >>. preturn n .>>. record
+ ; preturn (n, [])
+ ]
+
+let map_rate _ = function
+ | Rate.MassAction v -> v (*|> map_value pos*) |> Dsdreaction.Crn_ma
+ | Rate.Function f -> f |> Dsdreaction.Crn_func
+
+let to_dsd_reaction pos (r: Reaction, Expression.t>>) =
+ { Dsdreaction.ma_catalysts = r.catalysts
+ ; Dsdreaction.ma_reactants = r.reactants
+ ; Dsdreaction.ma_products = r.products
+ ; Dsdreaction.ma_rate = r.rate |> map_rate pos
+ ; Dsdreaction.ma_reverseRate = r.reverse |> Option.map (map_rate pos) }
+
+let before s p = opt (kw s) .>>. p |>> function None, n -> (false, n) | _, n -> (true, n)
+
+
+(***********************)
+//type TempInitialRecord = failwith ""
+(***********************)
+
+let rec parse_proc st =
+ let pKey = Key.parse (parse_species false)
+ [ "new" &> restriction +>>+ parse_proc |>> Process.New
+ ; pTry (
+ opt (kw "rxn")
+ >>. Reaction.parse // parse a reaction...
+ (parse_species false) // ... with these species ...
+ (Expression.parse parse_name) // ... with these rate values...
+ (Expression.parse pKey)
+ (Expression.Float 1.0) // ... in these rate expressions
+ |~> (fun pos -> to_dsd_reaction pos >> Process.Chemical)
+ "a reaction"
+ )
+ ; pTry ("constant" &> parse_species false
+ |~> fun pos p -> Process.Repeat(Value.Int(1, to_range pos), true, p, None, None))
+
+ ; pTry (parse_species false .>> choice [kw "with"; kw "="] >>= fun p ->
+ let proc = Process.Repeat(Value.Int(0, None), false, p, None, None)
+ Parser.record
+ proc
+ [ "spatial", Spatial_initial.parser |>> fun sp p ->
+ match p with
+ | (Process.Repeat(x,b,p',t,_)) ->
+ Process.Repeat(x,b,p',t, Some sp)
+ | _ -> failwith "Unexpected initial"
+ "time", Value.parse |>> fun t' p ->
+ match p with
+ | (Process.Repeat(x,b,p',_,sp)) ->
+ Process.Repeat(x,b,p',Some t',sp)
+ | _ -> failwith "Unexpected initial"
+ "value", Value.parse |>> fun v' p ->
+ match p with
+ | (Process.Repeat(_,b,p',t,sp)) ->
+ Process.Repeat(v',b,p',t,sp)
+ | _ -> failwith "Unexpected initial"
+ "constant", Parser.pbool .>> spaces |>> fun b' p ->
+ match p with
+ | (Process.Repeat(v,_,p',t,sp)) ->
+ Process.Repeat(v,b',p',t,sp)
+ | _ -> failwith "Unexpected initial" ]
+ |~> fun pos proc -> match proc with
+ | (Process.Repeat(v,b,p,t,sp)) ->
+ let t' = match t with
+ | Some time -> Some (Value.set_range (to_range pos) time)
+ | None -> None
+ Process.Repeat(v,b,p,t',sp)
+ | _ -> failwith "Unexpected initial"
+ )
+ //let initial =
+ //Parser.record ["spatial", id] )
+ ; pTry (before "constant" parse_value +>>+ ((kw "*" <|> kw "of" <|> Parser.preturn "") >>. before "constant" (parse_species false))
+ |~> fun pos ((c1,n), (c2,p)) -> Process.Repeat(n, c1||c2, p, None, None)
+ "species initial"
+ )
+ ; (pTry <| parse_species false) "a species"
+ ; parse_proc |> sep_by_bars |> paren |>> Process.Parallel
+ ] |> choice <| st
+
+
+
+
+let rec parse_parameters st = tuple do_parse_param st
+and
+ do_parse_param =
+ ( (parse_parameters >>= (Pattern.Pat >> preturn))
+ <|> ( parse_name >>= (Pattern.Name >> preturn)))
+
+
+type syn =
+ | Syn_new of ((string * (string * Process.dom_data) list) * bool)
+ | Syn_def of (string * Types.range * Pattern.t list * Process.t)
+ | Syn_val of (string * Value.t)
+ | Syn_proc of Process.t
+
+let rec to_syntax = function
+ | Syn_new (d, b) :: syns -> Syntax.New (d, b, syns |> to_syntax)
+ | Syn_def (n, r, vs, p) :: syns -> Syntax.Definition (n, r, vs, p, syns |> to_syntax)
+ | Syn_val (n, v) :: syns -> Syntax.Value (n, v, syns |> to_syntax)
+ | [Syn_proc p] -> Syntax.Process p
+ | [] -> Syntax.Process(Process.Parallel [])
+ | Syn_proc _ :: _ -> failwith "Multiple processes"
+
+let seq1 f = sepBy1 f spaces
+
+let rec parse_ds =
+ spaces >>. (
+ [ "def" &> parse_name .>> spaces >>=
+ fun name -> ((parse_parameters +>>+ ("=" &> parse_proc) |~> fun pos (ps, p) -> Syn_def (name, to_range pos, ps, p))
+ <|>
+ (("=" &> ((parse_value >>= fun x->preturn [x]) <|>parse_values)
+ |~> fun pos v -> Syn_val (name, match v with
+ | [x] -> x
+ | _ -> Value.Tuple (v, to_range pos) ))))
+ ; "new" &> restriction |>> fun r -> Syn_new (r, true)
+ ; "dom" &> int_name +>>+ ("=" &> record) |>> fun r -> Syn_new (r, false)
+ ; parse_proc +>> eof |>> Syn_proc
+ ]
+ |> choice
+ |> seq1
+ |>> to_syntax)
+
+let rec parse_sg =
+ let provider = RulesDSD.Syntax.makeProvider ()
+ let siteParser = Microsoft.Research.DNA.LogicDSD.psite Microsoft.Research.DNA.LogicDSD.engine provider true
+ let pRulesInitial = (between (kw "[") (kw "]") (RulesDSD.Parser.psystem siteParser))
+ spaces >>.
+ paren (sepBy1 (Expression.parse (name) .>>. pRulesInitial) (kw "|")) .>> eof
+
+let speciesParser = parse_molecule true |~> to_species
+
+let plotParser =
+ // lift the species parser to plots parser
+ let speciesPlotParser = (speciesParser >>= (Syntax.t_plot_base.Molecule >> preturn))
+
+ // module parser
+ let moduleParser = name .>> spaces >>= fun n ->
+ choice [ kw "_" >>. preturn (Syntax.t_plot_base.Module (n, Syntax.plot_pat.All))
+ ; paren (many Value.parse) >>= fun vs ->
+ preturn (Syntax.t_plot_base.Module (n, Syntax.plot_pat.Pats vs))
+ ; preturn (Syntax.t_plot_base.String n) ]
+
+ // a plot is an expression over either a species or a module
+ (speciesPlotParser <|> moduleParser)
+
+let dsdDirectivesParser =
+ //AP//let parseSettings = Microsoft.Research.CRNEngine.Directive.parse plotParser
+ //let parseSettings = Directive>.parse (Expression.parse plotParser)
+ //AP NB TODO: replace plot parser with species parser, to ensure that single variables are treated
+ //as species in the plot parser but as parameters in the rate parser.
+ let pplot = // parse a single species or an expression over species surrounded by sq. brackets
+ (Parser.pTry (plotParser |>> fun s -> Expression.Key (Key.Species s))) <|>
+ (Expression.parse (Key.parse plotParser))
+ let parseSettings = Directive>>.parse
+ (Expression.parse (Key.parse plotParser))
+ pplot
+ let crnDirective = parseSettings |>> Choice1Of2
+ let optDirective = Options.parse_option |>> Choice2Of2
+ InferenceSiteGraph.parseTask .>>. Parser.many (Parser.kw "directive" >>. ( optDirective <|> crnDirective ))
+
+//let updateSettings a b = Crn_settings.update_settings a b
+let updateCfg (crns:Crn_settings<'s>, opts) x =
+ match x with
+ | Choice1Of2 dir -> (crns.from_directive dir, opts)
+ | Choice2Of2 opt -> (crns, List.fold Options.update_options opts opt)
+
+let dsdCfg (task,ds) = (task, List.fold updateCfg (Crn_settings.defaults,
+ Options.default_options) ds)
+
+let parse_settings = dsdDirectivesParser |>> dsdCfg
+let parser = dsdDirectivesParser |>> dsdCfg >>= fun (task, (dirs, opts)) ->
+ match Options.get_rules_program opts with
+ | None -> preturn (task, dirs, opts) .>>. parse_ds .>> eof |>> fun ((a,b,c), e) -> ((a,b,c, None), e)
+ | Some rules -> preturn (task, dirs, opts, rules) .>>. parse_ds .>> eof |>> fun ((a,b,c,d), e) -> ((a,b,c, Some d), e)
+let parse x = Parser.run (spaces >>. parser) x
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/File1.fs b/ClassicDSD/ClassicDSDDotNet/File1.fs
new file mode 100644
index 0000000..997e938
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/File1.fs
@@ -0,0 +1,2 @@
+module File1
+
diff --git a/ClassicDSD/ClassicDSDDotNet/SLConversion.fs b/ClassicDSD/ClassicDSDDotNet/SLConversion.fs
new file mode 100644
index 0000000..fe3ef1a
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/SLConversion.fs
@@ -0,0 +1,898 @@
+[]
+module Microsoft.Research.DNA.SLConversion
+
+open Parser
+open Microsoft.Research.DNA.Syntax
+open Microsoft.Research.CRNEngine
+
+(*
+module DSDParser = Microsoft.Research.DNA.DSDParser
+module E = Microsoft.Research.CRNEngine.Expression
+module Options = Microsoft.Research.DNA.Options
+type SpS<'a> when 'a:equality = Microsoft.Research.CRNEngine.Spatial_settings<'a>
+type SiS<'a> when 'a:equality = Microsoft.Research.CRNEngine.Simulation_settings<'a>
+type Prior = Microsoft.Research.CRNEngine.Prior
+type Units = Microsoft.Research.CRNEngine.Units
+type Time = Microsoft.Research.CRNEngine.Time
+type Concentration = Microsoft.Research.CRNEngine.Concentration
+type Parameter = Microsoft.Research.CRNEngine.Parameter
+type Reaction<'a,'b,'c> when 'a:equality and 'b:equality and 'c:equality = Microsoft.Research.CRNEngine.Reaction<'a,'b,'c>
+module InfSet = Microsoft.Research.CRNEngine.Inference_settings
+module Value = Microsoft.Research.DNA.Value
+module Process = Microsoft.Research.DNA.Process
+*)
+
+(***************************************************************************************
+ *** Old DSD language conversion routine.
+ *** Parses a program written in the SilverLight version of the DSD language and
+ *** translates it into Classic DSD syntax
+ ***************************************************************************************)
+
+
+// utilities
+let spFloat = pfloat .>> spaces
+let spInt = pint32 .>> spaces
+let spBool = choice [ kw "true" >>. preturn true
+ ; kw "false" >>. preturn false] .>> spaces
+let spName = name .>> spaces
+
+let fpMsg = "Floating point conversion not supported"
+let pOldVal sp = choice [ kw "float_of_int" >>= fun _ -> failwith fpMsg
+ ; kw "int_of_float" >>= fun _ -> failwith fpMsg
+ ; pTry (DSDParser.parse_name .>> spaces >>= fun x ->
+ (kw "(" >>. failParser "") <|> preturn x ) ]
+ |> Expression.parse <| sp
+let pOldValue = pOldVal |~> DSDParser.map_value
+
+let rec pOldVals sp = DSDParser.tuple (pOldValue <|> (pOldVals |~> fun pos xs -> Value.Tuple (xs, (DSDParser.to_range pos)))) sp
+
+
+let pOldValues sp = pOldVal |> DSDParser.tuple |~> DSDParser.map_values <| sp
+// old molecules parsing
+let flip (a, b) = (b, a)
+
+let pMolecule upperSep lowerSep =
+ let pSite = DSDParser.parse_site true DSDParser.parse_name
+ let pSites = Parser.many1 pSite
+
+ let upper = bracket "<" ">" pSites
+ let lower = bracket "{" "}" pSites
+ let double = bracket "[" "]" pSites
+
+ let overhangs =
+ choice
+ [ upper .>>. (lower <|> preturn [])
+ ; lower .>>. (upper <|> preturn []) >>= fun (b, a) -> preturn (a, b)
+ ; preturn ([], []) ]
+
+ let pLeftHairpinOrOverhangs =
+ kw "<" >>. pSites >>= fun a ->
+ choice [ kw "}" >>. preturn (Choice1Of2 a) // left hairpin
+ ; kw ">" >>. preturn a .>>. (lower <|> preturn []) >>= (Choice2Of2 >> preturn)]
+
+ let rightHairpinOrOverhangs (a, b) =
+ choice [ kw "{" >>. pSites >>= fun c ->
+ choice [ kw ">" >>. preturn (DSDParser.mk_hpr a b c) // right hairpin
+ ; kw "}" >>. preturn c .>>. (upper <|> preturn []) >>= (flip >> DSDParser.mk_m a b >> preturn) ]
+ ; upper .>>. (lower <|> preturn []) >>= (DSDParser.mk_m a b >> preturn)
+ ; preturn (DSDParser.mk_m a b ([], []))
+ ]
+
+ let pStr (a : DSDParser.site list * DSDParser.site list) =
+ match a with
+ | ([], []) -> failParser "a strand"
+ | ([], ls) -> preturn (DSDParser.StrandLower ls)
+ | (hs, []) -> preturn (DSDParser.StrandUpper hs)
+ | _ -> failParser "a strand"
+ let pSegment =
+ choice
+ [ pLeftHairpinOrOverhangs >>= fun a ->
+ choice [ double >>= fun b ->
+ match a with
+ | Choice1Of2 a' -> overhangs >>= (DSDParser.mk_hpl a' b >> DSDParser.Gate >> preturn)
+ | Choice2Of2 a' -> rightHairpinOrOverhangs (a', b) >>= (DSDParser.Gate >> preturn)
+ ; (match a with
+ | Choice2Of2 z -> pStr z
+ | _ -> failParser "a strand") ]
+ ; overhangs >>= fun a ->
+ choice [ double >>= fun b -> (a, b) |> rightHairpinOrOverhangs >>= (DSDParser.Gate >> preturn)
+ ; pStr a ] ]
+
+ let pItem = pSegment |~> DSDParser.to_species
+ let pSeq = pItem .>>. many ((upperSep <|> lowerSep) .>>. pItem)
+
+ let res = pSeq |~> fun pos (x, y) -> Microsoft.Research.DNA.Species.convert_raw_gate (x, y, DSDParser.to_range pos)
+
+ res
+
+let parseOldMolecule = pMolecule (kw "::" >>. preturn true) (kw ":" >>. preturn false)
+
+let parseOldGroundSpecies =
+ choice
+ [ DSDParser.parse_name +>>+ pOldVals .>>. DSDParser.at_time |>> fun ((n, vs), t) -> Process.Instance(n,None,vs,t)
+ ; parseOldMolecule .>>. DSDParser.at_time >>= fun (v, t) ->
+ match v with
+ | Microsoft.Research.DNA.Species.STRAND s -> preturn (Process.Strand (s, t))
+ | Microsoft.Research.DNA.Species.GATE s -> preturn (Process.Gate (s, t))
+ | _ -> failParser "a gate or a strand"
+ ]
+
+let pOldSpecies =
+ choice
+ [ parseOldGroundSpecies |> DSDParser.sep_by_bars |> bracket "[[" "]]" .>>. DSDParser.at_time |>> Process.Origami
+ // NB: currently this allows timed species inside an origami, whereas the original parser does not
+ ; parseOldGroundSpecies ]
+
+let pReact pKey = Reaction.parse // parse a reaction...
+ pOldSpecies // ... with these species ...
+ (Expression.parse DSDParser.parse_name) // ... with these rate values...
+ (Expression.parse pKey) // ... in these rate expressions
+ (Expression.Float 1.0) // ... in these rate expressions
+ |~> (fun pos -> DSDParser.to_dsd_reaction pos >> Process.Chemical)
+
+let (&>) a b = DSDParser.(&>) a b
+
+let rec oldProc st =
+ let pKey = Microsoft.Research.CRNEngine.Key.parse pOldSpecies
+ [ "new" &> DSDParser.restriction +>>+ oldProc |>> Process.New
+ ; kw "rxn" >>. pReact pKey
+ ; pTry ("constant" &> pOldSpecies
+ |~> fun pos p -> Process.Repeat(Value.Int(1, DSDParser.to_range pos),true,p, None, None))
+ ; pTry (DSDParser.before "constant" pOldValue +>>+ ((kw "*" <|> kw "of") >>. DSDParser.before "constant" pOldSpecies)
+ |~> fun pos ((c1,n), (c2,p)) -> Process.Repeat(n,c1||c2,p, None, None)
+ "species initialization"
+ )
+ ; pTry (pOldSpecies) // "a species"
+ ; pTry (pReact pKey)
+ ; oldProc |> DSDParser.sep_by_bars |> paren |>> Process.Parallel
+ ] |> choice <| st
+
+let pValOrTuple = pOldValue <|> (pOldVals |~> fun pos vs -> (Value.Tuple (vs, (DSDParser.to_range pos))))
+
+// parser.mly
+type oldPlot = PloFloat of float
+ | PloName of string // FloatVarAExp or PopulationAExp?
+ | PloNameAt of string * float
+ | PloMolecule of species
+ | PloMoleculeAt of species * float
+ | PloModule of string * value list
+ | PloModuleAt of string * value list * float
+ | PloSum of oldPlot list
+ | PloSub of oldPlot * oldPlot
+ | PloDiff of oldPlot * oldPlot
+ | PloProd of oldPlot list
+ | PloDiv of oldPlot * oldPlot
+
+type oldSimMode = JIT
+ | SSA
+ | OSLO of bool (* is stiff? *)
+ | SPACIAL_PERIODIC of int32
+ | SUNDIALS of bool (* is stiff? *)
+ | CME_OSLO_OR_SUNDIALS of bool (* is stiff? *) (* the parser is ambiguous on "cme" *)
+ | LNA_OSLO of bool (* is stiff? *)
+
+type SpParam = Burnin of int32
+ | SpSamples of int32
+ | Thin of int32
+ | SeparateNoise of bool
+ | NoiseModel of int
+ | Prune of bool
+
+type CoreElem = CoreW of float
+ | CoreI of float
+ | CoreO of float
+
+type PointElem = PointX of float
+ | PointY of float
+ | PointW of float
+ | PointV of float
+
+type SpSetting = SpRandom1 of species * float
+ | SpRandom2 of float
+ | SpCentralCore of CoreElem list
+ | SpPointOfRecord of PointElem list
+ // Settings.add_spatialic [Expressions.PopulationAExp $4] [SettingsConstants.CentralCore {width=$3; inner=$5; outer=Some $6}] z
+ | BackwardComp of species * float * float * float option
+
+type SpBC = Periodic | ZeroFlux
+
+
+type ParSpace = ParReal | ParLog
+type ParVar = ParFixed | ParRandomized | ParInitVal
+type ParItem = ParAssign of string * float * float * float
+ | ParItem of string * float * float * float * ParSpace * ParVar
+
+type SweepVar = SweepVar of string list * value list list
+
+type SweepItem = NamedSweep of string * SweepVar list
+ | UnnamedSweep of SweepVar
+
+type KMode = KContextual | KStochastic | KDeterministic
+
+type VerMode = Encoding of int32
+ | Abstraction of int32
+ | Enumeration of int32
+ | PopBound of int32
+ | DummyRxn of bool
+ | EnfInitial of bool
+
+type oldDirective = Samples of float option * float option * int32 option // start, end, points
+ | DurationPoints of float option * float option * int32 option // start, end, points
+ | Scale of float
+ | Plot of oldPlot list
+ | Simulation of oldSimMode
+ | RelTolerance of float
+ | Tolerance of float // maps to abstolerance in deterministic
+ | Seed of int32
+ | OldEvent of Process.t
+ | SpecMax of species * int32
+ | OldTime of Time
+ | Concentration of Concentration
+ | Dt of float
+ | XMax of float
+ | Nx of int32
+ | Theta of float
+ | Spatialic of SpSetting
+ | Spatialbc of SpBC
+ | SpatialPlot of species
+ | Diffusion of species * float
+ | DefaultDiffusion of float
+ | Params of ParItem list
+ | Sweeps of SweepItem list
+ | Fit of string * string * oldPlot list
+ | FitRun of SpParam list
+ | PlotWindow of float * float * float * float
+ | Kinectics of KMode
+ | Verification of VerMode
+ | StabilityCorrection of float
+ | CoaxialDAngle of float
+ | DoubleCoaxialDAngle of float
+ | CoaxialCorrection of Options.prim
+ | Temperature of float
+ | TerminalDAngle of float
+
+// Tokens
+let SAMPLE = kw "sample"
+let ALL = kw "all"
+let PLOT = kw "plot"
+let POINTS = kw "points"
+let DURATION = kw "duration"
+let SCALE = kw "scale"
+let SEED = kw "seed"
+let SIMULATION = kw "simulation"
+let DETERMINISTICSTIFF = kw "deterministicstiff"
+let RELTOLERANCE = kw "reltolerance"
+let TOLERANCE = kw "tolerance" <|> kw "abstolerance"
+let EVENT = kw "event"
+let SPECMAX = kw "specmax"
+let TIME = kw "time"
+let CONCENTRATION = kw "concentration"
+let DT = kw "dt"
+let XMAX = kw "xmax"
+let NX = kw "nx"
+let THETA = kw "theta"
+let COAXIALDANGLE = kw "coaxialDangle"
+let DOUBLECOAXIALDANGLE = kw "doubleCoaxialDangle"
+let COAXIALCORRECTION = kw "coaxialCorrection"
+let TEMPERATURE = kw "temperature"
+let TERMINALDANGLE = kw "terminalDangle"
+let SPATIALIC = kw "spatialic"
+let SPATIALBC = kw "spatialbc"
+let SPATIALPLOT = kw "spatialplot"
+//let COMPILATION = kw "compilation"
+let DECLARE = kw "declare"
+let DEFAULTDIFFUSION = kw "defaultdiffusion"
+let DIFFUSION = kw "diffusion"
+let LEAKS = kw "leaks"
+let PINLEAK = kw "pinleak"
+let PINLEAKS = kw "pinleaks"
+let LENGTHS = kw "lengths"
+let MIGRATE = kw "migrate"
+let LOCALCONCENTRATIONS = kw "localconcentrations"
+let POLYMERS = kw "polymers"
+let SEQUENCERATES = kw "sequenceRates"
+let STABILITYCORRECTION = kw "stabilityCorrection"
+let TAU = kw "tau"
+let TOEHOLDS = kw "toeholds"
+let UNPRODUCTIVE = kw "unproductive"
+let VERIFICATION = kw "verification"
+let FIT = kw "fit"
+let FITRUN = kw "fit_run"
+let KINETICS = kw "kinetics"
+let PARAMETERS = kw "parameters"
+let PLOTWINDOW = kw "plotwindow"
+let PREDICATES = kw "predicates"
+let SWEEP = kw "sweep"
+
+let COMMA = kw ","
+let SEMI = kw ";"
+let AT = kw "@"
+let UNDERSCORE = kw "_"
+let SUM = kw "sum"
+let SUB = kw "sub"
+let DIFF = kw "diff"
+let PROD = kw "prod"
+let DIV = kw "div"
+let EQUAL = kw "="
+let DLBRACKET = kw "[["
+let DRBRACKET = kw "]]"
+let BAR = kw "|"
+
+(* each function below parses a specific "directive" string *)
+// samples directive
+let dirSamples =
+ SAMPLE >>. Expression.parse spFloat >>= fun x ->
+ choice [ COMMA >>. spFloat >>= fun y ->
+ choice [ ALL >>. preturn (Some (Expression.eval id x), Some y, Some 0)
+ ; spInt >>= fun z -> preturn (Some (Expression.eval id x), Some y, Some z)
+ ; preturn (Some (Expression.eval id x), Some y, None) ]
+ ; ALL >>. preturn (None, Some (Expression.eval id x), Some 0)
+ ; spInt >>= fun y -> preturn (None, Some (Expression.eval id x), Some y)
+ ; preturn (None, Some (Expression.eval id x), None) ]
+ >>= (Samples >> preturn) // wraps the result inside Samples
+
+// duration directive
+let dirDuration =
+ DURATION >>. spFloat >>= fun x ->
+ choice [ COMMA >>. spFloat >>= fun y ->
+ choice [ POINTS >>.
+ choice [ ALL >>. preturn (Some x, Some y, Some 0)
+ ; spInt >>= fun z -> preturn (Some x, Some y, Some z) ]
+ ; preturn (Some x, Some y, None) ]
+ ; POINTS >>. choice [ ALL >>. preturn (None, Some x, Some 0)
+ ; spInt >>= fun y -> preturn (None, Some x, Some y) ]
+ ; preturn (None, Some x, None) ]
+ >>= (DurationPoints >> preturn )
+
+// seed directive
+let dirSeed = SEED >>. spInt >>= (Seed >> preturn)
+
+// old molecule parser
+let pMol = parseOldMolecule
+ // TODO: double check that "--(cogs)" | "--(+ cogs)" | "--(cogs+)" is not used anymore
+
+// plots
+// TODO check empty plot "()" is parsed correctly with many or sepBy, double check that many1 or sepBy1 is not misused
+let rec pPlot sp =
+ let underscoreVal pos = [Value.Tuple ([Value.Variable ("_", pos)], pos)]
+ choice [ spFloat >>= (PloFloat >> preturn)
+ ; SUM >>. paren (many1 pPlot) >>= (PloSum >> preturn)
+ ; SUB >>. paren (pPlot .>> SEMI .>>. pPlot) >>= (PloSub >> preturn)
+ ; DIFF >>. paren (pPlot .>> SEMI .>>. pPlot) >>= (PloDiff >> preturn)
+ ; PROD >>. paren (many1 pPlot) >>= (PloProd >> preturn)
+ ; DIV >>. paren (pPlot .>> SEMI .>>. pPlot) >>= (PloDiv >> preturn)
+ ; pMol >>= fun m ->
+ choice [ AT >>. paren spFloat >>= fun x -> preturn (PloMoleculeAt (m, x))
+ ; preturn (PloMolecule m) ]
+ ; spName >>= fun n ->
+ choice [ AT >>. paren spFloat >>= fun x -> preturn (PloNameAt (n, x))
+ ; UNDERSCORE >>.
+ choice [ AT >>. paren spFloat |~> fun pos x -> PloModuleAt (n, underscoreVal (DSDParser.to_range pos), x)
+ ; preturn () |~> fun pos _ -> PloModule (n, underscoreVal (DSDParser.to_range pos))]
+ ; paren (many Value.parse) >>= fun vs ->
+ choice [ AT >>. paren spFloat >>= fun x -> preturn (PloModuleAt (n,vs,x))
+ ; preturn (PloModule (n,vs))]
+ ; preturn (PloName n) ] // FloatVarAExp
+ ] sp
+
+
+// plots directive
+let pPlots sp = sepBy1 pPlot SEMI sp
+let dirPlot = PLOT >>. pPlots >>= (Plot >> preturn)
+
+
+let curry f (a, b) = f a b
+//let valZero = Value.Float(0.0,Microsoft.Research.DNA.Types.emprange)
+
+let pOrigami =
+ let pInsides = sepBy1 pMol BAR // >>= fun ms -> preturn (Process.Origami (List.map (Process.from_species valZero) ms, valZero))
+ DLBRACKET >>. pInsides .>> DRBRACKET >>= fun ms ->
+ preturn (fun t -> Process.Origami (List.map (Process.from_species None) ms, t))
+
+let pEvent = choice [ pOrigami
+ ; pMol >>= fun x -> preturn (fun t -> Process.from_species t x)
+ ; name .>>. paren (sepBy pOldValue COMMA) >>=
+ fun (n, vs) -> preturn (fun t -> Process.Instance(n, None, vs, t)) ]
+
+let dirEvents = EVENT >>. pEvent .>>. pOldValue .>> AT .>>. pOldValue
+ >>= (fun ((ev, amount), time) -> let procInstance = Process.Repeat(amount, false, ev (Some time), None, None)
+ preturn (OldEvent procInstance))
+
+let dirSpecMax = SPECMAX >>. DSDParser.speciesParser .>>. spInt >>= (SpecMax >> preturn)
+let dirTime =
+ let s = Time.Seconds 1.0
+ let m = Time.Seconds 6.0
+ let h = Time.Seconds 3.6
+ let d = Time.Seconds 8.64
+ let ret = OldTime >> preturn
+ TIME >>. choice [ kw "seconds" >>. ret s
+ ; kw "s" >>. ret s
+ ; kw "minutes" >>. ret m
+ ; kw "m" >>. ret m
+ ; kw "hours" >>. ret h
+ ; kw "h" >>. ret h
+ ; kw "days" >>. ret d
+ ; kw "d" >>. ret d ]
+
+let dirConcentration =
+ let m = Concentration.Molar 0
+ let mM = Concentration.Molar -3
+ let uM = Concentration.Molar -6
+ let nM = Concentration.Molar -9
+ let pM = Concentration.Molar -12
+ let fM = Concentration.Molar -15
+ let aM = Concentration.Molar -18
+ let zM = Concentration.Molar -21
+ let yM = Concentration.Molar -24
+ let ret = Concentration >> preturn
+ CONCENTRATION >>. choice [ kw "molar" >>. ret m
+ ; kw "M" >>. ret m
+ ; kw "milimolar" >>. ret mM
+ ; kw "mM" >>. ret mM
+ ; kw "millimolar" >>. ret mM
+ ; kw "micromolar" >>. ret uM
+ ; kw "uM" >>. ret uM
+ ; kw "nanomolar" >>. ret nM
+ ; kw "nM" >>. ret nM
+ ; kw "picomolar" >>. ret pM
+ ; kw "pM" >>. ret pM
+ ; kw "femtomolar" >>. ret fM
+ ; kw "fM" >>. ret fM
+ ; kw "attomolar" >>. ret aM
+ ; kw "aM" >>. ret aM
+ ; kw "zeptomolar" >>. ret zM
+ ; kw "zM" >>. ret zM
+ ; kw "yoctomolar" >>. ret yM
+ ; kw "yM" >>. ret yM ]
+let dirRelativeTolerance = RELTOLERANCE >>. spFloat >>= (RelTolerance >> preturn)
+let dirTolerance = TOLERANCE >>. spFloat >>= (Tolerance >> preturn)
+let dirScale = SCALE >>. spFloat >>= (Scale >> preturn)
+
+// simulation
+let dirSimulation =
+ SIMULATION >>. choice [ kw "jit" >>. preturn (Simulation JIT)
+ ; kw "stochastic" >>. preturn (Simulation SSA)
+ ; kw "deterministicstiff" >>. preturn (Simulation (OSLO true))
+ ; kw "deterministic" >>. preturn (Simulation (OSLO false))
+ ; kw "spatial1d" >>. preturn (Simulation (SPACIAL_PERIODIC 1))
+ ; kw "spatial2d" >>. preturn (Simulation (SPACIAL_PERIODIC 2))
+ ; kw "sundials" >>. preturn (Simulation (SUNDIALS false))
+ ; kw "sundialsstiff" >>. preturn (Simulation (SUNDIALS true))
+ ; kw "cme" >>. preturn (Simulation (CME_OSLO_OR_SUNDIALS false))
+ ; kw "cmestiff" >>. preturn (Simulation (CME_OSLO_OR_SUNDIALS true))
+ ; kw "lna" >>. preturn (Simulation (LNA_OSLO false))
+ ; kw "lnastiff" >>. preturn (Simulation (LNA_OSLO true)) ]
+
+let dirDT = DT >>. spFloat >>= (Dt >> preturn)
+let dirXMax = XMAX >>. spFloat >>= (XMax >> preturn)
+let dirNX = NX >>. spInt >>= (Nx >> preturn)
+let dirTheta = THETA >>. spFloat >>= (Theta >> preturn)
+
+// spatial directives
+let coreElem sp = choice [ kw "width" >>. spFloat >>= (CoreW >> preturn)
+ ; kw "inner" >>. spFloat >>= (CoreI >> preturn)
+ ; kw "outer" >>. spFloat >>= (CoreO >> preturn)
+ ; kw "species" >>. failwith "species not supported in Spatial settings, Core" ] sp
+let coreRecord = sepBy coreElem SEMI
+
+let pointElem sp = choice [ kw "x" >>. spFloat >>= (PointX >> preturn)
+ ; kw "y" >>. spFloat >>= (PointY >> preturn)
+ ; kw "width" >>. spFloat >>= (PointW >> preturn)
+ ; kw "value" >>. spFloat >>= (PointV >> preturn)
+ ; kw "species" >>. failwith "species not supported in Spatial settings, Point"] sp
+let pointRecord = sepBy pointElem SEMI
+
+let speciesParser st = DSDParser.speciesParser st
+
+let dirSpatialic =
+ SPATIALIC >>.
+ choice [ kw "random" >>. choice
+ [ speciesParser .>>. spFloat >>= (SpRandom1 >> Spatialic >> preturn)
+ ; spFloat >>= (SpRandom2 >> Spatialic >> preturn) ]
+ ; kw "centralcore" >>.
+ choice [ spFloat .>>. speciesParser .>>. spFloat .>>. spFloat
+ >>= (fun (((x,mol), y), z) -> preturn (Spatialic (BackwardComp (mol, x, y, Some z))) )
+ ; coreRecord >>= (SpCentralCore >> Spatialic >> preturn)]
+ ; kw "point" >>. pointRecord >>= (SpPointOfRecord >> Spatialic >> preturn)]
+
+
+let dirSpatialbc = SPATIALBC >>. choice [ kw "periodic" >>. preturn (Spatialbc Periodic)
+ ; kw "zeroflux" >>. preturn (Spatialbc ZeroFlux)]
+let dirSpatialPlot = SPATIALPLOT >>. speciesParser >>= (SpatialPlot >> preturn)
+
+let dirDiffusion = DIFFUSION >>. speciesParser .>>. spFloat >>= (Diffusion >> preturn)
+let dirDefaultDiffusion = DEFAULTDIFFUSION >>. spFloat >>= (DefaultDiffusion >> preturn)
+
+// parameters
+let paramP =
+ let f n x y z pType = choice
+ [ kw "fixedvar" >>. preturn (ParItem (n, x, y, z, pType, ParFixed))
+ ; kw "fixed" >>. preturn (ParItem (n, x, y, z, pType, ParFixed))
+ ; kw "randomized" >>. preturn (ParItem (n, x, y, z, pType, ParRandomized))
+ ; kw "random" >>. preturn (ParItem (n, x, y, z, pType, ParRandomized))
+ ; kw "init" >>. preturn (ParItem (n, x, y, z, pType, ParInitVal))
+ ; kw "initval" >>. preturn (ParItem (n, x, y, z, pType, ParInitVal)) ]
+ spName >>= fun n ->
+ choice [ EQUAL >>. spFloat >>= fun f -> preturn (ParAssign (n, f, f, f))
+ ; COMMA >>. paren (spFloat .>> COMMA .>>. spFloat) .>> COMMA .>>. spFloat .>> COMMA
+ >>= fun ((x,y), z) ->
+ choice [ kw "realspace" >>. COMMA >>. f n x y z ParReal
+ ; kw "real" >>. COMMA >>. f n x y z ParReal
+ ; kw "log" >>. COMMA >>. f n x y z ParLog
+ ; kw "logspace" >>. COMMA >>. f n x y z ParLog ] ]
+
+let dirParameters = PARAMETERS >>. sqBrackets (sepBy1 paramP SEMI) >>= (Params >> preturn)
+
+// sweeps
+let namesList = sepBy1 name COMMA
+
+let valList1 = sepBy1 pOldValue COMMA
+let valList = sepBy2 pOldValue COMMA
+let valListP = paren valList
+let valTuples = sepBy1 valListP COMMA
+
+let varSweep = choice [ paren namesList .>> EQUAL .>>. sqBrackets valTuples >>= (SweepVar >> preturn)
+ ; spName .>> EQUAL .>>. sqBrackets valList1 >>= fun (n, xs) ->
+ preturn (SweepVar ([n], List.map (fun x -> [x]) xs)) ]
+let combSweep = sepBy1 varSweep COMMA
+
+let dirSweep =
+ SWEEP >>.
+ choice [ paren namesList .>> EQUAL .>>. sqBrackets valTuples >>=
+ (SweepVar >> UnnamedSweep >> (fun x -> [x]) >> Sweeps >> preturn)
+ ; spName .>> EQUAL >>= fun n ->
+ choice [ braces combSweep >>= (fun x -> preturn (Sweeps [NamedSweep (n, x)]))
+ ; sqBrackets valList1 >>= (fun x -> preturn (Sweeps [UnnamedSweep (SweepVar ([n], List.map (fun y -> [y]) x))])) ] ]
+
+// fit
+let dirFit =
+ FIT >>.
+ braces
+ (spName .>> SEMI .>>. spName .>> SEMI >>= fun (n1, n2) ->
+ choice [ sqBrackets pPlots >>= fun ps -> preturn (Fit (n1, n2, ps))
+ ; pPlot >>= fun p -> preturn (Fit (n1, n2, [p])) ]
+ )
+
+// fit run
+let fitElem =
+ choice [ kw "burnin" >>. EQUAL >>. spInt >>= (Burnin >> preturn)
+ ; kw "samples" >>. EQUAL >>. spInt >>= (SpSamples >> preturn)
+ ; kw "thin" >>. EQUAL >>. spInt >>= (Thin >> preturn) // TODO: default = findintdef "thin" 10 t
+ ; kw "separatenoise" >>. EQUAL >>. spBool >>= (SeparateNoise >> preturn) // TODO: default = findbooldef true t
+ ; kw "noisemodel" >>. EQUAL >>. spInt >>= (NoiseModel >> preturn) // TODO: Constant t
+ ; kw "prune" >>. EQUAL >>. spBool >>= (Prune >> preturn) // TODO: default true t }
+ ]
+let fitRecord = braces (sepBy1 fitElem SEMI)
+let dirFitRun sp = (FITRUN >>. fitRecord >>= (FitRun >> preturn)) sp
+
+// plot window, kinectics
+let dirPlotWindow = PLOTWINDOW >>. spFloat .>>. spFloat .>>. spFloat .>>. spFloat >>=
+ fun (((tmin, tmax), ymin), ymax) -> preturn (PlotWindow (tmin, tmax, ymin, ymax))
+let dirKinectics = KINETICS >>. choice [ kw "contextual" >>. preturn (Kinectics KContextual)
+ ; kw "stochastic" >>. preturn (Kinectics KStochastic)
+ ; kw "deterministic" >>. preturn (Kinectics KDeterministic) ]
+
+// verification
+let dirVerification =
+ VERIFICATION >>.
+ choice
+ [ kw "encoding"
+ >>. choice [kw "integer" >>. preturn (Verification (Encoding 0))
+ ; kw "bitvector" >>. preturn (Verification (Encoding 1)) ]
+ ; kw "abstraction"
+ >>. choice [ kw "default" >>. preturn (Verification (Abstraction 0))
+ ; kw "stutter" >>. preturn (Verification (Abstraction 1))
+ ; kw "connected" >>. preturn (Verification (Abstraction 2))
+ ; kw "boolean" >>. preturn (Verification (Abstraction 3)) ]
+ ; kw "enumeration"
+ >>. choice [ kw "first" >>. preturn (Verification (Enumeration -1))
+ ; kw "full" >>. preturn (Verification (Enumeration -2))
+ ; kw "limit" >>. spInt >>= fun x ->
+ if x < 0 then failParser ("Positive enumeration limit required, but found " + x.ToString())
+ else preturn (Verification (Enumeration x)) ]
+ ; kw "population_bound" >>. spInt >>= (PopBound >> Verification >> preturn)
+ ; kw "null_reaction" >>. spBool >>= (DummyRxn >> Verification >> preturn)
+ ; kw "enforce_initial" >>. spBool >>= (EnfInitial >> Verification >> preturn)
+ ]
+
+let dirStabilityCorrection = STABILITYCORRECTION >>. spFloat >>= (StabilityCorrection >> preturn)
+let dirCoaxialDAngle = COAXIALDANGLE >>. spFloat >>= (CoaxialDAngle >> preturn)
+let dirDoubleCoaxialDangle = DOUBLECOAXIALDANGLE >>. spFloat >>= (DoubleCoaxialDAngle >> preturn)
+let dirCoaxialCorrection = COAXIALCORRECTION >>. Value.parse >>= (Value.to_engineValue >> CoaxialCorrection >> preturn)
+let dirTemperature = TEMPERATURE >>. spFloat >>= (Temperature >> preturn)
+let dirTerminalDAngle = TERMINALDANGLE >>. spFloat >>= (TerminalDAngle >> preturn)
+
+
+let pOldDirectives = [ dirCoaxialCorrection
+ ; dirCoaxialDAngle
+ ; dirConcentration
+ ; dirDT
+ ; dirDefaultDiffusion
+ ; dirDiffusion
+ ; dirDoubleCoaxialDangle
+ ; dirDuration
+ ; dirEvents
+ ; dirFitRun
+ ; dirFit
+ ; dirKinectics
+ ; dirNX
+ ; dirParameters
+ ; dirPlot
+ ; dirPlotWindow
+ ; dirRelativeTolerance
+ ; dirSamples
+ ; dirScale
+ ; dirSeed
+ ; dirSimulation
+ ; dirSpatialbc
+ ; dirSpatialic
+ ; dirSpatialPlot
+ ; dirSpecMax
+ ; dirStabilityCorrection
+ ; dirSweep
+ ; dirTemperature
+ ; dirTerminalDAngle
+ ; dirTheta
+ ; dirTime
+ ; dirTolerance
+ ; dirVerification
+ ; dirXMax ]
+
+let fromOpt m x = match m with
+ | None -> x
+ | Some y -> y
+
+
+let rec oldToCrnPlot : oldPlot -> Expression.t = fun p ->
+ match p with
+ | PloFloat f -> Expression.Float f
+ | PloName n -> Expression.Key (t_plot_base.String n)
+ | PloNameAt (n, _) -> Expression.Key (t_plot_base.String n)
+ | PloMolecule m -> Expression.Key (t_plot_base.Molecule m)
+ | PloMoleculeAt (m, _) -> Expression.Key (t_plot_base.Molecule m)
+ | PloModule (n, mods) -> let pattern = match mods with
+ | [Value.Tuple ([Value.Variable ("_", _)], _)] -> plot_pat.All
+ | _ -> plot_pat.Pats mods
+ Expression.Key (t_plot_base.Module (n, pattern))
+ | PloModuleAt (n, mods, _) -> Expression.Key (t_plot_base.Module (n, plot_pat.Pats mods))
+ | PloSum ps -> Expression.Plus (List.map oldToCrnPlot ps)
+ | PloSub (p1, p2) -> Expression.Minus {sub1 = oldToCrnPlot p1; sub2 = oldToCrnPlot p2}
+ | PloDiff (p1, p2) -> Expression.Absolute (oldToCrnPlot (PloSub (p1, p2)))
+ | PloProd ps -> Expression.Times (List.map oldToCrnPlot ps)
+ | PloDiv (p1, p2) -> Expression.Divide {div1 = oldToCrnPlot p1; div2 = oldToCrnPlot p2}
+
+let oldToCrnParam param =
+ match param with
+ | ParAssign (n, f1, f2, f3) ->
+ let prior : Prior =
+ { interval = Interval.Real
+ ; variation = Variation.Fixed
+ ; distribution = Distribution.Uniform {min = f1; max = f2} }
+ Parameter.create(n, f3 , Some prior)
+
+ | ParItem (n, f1, f2, f3, parSpace, parVar) ->
+ let pr : Prior = { interval = match parSpace with
+ | ParReal -> Interval.Real
+ | ParLog -> Interval.Log
+ ; variation = match parVar with
+ | ParFixed -> Variation.Fixed
+ | ParRandomized -> Variation.Random
+ | ParInitVal -> Variation.Initial2
+ ; distribution = Distribution.Uniform {min = f1; max = f2}}
+ Parameter.create(n, f3 , Some pr)
+
+
+let oldToCrnSweepVar (SweepVar (names, values)) =
+ Microsoft.Research.CRNEngine.Assignment.create(names, List.map (fun vs -> List.map Value.to_engineValue vs) values)
+
+
+let oldToCrnSweep sidGen (sweep:SweepItem) =
+ match sweep with
+ | UnnamedSweep sweep -> let newName = sidGen ()
+ Microsoft.Research.CRNEngine.Sweep.create(newName, [oldToCrnSweepVar sweep])
+ | NamedSweep (n, sweeps) -> let asns = List.map oldToCrnSweepVar sweeps
+ Microsoft.Research.CRNEngine.Sweep.create(n, asns)
+
+type event_data = Choice
+let c1 (x : Microsoft.Research.CRNEngine.Crn_settings>)
+ = Choice1Of3 x
+let c2 (y : Options.t) = Choice2Of3 y
+let c3 (p : Process.t) = Choice3Of3 p
+
+let updateWithOldDirectives (sidGen : unit -> string) oldDir (s: Microsoft.Research.CRNEngine.Crn_settings>
+ , o: Options.t) =
+ match oldDir with
+ | Samples (startOpt, endOpt, pointsOpt)
+ | DurationPoints (startOpt, endOpt, pointsOpt) ->
+ c1 {s with simulation = { s.simulation with points = fromOpt pointsOpt s.simulation.points
+ ; initial = fromOpt startOpt s.simulation.initial
+ ; final = fromOpt endOpt s.simulation.final } }
+ | Scale f -> c1 {s with stochastic = { s.stochastic with scale = f }}
+ | Plot ps -> c1 {s with simulation = { s.simulation with plots = List.map oldToCrnPlot ps @ s.simulation.plots}}
+ | Simulation smode ->
+ match smode with
+ | JIT -> c2 (Options.set_is_jit true o)
+ | SSA
+ | OSLO _
+ | SPACIAL_PERIODIC _
+ | SUNDIALS _
+ | CME_OSLO_OR_SUNDIALS _
+ | LNA_OSLO _ ->
+ c1 {s with simulator =
+ match smode with
+ | JIT -> Microsoft.Research.CRNEngine.SSA
+ | SSA -> Microsoft.Research.CRNEngine.SSA
+ | OSLO _ -> Microsoft.Research.CRNEngine.Oslo
+ | SPACIAL_PERIODIC _ -> Microsoft.Research.CRNEngine.PDE
+ | SUNDIALS _ -> Microsoft.Research.CRNEngine.Sundials
+ | CME_OSLO_OR_SUNDIALS _ -> Microsoft.Research.CRNEngine.CME
+ | LNA_OSLO _ -> Microsoft.Research.CRNEngine.LNA
+ ; deterministic = {
+ s.deterministic with
+ stiff = match smode with
+ | OSLO isStiff -> isStiff
+ | LNA_OSLO isStiff -> isStiff
+ | SUNDIALS isStiff -> isStiff
+ | CME_OSLO_OR_SUNDIALS isStiff -> isStiff
+ | SPACIAL_PERIODIC _ -> false
+ | SSA -> false
+ | JIT -> false
+ }
+ ; simulation = s.simulation
+ }// TODO: add dimensions to spatial settings
+ | RelTolerance f -> c1 { s with deterministic = { s.deterministic with reltolerance = f }}
+ | Tolerance f -> c1 { s with deterministic = { s.deterministic with abstolerance = f }}
+ | Seed i -> c1 { s with simulation = { s.simulation with seed = Some i}}
+ | OldEvent p -> c3 p
+ | SpecMax _ -> failwith "specMax not supported"
+ | OldTime _ -> c1 s
+ | Concentration _ -> c1 s
+ | Dt f -> c1 { s with spatial = { s.spatial with dt = f }}
+ | XMax f -> c1 { s with spatial = { s.spatial with xmax = f }}
+ | Nx i -> c1 { s with spatial = { s.spatial with nx = i }}
+ | Theta _ -> failwith "theta directive not supported in the spatial simulator"
+ | Spatialic _ -> failwith "spatial initial concentration not supported"
+// c1
+// { s with
+// spatial =
+// { s.spatial with
+// initial = match sicSetting with
+// | SpRandom1 (m, f) -> failwith "random core with molecule not supported"
+// | SpRandom2 f -> SpS.initial.Random f
+// | SpCentralCore cs -> failwith "random core with molecule not supported"
+// | SpPointOfRecord ps -> failwith "random core with molecule not supported"
+// | BackwardComp (a, b, c, d) -> failwith "random core with molecule not supported"
+// } }
+ | Spatialbc sbcSetting ->
+ c1 { s with
+ spatial = { s.spatial with
+ boundary = match sbcSetting with
+ | Periodic -> Boundary.Periodic
+ | ZeroFlux -> Boundary.ZeroFlux
+ } }
+ | SpatialPlot mol -> c1 { s with simulation = { s.simulation with plots = (oldToCrnPlot (PloMolecule mol)) :: s.simulation.plots } }
+ | Diffusion _ -> failwith "directive \"diffusion\" not supported"
+ | DefaultDiffusion _ -> failwith "directive \"default diffusion\" not supported"
+ | Params ps -> c1 { s with parameters = List.map oldToCrnParam ps }
+ | Sweeps ss -> c1 { s with sweeps = List.map (oldToCrnSweep sidGen) ss }
+ | Fit _(*(n1, n2, ps)*) -> failwith "directive \"fit\" not supported "
+ | FitRun ps ->
+ let updateSpSet (inf:Inference_settings) spParam =
+ match spParam with
+ | Burnin i -> { inf with burnin = i}
+ | SpSamples i -> { inf with samples = i}
+ | Thin i -> { inf with thin = i }
+ | SeparateNoise b -> { inf with noise_parameter = if b then Noise_parameter.Multiple else Noise_parameter.Random}
+ | NoiseModel i -> { inf with noise_model = match i with
+ | 0 -> Noise_model.Constant
+ | 1 -> Noise_model.Proportional
+ | _ -> failwith "Unrecognised noise model. Use linear or proportional." }
+ | Prune b -> { inf with prune = b}
+ c1 { s with inference = List.fold updateSpSet s.inference ps }
+ | PlotWindow _ -> failwith "plot window not supported"
+ | Kinectics kmode ->
+ c1 { s with simulation = { s.simulation with kinetics =
+ match kmode with
+ | KContextual -> Kinetics.Contextual
+ | KStochastic -> Kinetics.Stochastic
+ | KDeterministic -> Kinetics.Deterministic
+ } }
+ | Verification _ -> failwith "directive \"verification\" not supported"
+ | StabilityCorrection f -> c2 ( Options.setStabilityCorrection f o )
+ | CoaxialDAngle f -> c2 ( Options.setCoaxialDangle f o )
+ | DoubleCoaxialDAngle f -> c2 ( Options.setDoubleCoaxialDangle f o )
+ | CoaxialCorrection v -> c2 ( Options.setCoaxialCorrection v o ) // TODO: in parser.mly, v can also be UNDERSCORE
+ | Temperature f -> c2 ( Options.setTemperature o f )
+ | TerminalDAngle f -> c2 ( Options.setTerminalDangleFactor o f )
+
+(**************************************************)
+
+let oldDirective =
+ choice (List.map (fun odp -> odp >>= (Choice1Of2 >> preturn)) pOldDirectives
+ @ (List.map (fun op -> op >>= (Choice2Of2 >> preturn)) Options.optionParsers))
+
+
+let oldDsParser evs =
+ choice
+ [ "def" &> DSDParser.parse_name .>> spaces >>= fun name ->
+ (("=" &> pValOrTuple ) >>= fun v -> preturn (DSDParser.Syn_val (name, v)))
+ <|>
+ (DSDParser.parse_parameters +>>+ ("=" &> oldProc)
+ |~> fun pos (ps, p) -> DSDParser.Syn_def (name, DSDParser.to_range pos, ps, p))
+ ; "new" &> DSDParser.restriction |>> fun r -> DSDParser.Syn_new (r, true)
+ ; "dom" &> DSDParser.int_name +>>+ ("=" &> DSDParser.record) |>> fun r -> DSDParser.Syn_new (r, false)
+ ; kw "predicate" >>= (fun x -> failwith ("\""+ x + "\" keyword not supported"))
+ ; kw "query" >>= (fun x -> failwith ("\""+ x + "\" keyword not supported"))
+ ; oldProc >>= fun ps -> match ps, evs with
+ | _, [] -> preturn (DSDParser.Syn_proc ps)
+ | Process.Parallel pars, evs -> preturn (DSDParser.Syn_proc (Process.Parallel (pars @ evs)))
+ | _, _ -> preturn (DSDParser.Syn_proc (Process.Parallel (ps :: evs)))
+ ]
+ |> DSDParser.seq1
+ |>> DSDParser.to_syntax
+
+let parserOld (sidGen: unit -> string) : Parser.t< Microsoft.Research.DNA.Syntax.t
+ * Microsoft.Research.CRNEngine.Crn_settings>
+ * Options.t> =
+ spaces >>. many (kw "directive" >>. oldDirective) >>=
+ (fun oldSettings ->
+ let updateDefs (cs, opts, es) ch =
+ match ch with
+ | Choice1Of2 oldDir ->
+ match updateWithOldDirectives sidGen oldDir (cs, opts) with
+ | Choice1Of3 cs' -> (cs', opts, es)
+ | Choice2Of3 opts' -> (cs, opts', es)
+ | Choice3Of3 e -> (cs, opts, e::es)
+ | Choice2Of2 o -> (cs, List.fold Options.update_options opts o, es)
+ let (settings, opts, evs) = List.fold updateDefs (Microsoft.Research.CRNEngine.Crn_settings.defaults, Options.default_options, []) oldSettings
+ oldDsParser evs >>= (
+ fun dsd ->
+ preturn (dsd, settings, opts)
+ )) .>> spaces
+
+let freshSweepIdGenerator () =
+ let sweep_id = ref 0
+ let new_sweep_name () =
+ let id = !sweep_id + 1 in
+ sweep_id := id
+ "sweep_" + id.ToString() // the hard-coded "sweep_" is from the old DNA solution
+ new_sweep_name
+
+let parseOld _ =
+ let sidGen = freshSweepIdGenerator ()
+ Parser.run (parserOld sidGen)
+
+(* converts a DSD program written in the Silver Light syntax to Classic DSD syntax *)
+let convertSL slCode : string =
+ // create a fresh sweep_id generator
+ let sidGen = freshSweepIdGenerator ()
+
+ // parse code in the old syntax
+ let (z, cs, opts) = match Parser.run (parserOld sidGen) slCode with
+ | Parser.Success ((z, cs, opts), _, _) -> (z, cs, opts)
+ | Parser.Failure (msg, _, _) -> raise (System.Exception msg)
+
+ let plotPrinter (x:Syntax.t_plot_base) :string =
+ match x with
+ | Syntax.t_plot_base.String s -> s
+ | Syntax.t_plot_base.Molecule m -> "[" + Species.display m + "]"
+ | Syntax.t_plot_base.Module (n, pats) ->
+ "[" + n + match pats with
+ | Syntax.plot_pat.All -> " _]"
+ | Syntax.plot_pat.Pats ps -> "(" + String.concat ", " (List.map Value.to_string ps) + ")]" // + " " +")"
+ let plotAlonePrinter (x:Syntax.t_plot_base) :string =
+ match x with
+ | Syntax.t_plot_base.String s -> s
+ | Syntax.t_plot_base.Molecule m -> Species.display m
+ | Syntax.t_plot_base.Module (n, pats) ->
+ n + match pats with
+ | Syntax.plot_pat.All -> " _"
+ | Syntax.plot_pat.Pats ps -> "(" + String.concat ", " (List.map Value.to_string ps) + ")" // + " " +")"
+ let dsdSettings = cs.to_string
+ (Expression.to_string plotPrinter)
+ (fun e -> match e with
+ | Expression.Key x -> plotAlonePrinter x
+ | _ -> e |> Expression.to_string plotPrinter)
+ let dsdOptions = Options.display opts
+ let dsdSyntax = Syntax.display z
+ dsdSettings + dsdOptions + dsdSyntax
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/app.config b/ClassicDSD/ClassicDSDDotNet/app.config
new file mode 100644
index 0000000..2bc077c
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/app.config
@@ -0,0 +1,13 @@
+
+
+
+
+
+
+
+
+ True
+
+
+
+
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/branchesrenderer.fs b/ClassicDSD/ClassicDSDDotNet/branchesrenderer.fs
new file mode 100644
index 0000000..6dd8508
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/branchesrenderer.fs
@@ -0,0 +1,1779 @@
+[]
+module Microsoft.Research.DNA.BranchesRenderer
+
+open System
+open Microsoft.Research.CRNEngine
+open Microsoft.Research.CRNEngine.Svg
+open Microsoft.Research.DNA
+open Microsoft.Research.DNA.Options
+open Microsoft.Research.DNA.LogicDSD
+
+// Abstract representation suitable for rendering algorithms based on a double-stranded branching tree structure. Note that this does not use DSD species, so that it can also be used for RulesDSD.
+
+// Some configuration flags follow.
+
+/// If true, bulges are rendered as lines, rather than curves.
+let bulge_lines = false
+/// If true, shows key anchors for debugging purposes.
+let debug_anchors = false
+
+/// Type that represents a domain instance. Note that the color does not appear here, because it is part of the style.
+type DDomain = {
+ name: string;
+ nucleotides: Sequence.t;
+ toehold: bool;
+ complemented: bool;
+ tether: string option;
+ pseudoknot: int option;
+} with
+ member this.GetComplemented() = { this with complemented = not this.complemented; nucleotides = Sequence.complement this.nucleotides |> List.rev }
+ override this.ToString() = this.name + (if this.toehold then "^" else "") + (if this.complemented then "*" else "") + (match this.pseudoknot with Some s -> "!"+s.ToString() | None -> "")
+end
+
+/// The type of a strand.
+type DStrandKind = TopStrand | BottomStrand | DoubleStrand | LeftHairpinStrand | RightHairpinStrand
+
+/// Type that represents a strand, i.e. a sequence of domains.
+type DStrand = {
+ kind: DStrandKind;
+ domains: DDomain list;
+} with
+ override this.ToString() = let rec add s domains = match domains with [] -> s | dom::rest -> add (s+" "+dom.ToString()) rest in add "" this.domains
+let empty_dstrand={kind=DoubleStrand;domains=[]}
+
+/// The type of connection between two segments (forming a gate). The double link (not available in ClassicDSD) implies that any overhangs on that side become bulges.
+type DSegmentConnection = TopLink | BottomLink | DoubleLink
+let conn_to_string conn = match conn with | None -> " " | Some TopLink -> "-" | Some BottomLink -> "_" | Some DoubleLink -> "="
+
+/// Type that represents a segment, i.e. a double strand that may or may not have overhangs and/or a hairpin. If the segment is part of a gate, and is not the last segment of the gate, then it also indicates the type of connection it has to the next segment in the gate.
+type DSegment = {
+ top_left: DStrand option;
+ top_right: DStrand option;
+ bottom_left: DStrand option;
+ bottom_right: DStrand option;
+ double_strand: DStrand;
+ hairpin_left: DStrand option;
+ hairpin_right: DStrand option;
+ connection: DSegmentConnection option;
+} with
+ override this.ToString() =
+ let tl = match this.top_left with None -> None | Some s -> "tl:"+s.ToString() |> Some
+ let tr = match this.top_right with None -> None | Some s -> "tr:"+s.ToString() |> Some
+ let bl = match this.bottom_left with None -> None | Some s -> "bl:"+s.ToString() |> Some
+ let br = match this.bottom_right with None -> None | Some s -> "br:"+s.ToString() |> Some
+ let hl = match this.hairpin_left with None -> None | Some s -> "hl:"+s.ToString() |> Some
+ let hr = match this.hairpin_right with None -> None | Some s -> "hr:"+s.ToString() |> Some
+ let ds = "ds:"+this.double_strand.ToString() |> Some
+ String.Join(";",List.choose (fun x->x) [ds;hl;tl;bl;tr;br;hr])+(conn_to_string this.connection)
+end
+let empty_dsegment = {top_left=None;top_right=None;bottom_left=None;bottom_right=None;double_strand=empty_dstrand;hairpin_left=None;hairpin_right=None;connection=None}
+
+///Type that represents a gate. It's just a list of segments. The types of the connections between segments are declared within the segment type.
+type DGate = {
+ left_connection: DSegmentConnection option;
+ segments: DSegment list;
+} with
+ override this.ToString() =
+ (conn_to_string this.left_connection)+(String.Join("",this.segments |> (fun seg -> seg.ToString())))
+end
+
+/// Type that represents a branch. In this representation, the species is tree-like, which means that the branching structure is directed. Therefore, a gate can have children gates. This is represented in this type.
+type DBranch = {
+ gate: DGate;
+ children: DBranch list;
+}
+
+/// Union type of objects that may be parts of an origami. In this representation, species that are not origami can be either a single strand, or a branch. If it is a branch, it may be as simple as a single gate with a single segment with just a double strand of a single domain - but it's still considered a branch object.
+type DOrigamiElement = Strand of DStrand | Branch of DBranch
+
+/// Type that represents an origami. It's just a list of origami elements.
+type DOrigami = DOrigamiElement list
+
+
+// "Branches" SVG renderer. The rendering algorithm works by creating a "box" for each DSegment (or isolated DStrand). Each box has anchor points which are used to align it with the boxes representing adjacent segments. The composition of these boxes results in a container box, representing a DGate and having its own anchor points. In order to render a DBranch, the DGate box is positioned horizontally, while other DBranches are rendered recursively and then positioned at an appropriate angle and connected to the DGate box. DOrigamis are rendered as stacked objects.
+
+/// The style for a branch join.
+let branch_join_style = "stroke-dasharray:4"
+/// The style for a short branch join.
+let short_branch_join_style = ""
+/// The length below which a branch join is considered to be short (uses a different style).
+let short_branch_join = 16.0
+/// The distance between the baseline and the top or bottom strands.
+let half_separation = 4.0
+/// The assumed font size; note that this is actually reported in the style.
+let font_size = 15.0
+/// The distance between the strand and the domain labels.
+let label_sep = 11.0
+/// The distance between the strand and the domain labels, if rotate_labels is true (which causes the Svg layer not to apply normalisation, which changes the baseline).
+let label_sep_rotated = 7.0
+/// Additional vertical offset for labels.
+let label_baseline = 5.0
+/// Additional vertical offset for labels, in nucleotide mode (different font).
+let label_baseline_nucleotides = 4.0
+/// Standard width of a character for the purpose of determining domain name length.
+let letter_width = 8.0
+/// Letter width multiplier for nucleotides in a hairpin.
+let nucleotide_hairpin_factor = 1.4
+/// Width of a character for the name of a pseudoknot domain (bold).
+let pseudoknot_letter_width = 9.0
+/// Extra padding length for domains.
+let domain_pad = letter_width * 4.0
+/// Extra padding length for domains on an arc.
+let arc_domain_pad = letter_width * 2.0
+/// The angle formed by an arrow terminator.
+let arrow_angle = Math.PI / 6.0
+/// The length of an arrowhead.
+let arrow_length = 15.0
+/// The thickness of the strand.
+let line_width = 2.5
+/// Extra strand length drawn, for the purpose of joining domains at angles.
+let margin = 0.5
+/// The length of the connection extension between strands.
+let extension_length = 8.0
+/// The angle for overhangs.
+let overhang_angle = 45.0
+/// This CSS class will be added to all elements of the picture, and can then be used for styling.
+let base_class = "svgdsd"
+let sanitize_id (id:string) = id.Replace("_","__").Replace('\'','_')
+/// The CSS id for a given domain.
+let dom_id d = "dom_"+(sanitize_id d.name)
+/// The extra distance from the midpoint for bulges.
+let bulge_sep = 16.0
+/// The extra length for an overhang that crosses.
+let strut_len = letter_width * 5.0
+///The distance between species in an origami.
+let species_skip = 10.0
+///The margin around species in an origami.
+let origami_sep = { Svg.x = 16.0; Svg.y = 16.0 }
+///The size of the origami box corners.
+let origami_round = 32.0
+
+let make_label_text (nucleotides:bool) (d:DDomain) =
+ match d.tether with
+ | Some s -> s
+ | _ ->
+ let text = if nucleotides then Sequence.string_of_sequence d.nucleotides else d.name
+ let text = if d.complemented && not nucleotides then (text+"*") else text
+ let text = text + match d.pseudoknot with Some s -> "!"+s.ToString() | None -> ""
+ text
+
+/// This function produces the CSS class for the given domain.
+let get_domain_class (nucleotides:bool) (d:DDomain) =
+ let domain_class = base_class
+ let domain_class = if nucleotides then (domain_class + " fixedwidth") else domain_class
+ let domain_class = if d.toehold then (domain_class + " " + dom_id d) else domain_class
+ let domain_class = if d.pseudoknot.IsSome then domain_class + " pseudoknot" else domain_class
+ domain_class
+
+/// Produces a Svg.path object for a single-strand linear domain (not a hairpin). This function needs to be provided with additional context. The length_function provides a method to get the desired length of the domain, any left extension, and any right extension. The voffset and hoffset are the vertical and horizontal offsets respectively. The upper_label flag indicates whether the label needs to be positioned above the path (if false, it gets positioned below the path). The left_arrow flag indicates that an arrow needs to be drawn on the left end; the right_arrow flag indicates that an arrow needs to be drawn on the right end. This function returns one or two path objects (in case of tethers), plus the rightmost x coordinate of the domain (which can be used as the horizontal offset for the next domain in a sequence).
+let ddomain_to_path (mode:renderer_mode) (rotate_labels:bool) (length_function:DDomain->(float*float*float)) (voffset:float) (hoffset:float) (upper_label:bool) (left_arrow:bool) (right_arrow:bool) (d:DDomain) : Svg.path list * float =
+ let nucleotides = mode = renderer_mode.Nucleotides
+ let label_baseline = if nucleotides then label_baseline_nucleotides else label_baseline
+ let make_label_text = make_label_text nucleotides
+ let get_domain_class = get_domain_class nucleotides
+ // Determine the CSS class.
+ let domain_class = get_domain_class d
+ // Determine the domain length (based on the text, +1 for the complemented marker).
+ let (domain_length,left_extension,right_extension) = length_function d
+ let total_domain_length = domain_length+left_extension+right_extension
+ // Create the SVG path commands. May start with a left arrow or not.
+ let commands = if left_arrow then [MoveTo{x=hoffset-margin+Math.Cos(arrow_angle)*arrow_length;y=voffset+Math.Sin(arrow_angle)*arrow_length};LineTo{x=hoffset;y=voffset}] else [MoveTo{x=hoffset-margin;y=voffset}]
+ // Draw the line.
+ let commands = commands@[LineTo{x=hoffset+total_domain_length+margin;y=voffset}]
+ // May end with a right arrow or not.
+ let commands = if right_arrow then commands@[LineTo{x=hoffset+total_domain_length+margin-Math.Cos(arrow_angle)*arrow_length;y=voffset-Math.Sin(arrow_angle)*arrow_length}] else commands
+ // Determine where to locate the label. Horizontally it'll be in the middle; vertically, it may be above or below.
+ let rotated_baseline = (not nucleotides && rotate_labels) || (nucleotides&¬ upper_label)
+ let label_sep = if rotated_baseline then label_sep_rotated else label_sep
+ let label_anchor =
+ { // Horizontally, it will be in the middle. In nucleotides mode, I have to ignore the extension length, because I want the nucleotides to be aligned.
+ x = if nucleotides then
+ hoffset + (domain_length/2.0) + left_extension
+ else
+ hoffset + (total_domain_length/2.0)
+ // Verticall
+ y = if nucleotides then
+ voffset + if upper_label then label_sep else -label_baseline - label_sep
+ else
+ voffset + (if rotated_baseline then 0.0 else label_baseline) + (if upper_label then -label_sep else label_sep)
+ }
+ // Determine the label text. This is the domain name, with the complement marker.
+ let label_text = make_label_text d
+ // Create the label object.
+ let label = { label_text = label_text
+ label_anchor = label_anchor
+ label_class = Some domain_class
+ letter_width = if d.pseudoknot.IsSome then pseudoknot_letter_width else letter_width
+ label_dir = Svg.translate_point_by {x=(if (nucleotides&&upper_label)||(not nucleotides&&(upper_label||not rotate_labels)) then 10.0 else -10.0);y=0.0} label_anchor } |> Some
+ let main_path = { path_class = Some domain_class
+ commands = commands
+ path_label = label }
+ if d.tether.IsSome then
+ let tether_p = {x=hoffset+total_domain_length/2.0;y=voffset}
+ let tether_path= { Svg.path_class = base_class + " tether-pin" |> Some
+ ; Svg.commands = [ Svg.MoveTo (tether_p |> Svg.translate_point_by { x = 0.0; y = 3.0})
+ ; Svg.ArcTo ( tether_p |> Svg.translate_point_by { x = 0.0; y = -3.0}
+ , { rx = 3.0; ry = 3.0; large_flag = true; sweep_flag = false; angle = 0.0 })
+ ; Svg.ArcTo ( tether_p |> Svg.translate_point_by { x = 0.0; y = 3.0}
+ , { rx = 3.0; ry = 3.0; large_flag = true; sweep_flag = false; angle = 0.0 }) ]
+ ; Svg.path_label = None } in
+ // Return the path objects, plus the horizontal offset for the next domain in the sequence.
+ [main_path;tether_path], hoffset + total_domain_length
+ else
+ // Return the path object, plus the horizontal offset for the next domain in the sequence.
+ [main_path], hoffset + total_domain_length
+
+/// Produces a Svg.path object for a single-strand arc domain (a hairpin domain or a bulge). The center is on the origin. These domains never have extensions or arrows. This function returns one or two path objects (in case of tethers), plus the final coordinate for the arc (which can be used as the starting point for the next domain in a sequence). The side flags controls the sweep flag of the arc (on which side the arc is drawn).
+let ddomain_to_arc (mode:renderer_mode) (rotate_labels:bool) (radius:float) (start_point:Svg.point) (angle:float) (d:DDomain) (side:bool) : Svg.path list * Svg.point =
+ let nucleotides = mode = renderer_mode.Nucleotides
+ let label_baseline = if nucleotides then label_baseline_nucleotides else label_baseline
+ let make_label_text = make_label_text nucleotides
+ let get_domain_class = get_domain_class nucleotides
+ // Determine the CSS class.
+ let domain_class = get_domain_class d
+ // Determine the end point. Remember that in the context of trigonometric functions the Y-axis points upwards, while in the context of SVG rendering, the Y axis points downwards.
+ let start_angle = Math.Asin(-start_point.y/radius);
+ let start_angle = if start_point.x < 0.0 then Math.PI - start_angle else start_angle
+ // Arc domains are always rendered clockwise, so "angle" here should be negative.
+ let end_angle = start_angle+angle;
+ let end_point = {x=radius*Math.Cos(end_angle);y= -radius*Math.Sin(end_angle)}
+ // Create the Svg.arc object, which contains the SVG parameters for the arc.
+ let arc = { rx = radius
+ ry = radius
+ large_flag = angle > Math.PI || angle < -Math.PI
+ sweep_flag = side
+ angle = 0.0 }
+ // Determine the label text. This is the domain name, with the complement marker.
+ let label_text = make_label_text d
+ let paths =
+ if nucleotides then
+ // The angular length of the domain pad.
+ let angular_pad = arc_domain_pad / radius / 2.0
+ // The angular length that can be used for each nucleotide.
+ let nucleotide_angle = (if angle > 0.0 then angle - 2.0 * angular_pad else angle + 2.0 * angular_pad) / float label_text.Length
+ let end_angle = end_angle - angular_pad - (nucleotide_angle / 2.0)
+ let make_letter i n =
+ let label_dist = radius - label_sep
+ let label_angle = end_angle - nucleotide_angle * float i
+ let label_anchor = {x=label_dist*Math.Cos(label_angle);y= -label_dist*Math.Sin(label_angle)}
+ let label_dir = Svg.translate_point_by {x=10.0*Math.Cos(label_angle-Math.PI/2.0);y= -10.0*Math.Sin(label_angle-Math.PI/2.0)} label_anchor
+ let label = { label_text = string n
+ label_anchor = label_anchor
+ label_class = Some domain_class
+ letter_width = letter_width
+ label_dir = label_dir }
+ { path_class = None
+ commands = []
+ path_label = Some label }
+ let letter_paths = Seq.mapi make_letter label_text |> Seq.toList
+ { path_class = Some domain_class
+ commands = [MoveTo start_point;ArcTo(end_point,arc)]
+ path_label = None }::letter_paths
+ else
+ // Determine placement for the label. It should appear at an angular position in the middle of the arc, at a distance from the arc.
+ let label_sep = if rotate_labels then label_sep_rotated else label_sep
+ let label_angle = start_angle+angle/2.0
+ let label_dist = radius+label_sep
+ let (label_anchor,label_dir) =
+ if rotate_labels then
+ let label_anchor = {x=label_dist*Math.Cos(label_angle);y= -label_dist*Math.Sin(label_angle)}
+ let label_dir = {x=(label_dist+10.0)*Math.Cos(label_angle);y= -(label_dist+10.0)*Math.Sin(label_angle)}
+ let label_dir = Svg.rotate_point_around label_anchor 90.0 label_dir
+ (label_anchor,label_dir)
+ else
+ let label_xoffset = letter_width * float (label_text.Length-1) / 2.0
+ let label_xoffset = if Math.Cos(label_angle) > 0.0 then label_xoffset else -label_xoffset
+ let label_xoffset = if Math.Abs(label_dist*Math.Sin(label_angle)) > radius+(label_sep/2.0) then 0.0 else label_xoffset
+ let label_anchor = {x=label_dist*Math.Cos(label_angle)+label_xoffset;y= -label_dist*Math.Sin(label_angle)+label_baseline}
+ let label_dir = Svg.translate_point_by {x=10.0;y=0.0} label_anchor
+ (label_anchor,label_dir)
+ // Create the label object.
+ let label = { label_text = label_text
+ label_anchor = label_anchor
+ label_class = Some domain_class
+ letter_width = if d.pseudoknot.IsSome then pseudoknot_letter_width else letter_width
+ label_dir = label_dir }
+ [{ path_class = Some domain_class
+ commands = [MoveTo start_point;ArcTo(end_point,arc)]
+ path_label = Some label }]
+ if d.tether.IsSome then
+ let tether_angle = (start_angle+end_angle)/2.0
+ let tether_point = {x=radius*Math.Cos(tether_angle);y= -radius*Math.Sin(tether_angle)}
+ let tether_path= { Svg.path_class = base_class + " tether-pin" |> Some
+ ; Svg.commands = [ Svg.MoveTo (tether_point |> Svg.translate_point_by { x = 0.0; y = 3.0})
+ ; Svg.ArcTo ( tether_point |> Svg.translate_point_by { x = 0.0; y = -3.0}
+ , { rx = 3.0; ry = 3.0; large_flag = true; sweep_flag = false; angle = 0.0 })
+ ; Svg.ArcTo ( tether_point |> Svg.translate_point_by { x = 0.0; y = 3.0}
+ , { rx = 3.0; ry = 3.0; large_flag = true; sweep_flag = false; angle = 0.0 }) ]
+ ; Svg.path_label = None } in
+ // Return the path objects, plus the horizontal offset for the next domain in the sequence.
+ tether_path::paths, end_point
+ else
+ // Return the path object, plus the end point (which is the start point for the next domain in the sequence).
+ paths, end_point
+
+/// Renders a DStrand to the intermediate Svg representation. This function needs to be provided with some additional context. The left_connection parameter indicates whether this strand is used to connect to another segment on the left, and the type of connection. The right_connection parameter indicates whether this strand is used to connect to another segment on the right, and the type of connection. The no_left_arrow flag indicates that the strand should never have a left arrow, even if it is a bottom or double strand (e.g. because it's a double with a bottom left overhang, or a bottom right overhang). The no_right_arrow flag indicates that the strand should never have a right arrow, even if it is a top or double strand (e.g. because it's a double with a top right overhang, or a top left overhang).
+let dstrand_to_group (mode:renderer_mode) (rotate_labels:bool) (left_connection:DSegmentConnection option) (left_strut:bool) (right_connection:DSegmentConnection option) (right_strut:bool) (no_left_arrow:bool) (no_right_arrow:bool) (strand:DStrand) : Svg.group =
+ let nucleotides = mode = renderer_mode.Nucleotides
+ let make_label_text = make_label_text nucleotides
+ let ddomain_to_path = ddomain_to_path mode rotate_labels
+ let ddomain_to_arc = ddomain_to_arc mode rotate_labels
+ let half_separation = if nucleotides then half_separation + label_sep else half_separation
+ // Render the strand. The exact algorithm depends on the strand kind.
+ match strand.kind with
+ | TopStrand ->
+ // Top strand: render as a straight sequence. The last domain has an arrow.
+ let top_domain (o:float) (i:int,d:DDomain) =
+ let left_extension = if (i=0 && left_connection=Some TopLink) then extension_length else 0.0
+ let left_extension = left_extension + if (i=0&&left_strut) then strut_len else 0.0
+ let right_extension = if (i=strand.domains.Length-1 && right_connection= Some TopLink) then extension_length else 0.0
+ let right_extension = right_extension + if (i=strand.domains.Length-1&&right_strut) then strut_len else 0.0
+ let domain_length d = (make_label_text d |> String.length |> float) * letter_width + domain_pad , left_extension , right_extension
+ let left_arrow = false
+ let right_arrow = (i=strand.domains.Length-1 && not no_right_arrow)
+ ddomain_to_path domain_length 0.0 o true left_arrow right_arrow d
+ let (paths,length) = List.mapi (fun i d -> i,d) strand.domains |> List.mapFold top_domain 0.0
+ let paths = List.concat paths
+ { name = "TopStrand "+strand.ToString()
+ content = Paths paths
+ // This group only has top anchors.
+ anchors = [{anchor_id="tl";anchor_point={x=0.0;y=0.0}}
+ {anchor_id="tr";anchor_point={x=length;y=0.0}}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+ | BottomStrand ->
+ // Bottom strand: render as a straight sequence. The first domain has an arrow.
+ let bottom_domain (o:float) (i:int,d:DDomain) =
+ let left_extension = if (i=0 && left_connection=Some BottomLink) then extension_length else 0.0
+ let left_extension = left_extension + if (i=0&&left_strut) then strut_len else 0.0
+ let right_extension = if (i=strand.domains.Length-1 && right_connection=Some BottomLink) then extension_length else 0.0
+ let right_extension = right_extension + if (i=strand.domains.Length-1&&right_strut) then strut_len else 0.0
+ let domain_length d = (make_label_text d |> String.length |> float) * letter_width + domain_pad , left_extension , right_extension
+ let left_arrow = (i=0 && not no_left_arrow)
+ let right_arrow = false
+ ddomain_to_path domain_length 0.0 o false left_arrow right_arrow d
+ let (paths,length) = List.mapi (fun i d -> i,d) strand.domains |> List.mapFold bottom_domain 0.0
+ let paths = List.concat paths
+ { name = "BottomStrand "+strand.ToString()
+ content = Paths paths
+ // This group only has bottom anchors.
+ anchors = [{anchor_id="bl";anchor_point={x=0.0;y=0.0}}
+ {anchor_id="br";anchor_point={x=length;y=0.0}}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+ | DoubleStrand ->
+ // Double strand: render as two straight sequences. The top sequence is rendered as a top single strand and the bottom sequence is rendered as a bottom single strand; the only exception is that a vertical offset is added to implement strand separation.
+ let thoffset = if left_connection=Some BottomLink then extension_length else 0.0
+ let bhoffset = if left_connection=Some TopLink then extension_length else 0.0
+ let top_domain (hoffset:float) (i:int,d:DDomain) =
+ let left_extension = if (i=0 && left_connection=Some TopLink) then extension_length else 0.0
+ let right_extension = if (i=strand.domains.Length-1 && right_connection= Some TopLink) then extension_length else 0.0
+ let domain_length d = (make_label_text {d with complemented=true} |> String.length |> float) * letter_width + domain_pad , left_extension , right_extension
+ let left_arrow = false
+ let right_arrow = (i=strand.domains.Length-1 && not no_right_arrow)
+ ddomain_to_path domain_length -half_separation hoffset true left_arrow right_arrow d
+ let bottom_domain (hoffset:float) (i:int,d:DDomain) =
+ let left_extension = if (i=0 && left_connection=Some BottomLink) then extension_length else 0.0
+ let right_extension = if (i=strand.domains.Length-1 && right_connection=Some BottomLink) then extension_length else 0.0
+ let domain_length d = (make_label_text {d with complemented=true} |> String.length |> float) * letter_width + domain_pad , left_extension , right_extension
+ let left_arrow = (i=0 && not no_left_arrow)
+ let right_arrow = false
+ ddomain_to_path domain_length half_separation hoffset false left_arrow right_arrow (d.GetComplemented())
+ let (tpaths,tlength) = List.mapi (fun i d -> i,d) strand.domains |> List.mapFold top_domain thoffset
+ let (bpaths,blength) = List.mapi (fun i d -> i,d) strand.domains |> List.mapFold bottom_domain bhoffset
+ let paths = List.concat (tpaths@bpaths)
+ // I now have two path lists, one for top and one for bottom; I will concatenate them within the resulting group.
+ { name = "DoubleStrand "+strand.ToString()
+ content = Paths paths
+ // This group has top and bottom anchors.
+ anchors = [{anchor_id="tl";anchor_point={x=thoffset;y= -half_separation}}
+ {anchor_id="tr";anchor_point={x=tlength;y= -half_separation}}
+ {anchor_id="bl";anchor_point={x=bhoffset;y=half_separation}}
+ {anchor_id="br";anchor_point={x=blength;y=half_separation}}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+ | LeftHairpinStrand ->
+ match strand.domains with
+ | [] ->
+ // Degenerate hairpin: render as an arc with the same diameter as the strand separation.
+ let arc = { rx = half_separation
+ ry = half_separation
+ large_flag = false
+ sweep_flag = false
+ angle = 0.0 }
+ let start_point = {x=0.0;y=half_separation}
+ let mid_point = {x= -half_separation;y=0.0}
+ let end_point = {x=0.0;y= -half_separation}
+ let path1 = { path_class = Some base_class
+ commands = [MoveTo start_point;ArcTo(mid_point,arc)]
+ path_label = None }
+ let path2 = { path_class = Some base_class
+ commands = [MoveTo mid_point;ArcTo(end_point,arc)]
+ path_label = None }
+ { name = "LeftHairpin "+strand.ToString()
+ content = Paths [path1;path2]
+ anchors = [{anchor_id="tr";anchor_point=end_point}
+ {anchor_id="br";anchor_point=start_point}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+ | domains ->
+ // Left hairpin: render as a sequence of arcs. A hairpin never has arrows or extensions. The arc will be centered on the origin, and sweep clockwise.
+ let arc_length =
+ if nucleotides then
+ List.fold (fun i d -> i + (float d.nucleotides.Length) * letter_width * nucleotide_hairpin_factor + arc_domain_pad) arc_domain_pad domains
+ else
+ float (max 2 domains.Length) * letter_width * 3.0
+ let radius = arc_length / Math.PI / 2.0
+ // Calculate the start and end of the arc, both as coordinates and as angles. Remember that in the context of trigonometric functions the Y-axis points upwards, while in the context of SVG rendering, the Y axis points downwards.
+ // I'm tweaking the position based on the line width, in order to display a better connection. Note that I'll have to undo this when generating the anchor points.
+ let sep = half_separation-line_width/2.0
+ let start_angle = -Math.Asin(-sep/radius)
+ let end_angle = 2.0*Math.PI - Math.Asin(sep/radius)
+ let start_point = {x=radius*Math.Cos(start_angle);y= -sep}
+ let end_point = {x=radius*Math.Cos(end_angle);y= sep}
+ let paths =
+ if nucleotides then
+ let available_angle = end_angle-start_angle
+ let available_length = available_angle * radius
+ let arc_domain (start_point:Svg.point) (d:DDomain) : Svg.path list*Svg.point =
+ let domain_angle = ((float d.nucleotides.Length) * letter_width * nucleotide_hairpin_factor + arc_domain_pad) * available_length / arc_length / radius
+ ddomain_to_arc radius start_point domain_angle d false
+ List.mapFold arc_domain start_point domains |> fst |> List.concat
+ else
+ let domain_angle = (end_angle-start_angle) / float domains.Length;
+ let arc_domain (start_point:Svg.point) (d:DDomain) : Svg.path list*Svg.point = ddomain_to_arc radius start_point domain_angle d false
+ List.mapFold arc_domain start_point domains |> fst |> List.concat
+ { name = "LeftHairpin "+strand.ToString()
+ content = Paths paths
+ // This group has top and bottom anchors, to the right only.
+ anchors = [{anchor_id="tr";anchor_point={end_point with y= -half_separation}}
+ {anchor_id="br";anchor_point={start_point with y=half_separation}}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+ | RightHairpinStrand ->
+ match strand.domains with
+ | [] ->
+ // Degenerate hairpin: render as an arc with the same diameter as the strand separation.
+ let arc = { rx = half_separation
+ ry = half_separation
+ large_flag = false
+ sweep_flag = false
+ angle = 0.0 }
+ let start_point = {x=0.0;y= -half_separation}
+ let mid_point = {x= half_separation;y=0.0}
+ let end_point = {x=0.0;y=half_separation}
+ let path1 = { path_class = Some base_class
+ commands = [MoveTo start_point;ArcTo(mid_point,arc)]
+ path_label = None }
+ let path2 = { path_class = Some base_class
+ commands = [MoveTo mid_point;ArcTo(end_point,arc)]
+ path_label = None }
+ { name = "RightHairpin "+strand.ToString()
+ content = Paths [path1;path2]
+ anchors = [{anchor_id="tl";anchor_point=start_point}
+ {anchor_id="bl";anchor_point=end_point}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+ | domains ->
+ // Right hairpin: render as a sequence of arcs. A hairpin never has arrows or extensions. The arc will be centered on the origin, and sweep clockwise.
+ let arc_length =
+ if nucleotides then
+ List.fold (fun i d -> i + (float d.nucleotides.Length) * letter_width * nucleotide_hairpin_factor + arc_domain_pad) 0.0 domains
+ else
+ float (max 2 domains.Length) * letter_width * 3.0
+ let radius = arc_length / Math.PI / 2.0
+ // Calculate the start and end of the arc, both as coordinates and as angles. Remember that in the context of trigonometric functions the Y-axis points upwards, while in the context of SVG rendering, the Y axis points downwards.
+ // I'm tweaking the position based on the line width, in order to display a better connection. Note that I'll have to undo this when generating the anchor points.
+ let sep = half_separation-line_width/2.0
+ let start_angle = -Math.PI + Math.Asin(sep/radius)
+ let end_angle = Math.PI + Math.Asin(-sep/radius)
+ let start_point = {x=radius*Math.Cos(start_angle);y= sep}
+ let end_point = {x=radius*Math.Cos(end_angle);y= -sep}
+ let paths =
+ if nucleotides then
+ let available_angle = end_angle-start_angle
+ let available_length = available_angle * radius
+ let arc_domain (start_point:Svg.point) (d:DDomain) : Svg.path list*Svg.point =
+ let domain_angle = ((float d.nucleotides.Length) * letter_width * nucleotide_hairpin_factor + arc_domain_pad) * available_length / arc_length / radius
+ ddomain_to_arc radius start_point domain_angle d false
+ List.mapFold arc_domain start_point domains |> fst |> List.concat
+ else
+ let domain_angle = (end_angle-start_angle) / float domains.Length;
+ let arc_domain (start_point:Svg.point) (d:DDomain) : Svg.path list*Svg.point = ddomain_to_arc radius start_point domain_angle d false
+ List.mapFold arc_domain start_point domains |> fst |> List.concat
+ { name = "RightHairpin "+strand.ToString()
+ content = Paths paths
+ // This group has top and bottom anchors, to the right only.
+ anchors = [{anchor_id="tl";anchor_point={end_point with y= -half_separation}}
+ {anchor_id="bl";anchor_point={start_point with y=half_separation}}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+
+/// Renders a bulge to the intermediate Svg representation, as a double linear sequence of domains with a much wider separation than double strands. Bulges never have arrows. The *_extension parameters are the adjacent double-stranded domains, which will be used to draw an extended line in the case of bulges that only have one side.
+let bulge_to_group_lines (mode:renderer_mode) (rotate_labels:bool) (top:DDomain list) (top_extension:DDomain) (bottom:DDomain list) (bottom_extension:DDomain) : Svg.group =
+ let ddomain_to_path = ddomain_to_path mode rotate_labels
+ // The total length of the top and bottom strands needs to be equal. I will calculate the length of the longest strand, and scale the length of the domains in the shorter strand accordingly.
+ let domain_length d = (float (d.name.Length + if d.complemented then 1 else 0)) * letter_width + domain_pad
+ let min_top_length = List.sumBy domain_length top
+ let min_bottom_length = List.sumBy domain_length bottom
+ let length = max min_top_length min_bottom_length
+ let top_domain_length d = (domain_length d) * length / min_top_length, 0.0, 0.0
+ let bottom_domain_length d = (domain_length d) * length / min_bottom_length, 0.0, 0.0
+ let top_junctions =
+ match top with
+ | [] ->
+ let top_Path = { path_class = Some (base_class+" "+dom_id top_extension)
+ commands = [MoveTo{x=0.0;y= -half_separation};LineTo{x=bulge_sep;y= -half_separation-bulge_sep};LineTo{x=bulge_sep+length;y= -half_separation-bulge_sep};LineTo{x=bulge_sep+bulge_sep+length;y= -half_separation}]
+ path_label = None }
+ [top_Path]
+ | _ ->
+ // Each side of the bulge starts with an angled connector, then proceeds with the strand, then terminates with another angled connector.
+ let top_left = { path_class = Some (base_class+" "+dom_id top.Head)
+ commands = [MoveTo{x=0.0;y= -half_separation};LineTo{x=bulge_sep;y= -half_separation-bulge_sep}]
+ path_label = None }
+ let top_right = { path_class = Some (base_class+" "+dom_id (List.rev top).Head)
+ commands = [MoveTo{x=bulge_sep+length;y= -half_separation-bulge_sep};LineTo{x=bulge_sep+bulge_sep+length;y= -half_separation}]
+ path_label = None }
+ [top_left;top_right]
+ let bottom_junctions =
+ match bottom with
+ | [] ->
+ let bottom_path = { path_class = Some (base_class+" "+dom_id bottom_extension)
+ commands = [MoveTo{x=0.0;y=half_separation};LineTo{x=bulge_sep;y=half_separation+bulge_sep};LineTo{x=bulge_sep+length;y=half_separation+bulge_sep};LineTo{x=bulge_sep+bulge_sep+length;y=half_separation}]
+ path_label = None }
+ [bottom_path]
+ | _ ->
+ let bottom_left = { path_class = Some (base_class+" "+dom_id bottom.Head)
+ commands = [MoveTo{x=0.0;y=half_separation};LineTo{x=bulge_sep;y=half_separation+bulge_sep}]
+ path_label = None }
+ let bottom_right = { path_class = Some (base_class+" "+dom_id (List.rev bottom).Head)
+ commands = [MoveTo{x=bulge_sep+length;y=half_separation+bulge_sep};LineTo{x=bulge_sep+bulge_sep+length;y=half_separation}]
+ path_label = None }
+ [bottom_left;bottom_right]
+ // Top strand: render as a straight sequence.
+ let top_domain (o:float) (d:DDomain) = ddomain_to_path top_domain_length (-half_separation-bulge_sep) o true false false d
+ let top_domain_paths = List.mapFold top_domain bulge_sep top |> fst |> List.concat
+ // Bottom strand: render as a straight sequence.
+ let bottom_domain (o:float) (d:DDomain) = ddomain_to_path bottom_domain_length (half_separation+bulge_sep) o false false false d
+ let bottom_domain_paths = List.mapFold bottom_domain bulge_sep bottom |> fst |> List.concat
+ { name = "Bulge"
+ content = Paths (top_junctions@bottom_junctions@top_domain_paths@bottom_domain_paths)
+ anchors = [{anchor_id="bl";anchor_point={x=0.0;y=half_separation}}
+ {anchor_id="tl";anchor_point={x=0.0;y= -half_separation}}
+ {anchor_id="tr";anchor_point={x=length+bulge_sep+bulge_sep;y= -half_separation}}
+ {anchor_id="br";anchor_point={x=length+bulge_sep+bulge_sep;y=half_separation}}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+
+/// Renders a bulge to the intermediate Svg representation, as two semicircles. Bulges never have arrows. The *_extension parameters are the adjacent double-stranded domains, which will be used to draw an extended line in the case of bulges that only have one side.
+let bulge_to_group_arcs (mode:renderer_mode) (rotate_labels:bool) (top:DDomain list) (top_extension:DDomain) (bottom:DDomain list) (bottom_extension:DDomain) : Svg.group =
+ let ddomain_to_arc = ddomain_to_arc mode rotate_labels
+ // The total length of the top and bottom strands needs to be equal. I will calculate the length of the longest strand, and scale the length of the domains in the shorter strand accordingly.
+ let radius = float (max 2 (max top.Length bottom.Length)) * letter_width * 3.0 / Math.PI
+ let start_angle = Math.PI - Math.Asin(half_separation/radius);
+ let end_angle = Math.Asin(half_separation/radius);
+ let top_angle = (end_angle-start_angle) / float top.Length
+ let bottom_angle = (end_angle-start_angle) / float bottom.Length
+ let top_domain_paths =
+ match top with
+ | [] ->
+ [{ path_class = Some (base_class+" "+dom_id top_extension)
+ commands = [MoveTo {x= -radius;y= -half_separation};LineTo{x= radius;y= -half_separation}]
+ path_label = None }]
+ | _ -> let top_domain (start_point:Svg.point) (d:DDomain) : Svg.path list*Svg.point = ddomain_to_arc radius start_point top_angle d true
+ List.mapFold top_domain {x= -radius;y= -half_separation} top |> fst |> List.concat
+ let bottom_domain_paths =
+ match bottom with
+ | [] ->
+ [{ path_class = Some (base_class+" "+dom_id bottom_extension)
+ commands = [MoveTo {x= -radius;y= half_separation};LineTo{x= radius;y= half_separation}]
+ path_label = None }]
+ | _ -> let bottom_domain (start_point:Svg.point) (d:DDomain) : Svg.path list*Svg.point = ddomain_to_arc radius start_point bottom_angle d true
+ List.mapFold bottom_domain {x= radius;y=half_separation} (List.rev bottom) |> fst |> List.concat
+ { name = "Bulge"
+ content = Paths (top_domain_paths@bottom_domain_paths)
+ anchors = [{anchor_id="bl";anchor_point={x= -radius;y=half_separation}}
+ {anchor_id="tl";anchor_point={x= -radius;y= -half_separation}}
+ {anchor_id="tr";anchor_point={x=radius;y= -half_separation}}
+ {anchor_id="br";anchor_point={x=radius;y=half_separation}}]
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+
+/// Renders a DSegment to the intermediate SVG representation. This function requires additional context, in the form of the previous and next segments (which may be empty), in order to correctly draw connections.
+let dsegment_to_group (mode:renderer_mode) (rotate_labels:bool) (prev:DSegment) (segment:DSegment) (next:DSegment) : Svg.group =
+ let dstrand_to_group = dstrand_to_group mode rotate_labels
+ let prev_empty = prev.double_strand.domains=[]
+ let next_empty = next.double_strand.domains=[]
+ let left_connection = prev.connection
+ let right_connection = segment.connection
+ // Render the double strand (always present). Note that I need to determine whether an extension is needed to connect to adjacent segments.
+ let ds = dstrand_to_group
+ (if segment.top_left.IsSome && left_connection = Some TopLink then None else if segment.bottom_left.IsSome && left_connection = Some BottomLink then None else left_connection) false
+ (if segment.top_right.IsSome && right_connection = Some TopLink then None else if segment.bottom_right.IsSome && right_connection = Some BottomLink then None else right_connection) false
+ (segment.bottom_left.IsSome || segment.hairpin_left.IsSome || left_connection = Some BottomLink || left_connection = Some DoubleLink)
+ (segment.top_right.IsSome || segment.hairpin_right.IsSome || right_connection = Some TopLink || right_connection = Some DoubleLink)
+ segment.double_strand
+ /// This function is a shortcut for Svg.attach_group_to; it's used to position a rendered overhang correctly with respect to the double strand. Note that, for the purpose of attaching hairpins, either top or bottom anchors will do.
+ let attach (anchor_on_double:string) (anchor_on_group:string) (seg_group:Svg.group) : Svg.group =
+ Svg.attach_group_to (ds,anchor_on_double) (seg_group,anchor_on_group)
+ // For each possible element, if it is present, then render it, rotate it, and attach it to the double strand.
+ // Bulges happen when two segments are connected by a double link with overhangs.
+ let has_bulge_left = left_connection = Some DoubleLink && (segment.top_left.IsSome || segment.bottom_left.IsSome) && not prev_empty
+ let has_bulge_right = right_connection = Some DoubleLink && (segment.top_right.IsSome || segment.bottom_right.IsSome) && not next_empty
+ let bulge_to_group = if bulge_lines then bulge_to_group_lines else bulge_to_group_arcs
+ let bulge_to_group = bulge_to_group mode rotate_labels
+ // Render any bulges. Top and bottom strands are rendered as a unit.
+ let bulgel = if not has_bulge_left then None else
+ bulge_to_group (match segment.top_left with None -> [] | Some strand -> strand.domains) (segment.double_strand.domains.Head) (match segment.bottom_left with None -> [] | Some strand -> strand.domains) (segment.double_strand.domains.Head)
+ |> (attach "tl" "tr") |> Some
+ let bulger = if not has_bulge_right then None else
+ bulge_to_group (match segment.top_right with None -> [] | Some strand -> strand.domains) (segment.double_strand.domains |> List.last) (match segment.bottom_right with None -> [] | Some strand -> strand.domains) (segment.double_strand.domains |> List.last)
+ |> (attach "tr" "tl") |> Some
+ // Render each possible overhang. Note that the presence of a bulge overrides overhangs. Note that an overhang should generally be rotated, unless it is at the end of a segment that doesn't connect to anything, or it is itself a connector to another segment of the same gate. If both top and bottom overhangs are present, they both must be rotated regardless.
+ let tl = if has_bulge_left then None else
+ match segment.top_left with
+ | None -> None
+ | Some strand -> let straight = segment.bottom_left.IsNone && (left_connection=None || (left_connection=Some TopLink && not prev_empty))
+ dstrand_to_group left_connection false None (prev.top_right.IsSome) false true strand
+ |> (fun g -> if straight then g else Svg.rotate_group_around_anchor "tr" overhang_angle g)
+ |> (attach "tl" "tr") |> Some
+ let bl = if has_bulge_left then None else
+ match segment.bottom_left with
+ | None -> None
+ | Some strand -> let straight = segment.top_left.IsNone && (left_connection=None || (left_connection=Some BottomLink && not prev_empty))
+ dstrand_to_group left_connection false None (prev.bottom_right.IsSome) (left_connection=Some BottomLink || left_connection=Some DoubleLink) false strand
+ |> (fun g -> if straight then g else Svg.rotate_group_around_anchor "br" -overhang_angle g)
+ |> (attach "bl" "br") |> Some
+ let tr = if has_bulge_right then None else
+ match segment.top_right with
+ | None -> None
+ | Some strand -> let straight = segment.bottom_right.IsNone && (right_connection=None || (right_connection=Some TopLink && not next_empty))
+ dstrand_to_group None (next.top_left.IsSome) right_connection false false (right_connection=Some TopLink || right_connection=Some DoubleLink) strand
+ |> (fun g -> if straight then g else Svg.rotate_group_around_anchor "tl" -overhang_angle g)
+ |> (attach "tr" "tl") |> Some
+ let br = if has_bulge_right then None else
+ match segment.bottom_right with
+ | None -> None
+ | Some strand -> let straight = segment.top_right.IsNone && (right_connection=None || (right_connection=Some BottomLink && not next_empty))
+ dstrand_to_group None (next.bottom_left.IsSome) right_connection false true false strand
+ |> (fun g -> if straight then g else Svg.rotate_group_around_anchor "bl" overhang_angle g)
+ |> (attach "br" "bl") |> Some
+ // Render hairpins. Note that here I'm trusting that the segment is well-formed, i.e. does not have a hairpin and overhangs on the same side, and if it has a hairpin then it's disconnected on that side.
+ let hl = match segment.hairpin_left with
+ | None -> None
+ | Some strand -> dstrand_to_group None false None false true true strand
+ |> (attach "tl" "tr") |> Some
+ let hr = match segment.hairpin_right with
+ | None -> None
+ | Some strand -> dstrand_to_group None false None false true true strand
+ |> (attach "tr" "tl") |> Some
+ // Determine the combined anchor points. The group for a DSegment always has top and bottom anchor points. It may not have left or right anchor points, if there is a hairpin on that side. For each overhang position, if there is an overhang, then the segment anchor point is the anchor point for the overhang. If there is no overhang, then the segment anchor point is the anchor point for the double strand.
+ let a_tl = if segment.hairpin_left.IsSome then None else
+ let a = match bulgel with Some g -> g | None -> match tl with Some g -> g | None -> ds
+ Some {anchor_id="tl";anchor_point=Svg.get_anchor_point "tl" a}
+ let a_tr = if segment.hairpin_right.IsSome then None else
+ let a = match bulger with Some g -> g | None -> match tr with Some g -> g | None -> ds
+ Some {anchor_id="tr";anchor_point=Svg.get_anchor_point "tr" a}
+ let a_bl = if segment.hairpin_left.IsSome then None else
+ let a = match bulgel with Some g -> g | None -> match bl with Some g -> g | None -> ds
+ Some {anchor_id="bl";anchor_point=Svg.get_anchor_point "bl" a}
+ let a_br = if segment.hairpin_right.IsSome then None else
+ let a = match bulger with Some g -> g | None -> match br with Some g -> g | None -> ds
+ Some {anchor_id="br";anchor_point=Svg.get_anchor_point "br" a}
+ // Create the group object. Note that this group does not actually have content of its own; it only has sub-groups.
+ { name = "Segment "+segment.ToString()
+ content = Paths []
+ // Gather the anchors that actually exist.
+ anchors = List.choose (fun g->g) [a_tl;a_tr;a_bl;a_br]
+ debug_anchors = false
+ // Gather the double strand group and the overhang groups that actually exist.
+ sub_groups = List.choose (fun x->x) [Some ds;tl;tr;bl;br;hl;hr;bulgel;bulger]
+ offset = None }
+
+/// Renders a DGate to the intermediate SVG representation.
+let dgate_to_group (mode:renderer_mode) (rotate_labels:bool) (gate:DGate) : Svg.group =
+ let dsegment_to_group = dsegment_to_group mode rotate_labels
+ /// This function renders a DSegment within a gate, and attaches it to the group that was rendered from a previous DSegment. The signature is designed for use with List.mapFold. It returns the rendered group, and a tuple of the segment plus the rendered group (which will become the parameter of the next iteration).
+ let attach (prev:DSegment,prevg:Svg.group,curr:DSegment) (next:DSegment) : Svg.group*(DSegment*Svg.group*DSegment) =
+ // Render the new segment and align it with the previous segment, according to the connection type.
+ let gseg = dsegment_to_group prev curr next
+ let currg = match prev.connection with
+ | None -> failwith "unconnected segment"
+ | Some TopLink -> Svg.attach_group_to (prevg,"tr") (gseg,"tl")
+ | Some BottomLink -> Svg.attach_group_to (prevg,"br") (gseg,"bl")
+ | Some DoubleLink -> Svg.attach_group_to (prevg,"tr") (gseg,"tl")
+ currg,(curr,currg,next)
+ // Get the first group.
+ let firstseg = gate.segments.Head
+ let nextseg = match gate.segments.Tail with [] -> empty_dsegment | seg::_ -> seg
+ let firstg = dsegment_to_group ({empty_dsegment with connection=gate.left_connection}) firstseg nextseg
+ // Render the segment sequence.
+ let (groups,(lastseg,lastg)) =
+ match gate.segments.Tail with
+ | [] -> ([firstg],(firstseg,firstg))
+ | next::rest ->
+ let (groups,(curr,_,last)) = List.mapFold attach (firstseg,firstg,next) rest
+ let groups = firstg::groups
+ // Render the last segment.
+ let (last_group,(lastseg,lastg,_)) = attach(curr,(List.last groups),last) empty_dsegment
+ (groups@[last_group],(lastseg,lastg))
+ let left_connection = gate.left_connection
+ let right_connection = lastseg.connection
+ // Determine the gate anchors. Each anchor may need to be extended a bit, if the adjacent gate is not actually connected there.
+ let a_tl =
+ if firstseg.hairpin_left.IsSome then None else
+ let p = Svg.get_anchor_point "tl" firstg
+ let p = if left_connection=Some DoubleLink||left_connection=Some TopLink then p else
+ if p.y = -half_separation then {p with x=p.x-extension_length} else
+ Svg.rotate_point_around p -overhang_angle {p with x=p.x-extension_length}
+ Some {anchor_id="tl";anchor_point=p}
+ let a_tr =
+ if lastseg.hairpin_right.IsSome then None else
+ let p = Svg.get_anchor_point "tr" lastg
+ let p = if right_connection=Some DoubleLink||right_connection=Some TopLink then p else
+ if p.y = -half_separation then {p with x=p.x+extension_length} else
+ Svg.rotate_point_around p -overhang_angle {p with x=p.x+extension_length}
+ Some {anchor_id="tr";anchor_point=p}
+ let a_bl =
+ if firstseg.hairpin_left.IsSome then None else
+ let p = Svg.get_anchor_point "bl" firstg
+ let p = if left_connection=Some DoubleLink||left_connection=Some BottomLink then p else
+ if p.y = half_separation then {p with x=p.x-extension_length} else
+ Svg.rotate_point_around p overhang_angle {p with x=p.x-extension_length}
+ Some {anchor_id="bl";anchor_point=p}
+ let a_br =
+ if lastseg.hairpin_right.IsSome then None else
+ let p = Svg.get_anchor_point "br" lastg
+ let p = if right_connection=Some DoubleLink||right_connection=Some BottomLink then p else
+ if p.y = half_separation then {p with x=p.x+extension_length} else
+ Svg.rotate_point_around p overhang_angle {p with x=p.x+extension_length}
+ Some {anchor_id="br";anchor_point=p}
+ // Return the containing group. This group has no content of its own, just subgroups.
+ { name = "Gate "+gate.ToString()
+ content = Paths []
+ // A DGate always has top and bottom anchors, which correspond to the anchors for the leftmost and rightmost segments. It may not have left or right anchors, if the first segment has a left hairpin or the last segment has a right hairpin, respectively.
+ anchors = List.choose (fun g->g) [a_tl;a_tr;a_bl;a_br]
+ debug_anchors = debug_anchors
+ // Return all the rendered subgroups.
+ sub_groups = groups
+ offset = None }
+
+/// This function draws connecting lines between branches as appropriate. Parameters: the root of the node to which the gates belong, and tuples of already-rendered group and gates for the two gates. Precondition: the groups must be in the same frame of reference. Returns the updated g1.
+let connect_branches (mode:renderer_mode) (root:DGate) (g1:group,gate1:DGate) (g2:group,gate2:DGate) : group =
+ let nucleotides = mode = renderer_mode.Nucleotides
+ let get_domain_class = get_domain_class nucleotides
+ let connector_anchor = "cc"
+ /// Returns the top right domain for the given gate, along with a flag that tells whether it is an overhang.
+ let get_top_right_domain (gate:DGate) =
+ let last_segment = List.last gate.segments
+ match last_segment.top_right with Some strand -> List.last strand.domains,true | None -> List.last last_segment.double_strand.domains,false
+ /// Returns the top left domain for the given gate, along with a flag that tells whether it is an overhang.
+ let get_top_left_domain (gate:DGate) =
+ let first_segment = List.head gate.segments
+ match first_segment.top_left with Some strand -> List.head strand.domains,true | None -> List.head first_segment.double_strand.domains,false
+ /// Returns the bottom right domain for the given gate, along with a flag that tells whether it is an overhang.
+ let get_bottom_right_domain (gate:DGate) =
+ let last_segment = List.last gate.segments
+ match last_segment.bottom_right with Some strand -> List.last strand.domains,true | None -> List.last last_segment.double_strand.domains,false
+ /// Returns the bottom left domain for the given gate, along with a flag that tells whether it is an overhang.
+ let get_bottom_left_domain (gate:DGate) =
+ let first_segment = List.head gate.segments
+ match first_segment.bottom_left with Some strand -> List.head strand.domains,true | None -> List.head first_segment.double_strand.domains,false
+ /// Chooses which pair of classes to use, based on which ones are supposed to avoid fraying.
+ let choose_classes (class1,avoid_fraying_1) (class2,avoid_fraying_2) : string*string =
+ if avoid_fraying_1 && not avoid_fraying_2 then (class2,class2) else
+ if avoid_fraying_2 && not avoid_fraying_1 then (class1,class1) else
+ (class1,class2)
+ /// Creates a set of paths that connects the given anchors of the given groups, with the given CSS classes.
+ let connect_anchors (a1,g1,c1) (a2,g2,c2) =
+ let p1 = Svg.get_anchor_point a1 g1
+ let p2 = Svg.get_anchor_point a2 g2
+ let short = sqrt ((p1.x-p2.x)*(p1.x-p2.x)+(p1.y-p2.y)*(p1.y-p2.y)) < short_branch_join
+ let style = if short then " shortbranchjoin" else " branchjoin"
+ if c1 = c2 then
+ [{ path_class = Some (c1+style)
+ ; commands = [MoveTo p1;LineTo p2]
+ ; path_label = None }]
+ else
+ let mid = {x=(p1.x+p2.x)/2.0;y=(p1.y+p2.y)/2.0}
+ let a = { path_class = Some (c1+style)
+ ; commands = [MoveTo p1;LineTo mid]
+ ; path_label = None }
+ let b = { path_class = Some (c2+style)
+ ; commands = [MoveTo mid;LineTo p2]
+ ; path_label = None }
+ [a;b]
+ if gate1 = root then
+ // First link. Connect gate1's top right to gate2's top left, iff gate2 has a top or double link at the beginning.
+ match gate2.left_connection with
+ | Some BottomLink
+ | None -> {g1 with sub_groups=g2::g1.sub_groups}
+ | Some TopLink
+ | Some DoubleLink ->
+ let ct1 = let (d,overhang) = gate1|>get_top_right_domain in d|>get_domain_class,d.toehold&¬ overhang
+ let ct2 = let (d,overhang) = gate2|>get_top_left_domain in d|>get_domain_class,d.toehold&¬ overhang
+ //let (class1,class2) = choose_classes ct1 ct2
+ let (class1,class2) = base_class,base_class
+ let paths = connect_anchors ("tr",g1,class1) ("tl",g2,class2)
+ let pg = { Svg.content_group (Paths paths) with name = "Connector" }
+ {g1 with sub_groups=g2::pg::g1.sub_groups}
+ else if gate2 = root then
+ // Last link. Connect gate1's bottom left to gate2's bottom right, iff gate2 has a top or bottom link at the beginning. Note that, in this case, g2 is already present within g1, therefore thereturned group does not need to include it in the sub_groups.
+ match (List.last gate2.segments).connection with
+ | Some TopLink
+ | None -> {g1 with sub_groups=g1.sub_groups}
+ | Some BottomLink
+ | Some DoubleLink ->
+ let ct1 = let (d,overhang) = gate1|>get_bottom_left_domain in d|>get_domain_class,d.toehold&¬ overhang
+ let ct2 = let (d,overhang) = gate2|>get_bottom_right_domain in d|>get_domain_class,d.toehold&¬ overhang
+ //let (class1,class2) = choose_classes ct1 ct2
+ let (class1,class2) = base_class,base_class
+ let paths = connect_anchors (connector_anchor,g1,class1) ("br",g2,class2)
+ let pg = { Svg.content_group (Paths paths) with name = "Connector" }
+ {g1 with sub_groups=pg::g1.sub_groups}
+ else
+ // Connect gate1's bottom left to gate2's top left, iff gate2 has a top or double link at the beginning.
+ match gate2.left_connection with
+ | Some BottomLink
+ | None -> {g1 with sub_groups=g2::g1.sub_groups}
+ | Some TopLink
+ | Some DoubleLink ->
+ let ct1 = let (d,overhang) = gate1|>get_bottom_left_domain in d|>get_domain_class,d.toehold&¬ overhang
+ let ct2 = let (d,overhang) = gate2|>get_top_left_domain in d|>get_domain_class,d.toehold&¬ overhang
+ //let (class1,class2) = choose_classes ct1 ct2
+ let (class1,class2) = base_class,base_class
+ let paths = connect_anchors (connector_anchor,g1,class1) ("tl",g2,class2)
+ let pg = { Svg.content_group (Paths paths) with name = "Connector" }
+ {g1 with sub_groups=g2::pg::g1.sub_groups}
+
+/// Renders a DBranch to the intermediate SVG representation.
+let rec dbranch_to_group_wide (mode:renderer_mode) (rotate_labels:bool) (branch:DBranch) : Svg.group =
+ let dgate_to_group = dgate_to_group mode rotate_labels
+ let dbranch_to_group_wide = dbranch_to_group_wide mode rotate_labels
+ let connect_branches = connect_branches mode
+ let rootgate = branch.gate
+ let rendered_gate = dgate_to_group rootgate,rootgate
+ let rendered_children = branch.children |> List.map (fun b -> dbranch_to_group_wide b,b.gate)
+ let edge_count = float (rendered_children.Length+1)
+ let min_anchor_x (g:group) = (g.anchors |> List.map (fun a -> a.anchor_point.x) |> List.min)
+ let max_anchor_x (g:group) = (g.anchors |> List.map (fun a -> a.anchor_point.x) |> List.max)
+ let mid_anchor_y_left (g:group) = ((Svg.get_anchor_point "bl" g).y + (Svg.get_anchor_point "tl" g).y) / 2.0
+ let anchor_height_left (g:group) = abs ((Svg.get_anchor_point "bl" g).y - (Svg.get_anchor_point "tl" g).y)
+ let mid_anchor_y_right (g:group) = ((Svg.get_anchor_point "br" g).y + (Svg.get_anchor_point "tr" g).y) / 2.0
+ let anchor_height_right (g:group) = abs ((Svg.get_anchor_point "br" g).y - (Svg.get_anchor_point "tr" g).y)
+ // Note that if there are no children, then this entire function won't actually do anything. Also, in that case there is the possibility that the dgate does not have right anchors, which would cause anchor_height_right to crash. So I'm better off not calculating the height at all.
+ let max_height = if rendered_children=[] then 0.0 else max (rendered_gate|>fst|>anchor_height_right) ((rendered_children) |> List.map fst |> List.maxBy anchor_height_left |> anchor_height_left)
+ let circumference = (max_height + 1.0) * edge_count
+ let radius = circumference / Math.PI / 2.0
+ let deg_diff = 360.0 / edge_count
+ // I'm adding vertical center anchors to the groups, which correspond to the center of the circle.
+ let rendered_gate =
+ // For the same reason as above, if I have no children then there's no point in adding the right-central anchor, and it may fail if the dgate lacks right anchors. So I'm skipping it.
+ if rendered_children=[] then rendered_gate else
+ let (g,gate) = rendered_gate
+ {g with anchors = {anchor_id="rc";anchor_point={x=max_anchor_x g + radius;y=mid_anchor_y_right g}}::g.anchors},gate
+ let rendered_children = rendered_children |> List.map (fun (g,gate) -> {g with anchors = {anchor_id="lc";anchor_point={x=min_anchor_x g-radius;y=mid_anchor_y_left g}}::g.anchors},gate)
+ /// Rotates, translates and connects the children of the given (group,gate), starting from the given angle. Returns the updated group and the last connected gate.
+ let rec attach (group,gate) angle (children:(group*DGate)list) : group*DGate =
+ match children with
+ | [] ->
+ let (group,gate) = if gate = rootgate then (group,gate) else connect_branches rootgate (group,gate) rendered_gate, snd rendered_gate
+ (group,gate)
+ | (child_group,child_gate)::rest ->
+ let child_group = Svg.rotate_group_around_anchor "lc" angle child_group
+ let child_group = Svg.attach_group_to (group,"rc") (child_group,"lc")
+ let cgroup = connect_branches rootgate (group,gate) (child_group,child_gate)
+ let cgroup = {cgroup with anchors={anchor_id="cc";anchor_point=Svg.get_anchor_point "bl" child_group}::cgroup.anchors}
+ attach (cgroup,child_gate) (angle+deg_diff) rest
+ let (group,_) = attach rendered_gate (deg_diff-180.0) rendered_children
+ group
+
+/// Renders a DBranch to the intermediate SVG representation.
+let rec dbranch_to_group_babylon (mode:renderer_mode) (rotate_labels:bool) (branch:DBranch) : Svg.group =
+ let connect_branches = connect_branches mode
+ let dgate_to_group = dgate_to_group mode rotate_labels
+ let dbranch_to_group_babylon = dbranch_to_group_babylon mode rotate_labels
+ // Render the root.
+ let rootgate = branch.gate
+ let rootgroup = dgate_to_group rootgate
+ // If this is just the root, everything else is useless. Return immediately.
+ if branch.children = [] then rootgroup else
+ // Render the children.
+ let rendered_children = branch.children |> List.map (fun b -> dbranch_to_group_babylon b,b.gate)
+ /// This function returns the length of the side of a group that's facing towards the node.
+ let side_len (group,gate) =
+ let vec = if gate = rootgate then Svg.anchor_to_anchor (group,"br") (group,"tr") else Svg.anchor_to_anchor (group,"bl") (group,"tl")
+ let len = Svg.norm vec
+ len
+ // Calculate the array of side lengths.
+ let side_lengths = List.map side_len ((rootgroup,rootgate)::rendered_children)
+ /// Provides the angle covered by a side.
+ let side_angle radius side_len = 2.0 * Math.Asin (side_len/radius/2.0)
+ let total_angle radius =
+ List.sumBy (side_angle radius) side_lengths
+ /// Finds a crude numerical solution to the babylonian problem.
+ let rec find_radius last_radius =
+ let next_radius = last_radius - 1.0
+ if next_radius <= 0.0 then next_radius else
+ let next_total_angle = total_angle next_radius
+ if Double.IsNaN next_total_angle || next_total_angle > 2.0*Math.PI then last_radius else
+ find_radius next_radius
+ // Get the radius. If the longest side is greater than all the rest put together, then the babylonian problem has no solution. I'll just use the max side as radius.
+ let max_side = List.max side_lengths
+ let radius = if max_side >= (List.sum side_lengths) / 2.0 then max_side/2.0 else find_radius max_side
+ let radius = if radius <= 0.0 then max_side/2.0 else radius
+ let radius = radius + float (rendered_children.Length+1) * 1.0
+ // Get the total angle occupied by branch sides. This will typically be a bit less than 360°.
+ let total_seg_angle = total_angle radius
+ // Get the remaining angle. I'll allocate this as extra spacing between branches.
+ let total_spare_angle = Math.PI * 2.0 - total_seg_angle
+ /// Weight function for the allocation of extra spacing between branches. Takes two adjacent branches and returns a number that's proportional to how much extra angular spacing should be allocated between them.
+ let spare_angle_weight (group1,gate1) (group2,gate2) =
+ let trunk_dist_1 = abs (if gate1=rootgate then (Svg.get_anchor_point "tr" group1).y else (Svg.get_anchor_point "bl" group1).y)
+ let trunk_dist_2 = abs (if gate2=rootgate then (Svg.get_anchor_point "br" group2).y else (Svg.get_anchor_point "tl" group2).y)
+ 1.0 / ((trunk_dist_1+trunk_dist_2)*(trunk_dist_1+trunk_dist_2))
+ // Create a table associating couples of successive gates with the weight to be given to the allocation of the spare angle between them.
+ let spare_angle_weights =
+ let (couples,_) = List.mapFold (fun curr next -> (curr,next),next) (rootgroup,rootgate) (rendered_children@[(rootgroup,rootgate)])
+ List.map (fun ((groupa,gatea),(groupb,gateb)) -> (gatea,gateb),spare_angle_weight (groupa,gatea) (groupb,gateb)) couples
+ // Calculate the total weight for the allocation of spare angles.
+ let spare_angle_total_weight = List.sumBy (fun (_,w) -> w) spare_angle_weights
+ // Redefine the weight function to use the table created above. This ensures it produces the correct result after the groups get rototranslated.
+ let spare_angle_weight gate1 gate2 =
+ let (_,w) = List.find (fun ((g1,g2),_) -> g1=gate1&&g2=gate2) spare_angle_weights
+ w
+ /// Calculates the extra angular spacing to be inserted between two groups.
+ let spare_angle_per_connection g1 g2 = total_spare_angle * (spare_angle_weight g1 g2) / spare_angle_total_weight
+ /// Adds to the group an anchor located at the center of the circle.
+ let add_center_anchor (g:group) : group =
+ // I need to figure out an anchor located on the center of the circle. For the root, it's on the right; for the children, it's on the left.
+ let root = (g = rootgroup)
+ // Get the two anchors on the side facing the node.
+ let (p1,p2) = if root then (Svg.get_anchor_point "tr" g), (Svg.get_anchor_point "br" g) else (Svg.get_anchor_point "tl" g), (Svg.get_anchor_point "bl" g)
+ // Calculate the intersection points of two circles of equal radius, centered on the two anchors. Good explanation at https://math.stackexchange.com/questions/256100/how-can-i-find-the-points-at-which-two-circles-intersect.
+ let d2 = (p1.x-p2.x)*(p1.x-p2.x)+(p1.y-p2.y)*(p1.y-p2.y)
+ let k = sqrt(4.0*radius*radius/d2-1.0)/2.0
+ let xa = (p1.x+p2.x)/2.0 + k * (p2.y-p1.y)
+ let xb = (p1.x+p2.x)/2.0 - k * (p2.y-p1.y)
+ let ya = (p1.y+p2.y)/2.0 + k * (p2.x-p1.x)
+ let yb = (p1.y+p2.y)/2.0 - k * (p2.x-p1.x)
+ let c1 = {x=xa;y=yb}
+ let c2 = {x=xb;y=ya}
+ // I have two intersections. Get the one on the correct side.
+ let c = if root then
+ if xa > xb then c1 else c2
+ else
+ if xa > xb then c2 else c1
+ let anchor = {anchor_id="cen";anchor_point=c}
+ {g with anchors=anchor::g.anchors}
+ // I'm adding vertical center anchors to the groups, which correspond to the center of the circle. The root group doesn't get the anchor, because it doesn't get rotated.
+ let rootgroup1 = rootgroup |> add_center_anchor
+ let rendered_children1 = rendered_children |> List.map (fun (group,gate) -> (add_center_anchor group),gate)
+ // Move all children so that their center anchors are superposed with the center anchor of the root.
+ let rendered_children2 = rendered_children1 |> List.map (fun (group,gate) -> (Svg.attach_group_to (rootgroup1,"cen") (group,"cen")),gate )
+ /// This function rotates a child so that its side is located clockwise of the previous child, plus some spare angle.
+ let rotate_child (prev_group:group,prev_gate:DGate,prev_angle:float) (child_group:group,child_gate:DGate) : group*float =
+ // This doesn't work because the child's center anchor does not necessarily lie on its axis, so the child may initially be at an angle different from 0.
+ let child_angle =
+ let child_side_1 = Svg.get_anchor_point "tl" child_group
+ let child_side_2 = Svg.get_anchor_point "bl" child_group
+ let child_center = Svg.get_anchor_point "cen" child_group
+ let child_side_center = {x=(child_side_1.x+child_side_2.x)/2.0;y=(child_side_1.y+child_side_2.y)/2.0}
+ let v = Svg.sub child_side_center child_center
+ let angle = Svg.ang v
+ angle
+ let spare_angle = (spare_angle_per_connection prev_gate child_gate) |> Svg.rad_to_deg
+ let prev_side = side_len (prev_group,prev_gate)
+ let child_side = side_len (child_group,child_gate)
+ let prev_side_angle = side_angle radius prev_side |> Svg.rad_to_deg
+ let child_side_angle = side_angle radius child_side |> Svg.rad_to_deg
+ let angle = prev_angle + prev_side_angle/2.0 + spare_angle + child_side_angle/2.0
+ let group = Svg.rotate_group_around_anchor "cen" (angle - child_angle) child_group
+ group,angle
+ // Note that the starting angle is -180.0, because all children have the center to the left.
+ let (rendered_children3,final_angle) = rendered_children2 |> List.mapFold (fun prev_group (group,gate) -> let (group,a) = rotate_child prev_group (group,gate) in (group,gate),(group,gate,a)) (rootgroup1,rootgate,-180.0)
+
+ // Connect all children.
+ let rec attach (group,gate) (children:(group*DGate)list) : group*DGate =
+ match children with
+ | [] ->
+ let (group,gate) = if gate = rootgate then (group,gate) else connect_branches rootgate (group,gate) (rootgroup1,rootgate), rootgate
+ (group,gate)
+ | (child_group,child_gate)::rest ->
+ let cgroup = connect_branches rootgate (group,gate) (child_group,child_gate)
+ let cgroup = {cgroup with anchors={anchor_id="cc";anchor_point=Svg.get_anchor_point "bl" child_group}::cgroup.anchors}
+ attach (cgroup,child_gate) rest
+ let (group,_) = attach (rootgroup1,rootgate) rendered_children3
+ group
+
+let dbranch_to_group (arrange:arrange_mode) (mode:renderer_mode) (rotate_labels:bool) (branch:DBranch) : Svg.group =
+ match arrange with
+ | Babylon -> dbranch_to_group_babylon mode rotate_labels branch
+ | Wide -> dbranch_to_group_wide mode rotate_labels branch
+
+let dorigami_to_group (arrange:arrange_mode) (mode:renderer_mode) (rotate_labels:bool) (origami:DOrigami) : Svg.group =
+ let dstrand_to_group = dstrand_to_group mode rotate_labels
+ let dbranch_to_group = dbranch_to_group arrange mode rotate_labels
+ let (dstrands,dbranches) = origami |> List.partition (fun (el:DOrigamiElement) -> match el with Strand _ -> true | _ -> false)
+ let dstrands = dstrands |> List.map (fun el -> match el with Strand s -> s | _ -> failwith "")
+ let dbranches = dbranches |> List.map (fun el -> match el with Branch b -> b | _ -> failwith "")
+ let gstrands = dstrands |> List.map (dstrand_to_group None false None false false false)
+ let gbranches = dbranches |> List.map dbranch_to_group
+ let b = (gstrands @ gbranches) |> List.map (fun g -> Svg.emerge_groups [g]) |> Svg.stackv origami_sep species_skip in
+ let border_label = "" in
+ let border_inset = (String.length border_label |> float) * letter_width / 2.0 in
+ let border_offset = { Svg.x = 2.0; Svg.y = 2.0 } in
+ let border_dim = b.box_dim |> Svg.translate_point_by (border_offset |> Svg.scale_by -1.0) in
+ let border = { Svg.path_class = base_class + " origami-border" |> Some
+ ; Svg.commands = Svg.rounded_box border_offset border_dim origami_round
+ ; Svg.path_label = { Svg.label_text = border_label
+ ; Svg.label_anchor = Svg.sub b.box_dim origami_sep |> Svg.translate_point_by { x = -border_inset; y = 0.0 }
+ ; Svg.label_class = Some base_class
+ ; Svg.letter_width = Svg.default_letter_width
+ ; Svg.label_dir = Svg.sub b.box_dim origami_sep |> Svg.translate_point_by { x = -border_inset; y = 0.0 } }
+ |> Some }
+ {b.box_group with content = Paths [border]}
+
+let unknown_to_group (unknown:string) : Svg.group =
+ { name = unknown
+ content = Raw unknown
+ anchors = []
+ debug_anchors = false
+ sub_groups = []
+ offset = None }
+
+
+// Conversion from ClassicDSD species. This is fairly straightforward, as the underlying representations are similar.
+
+let from_dsd_domain (mapping:Sequence.mapping) (dom:Domain.t) : DDomain =
+ let dname = Domain.get_name dom
+ let name = if dname.EndsWith("*") then dname.Substring(0,dname.Length-1) else dname
+ { name = name
+ nucleotides = match Sequence.get_domain mapping dom with None | Some None -> Domain.get_sequence dom |> Sequence.parse_sequence | Some (Some s) -> s
+ toehold = Domain.is_toehold dom
+ complemented = Domain.is_complemented dom
+ tether = if Domain.is_tethered dom then Domain.display_picture dom true |> Some else None
+ pseudoknot = None }
+
+let from_dsd_strand (mapping:Sequence.mapping) (st:Strand.t) : DStrand =
+ let from_dsd_domain = from_dsd_domain mapping
+ match st with
+ | Strand.Upper doms -> { kind = TopStrand; domains = List.map from_dsd_domain doms }
+ | Strand.Lower doms -> { kind = BottomStrand; domains = List.map from_dsd_domain doms }
+
+let from_dsd_segment (mapping:Sequence.mapping) (seg:Segment.t) : DSegment =
+ let from_dsd_domain = from_dsd_domain mapping
+ match seg with
+ | Segment.Double (bl, tl, m, tr, br) ->
+ { top_left = if tl=[] then None else { kind = TopStrand; domains = List.map from_dsd_domain tl } |> Some
+ top_right = if tr=[] then None else { kind = TopStrand; domains = List.map from_dsd_domain tr } |> Some
+ bottom_left = if bl=[] then None else { kind = BottomStrand; domains = List.map from_dsd_domain bl } |> Some
+ bottom_right = if br=[] then None else { kind = BottomStrand; domains = List.map from_dsd_domain br } |> Some
+ double_strand = { kind = DoubleStrand; domains = List.map from_dsd_domain m }
+ hairpin_left = None
+ hairpin_right = None
+ connection = None }
+ | Segment.Hairpin (b, t, m, h, side) ->
+ match side with
+ | Segment.Left ->
+ { top_left = None
+ top_right = if t=[] then None else { kind = TopStrand; domains = List.map from_dsd_domain t } |> Some
+ bottom_left = None
+ bottom_right = if b=[] then None else { kind = BottomStrand; domains = List.map from_dsd_domain b } |> Some
+ double_strand = { kind = DoubleStrand; domains = List.map from_dsd_domain m }
+ hairpin_left = { kind = LeftHairpinStrand; domains = List.map from_dsd_domain h } |> Some
+ hairpin_right = None
+ connection = None }
+ | Segment.Right ->
+ { top_left = if t=[] then None else { kind = TopStrand; domains = List.map from_dsd_domain t } |> Some
+ top_right = None
+ bottom_left = if b=[] then None else { kind = BottomStrand; domains = List.map from_dsd_domain b } |> Some
+ bottom_right = None
+ double_strand = { kind = DoubleStrand; domains = List.map from_dsd_domain m }
+ hairpin_left = None
+ hairpin_right = { kind = RightHairpinStrand; domains = List.map from_dsd_domain h } |> Some
+ connection = None }
+
+let from_dsd_gate (mapping:Sequence.mapping) (g:Gate.t) : DGate =
+ let from_dsd_segment = from_dsd_segment mapping
+ // A DSD gate is a double-list. Elements in the inner list are all bottom-connected, and are top-connected to other element sequences in the outer list.
+ let to_bottom_sequence (final: bool) (segs:Segment.t list) =
+ let len = segs.Length
+ List.mapi (fun i seg -> { from_dsd_segment seg with connection = if i = len-1 then (if final then None else Some TopLink) else Some BottomLink}) segs
+ let len = g.Length
+ let segments = List.mapi (fun i segl -> to_bottom_sequence (i=len-1) segl) g |> List.concat
+ { segments = segments; left_connection = None }
+
+let from_dsd_origami (mapping:Sequence.mapping) (o:Origami.t) : DOrigami =
+ let from_dsd_strand = from_dsd_strand mapping
+ let from_dsd_gate = from_dsd_gate mapping
+ let gate_to_simple_dbranch (g:Gate.t) = { gate = from_dsd_gate g; children = [] }
+ let to_origami_element (c:Origami.content) =
+ match c with
+ | Origami.C_strand str -> from_dsd_strand str |> Strand
+ | Origami.C_gate gate -> gate_to_simple_dbranch gate |> Branch
+ List.map to_origami_element o
+
+
+// Conversion from LogicDSD processes. This goes through a graph representation (where bind sites are edges and everything else is nodes).
+
+/// Site type for the intermediate representation. This is basically the same as SiteC, except that it also allows for the notion of an explicit "eliminated pseudoknot".
+type LSite = LBound of DomainC * BondC
+ | LUnbound of DomainC
+ | LPseudoknotBound of DomainC * BondC
+ with override this.ToString() = match this with
+ | LPseudoknotBound (domain,bond) -> domain.ToString()+"/"+bond.ToString()
+ | LBound (domain,bond) -> domain.ToString()+"."+bond.ToString()
+ | LUnbound domain -> domain.ToString()
+ end
+/// Process type for the intermediate representation. It's a list of strands, which are a list of sites.
+type LProcess = LSite list list
+/// Type representing a site sequence; this is basically a ProcessC where gaps between StrandC instances are replaced with a None object.
+type LSeq = LSite option list
+/// Node type for the intermediate graph representation. A node is conceptually a circle made of interleaved edges and LSeq instances. The first LSeq represents the unprocessed sites that lie on the node between the edge from its parent node and the first child edge (leading sequence). The tuples in the list are made of an edge, and the unprocessed sites (trailing sequence) that lie on the node between the edge and the next edge (or, in the case of the last tuple in the list, between the edge and the edge coming from the parent).
+type LNode = { leading: LSeq; edges: (LEdge * LSeq) list }
+/// Edge type for the intermediate graph representation. An edge is a DGate, plus the LNode to which it connects. Edges are directed. They connect to their parent node on the left, and to child nodes on the right.
+and LEdge = { gate: DGate; child: LNode }
+
+/// This functions converts a DomainC to a DDomain.
+let domainc_to_domain (domain:DomainC) (pseudoknot:int option) : DDomain =
+ { name = domain.name
+ nucleotides = []
+ toehold = domain.isToehold
+ complemented = domain.isComplementary
+ tether = match domain.tag with
+ | NoTagC -> None
+ | AnyTagC -> Some "_"
+ | TagC s -> Some s
+ pseudoknot = pseudoknot }
+
+/// This function converts a LSeq into a DStrand. It's used for cases where the entire graph is composed of a node with no edges. This means that it is a single strand. This is a special case, because it cannot be represented as a DBranch.
+let from_single_node_lgraph (lseq:LSeq) : DStrand =
+ let site_to_domain (s:LSite) : DDomain =
+ let (domain,pseudoknot) = match s with LBound (dom,_) -> (dom,None) | LPseudoknotBound (dom,pk) -> (dom,Some pk) | LUnbound dom -> (dom,None)
+ domainc_to_domain domain pseudoknot
+ let domains = lseq |> List.choose (fun x->x) |> List.map site_to_domain
+ // I expect the sequence to be a single strand, i.e. connected domains and a single "empty" site at the end. If there's more than oneempty site, then something is wrong. A process with more than one strand should always have at least one bond.
+ if domains.Length <> lseq.Length-1 then failwith "Error: root node is a split leaf" else
+ // By convention, I assume this strand to be top.
+ { domains = domains; kind = DStrandKind.TopStrand }
+
+/// This function "irons" the graph, that is, moves all domains that are inside an LNode into edges proper.
+let iron_root_graph (root:LNode) : LNode =
+ /// This function irons each edge's leading sequence into the top left of the edge.
+ let rec iron_top_left_all (leading:LSeq,edges:(LEdge*LSeq)list) =
+ /// Moves all domains from the leading sequence to the adjacent edge, up to the end or the first gap. Returns the modified leading sequence and modified edge.
+ let rec iron_top_left (leading:LSeq) (edge:LEdge) : (LSeq*LEdge) =
+ /// Moves one domain from the leading sequence to the adjacent edge, if possible. Returns the modified leading sequence and modified edge. If there's no domain to move, returns None.
+ let iron_top_left_single (leading:LSeq) (edge:LEdge) : (LSeq*LEdge) option =
+ match List.rev leading with
+ | [] -> None
+ | None::revrest -> None
+ | site::revrest ->
+ // I've removed a non-gap site immediately preceding the edge. Convert the site to a domain.
+ let domain = match site with
+ | Some (LUnbound dom) -> domainc_to_domain dom None
+ | Some (LPseudoknotBound (dom,pk)) -> domainc_to_domain dom (Some pk)
+ | _ -> failwith "this should never happen (bound domain in a node)"
+ let rest = List.rev revrest
+ // Attach it to the top left of the edge gate.
+ let dgate:DGate =
+ match edge.gate.segments with
+ | [] -> failwith "this should never happen (empty edge gate)"
+ | leftmost_segment::rest_gate ->
+ // Create the overhang if it doesn't exist yet.
+ let strand = match leftmost_segment.top_left with None -> {domains=[];kind=DStrandKind.TopStrand} | Some strand -> strand
+ let strand = {strand with domains=domain::strand.domains}
+ {edge.gate with segments={leftmost_segment with top_left = Some strand}::rest_gate}
+ Some (rest,{edge with gate = dgate})
+ let updated = iron_top_left_single leading edge
+ match updated with
+ | None ->
+ // Set the top connection for the leftmost gate. See if it has a top connection to the rest of the node.
+ let has_top_connection = leading = []
+ let connection = match edge.gate.left_connection with
+ | None | Some TopLink -> if has_top_connection then Some TopLink else None
+ | Some BottomLink | Some DoubleLink -> if has_top_connection then Some DoubleLink else Some BottomLink
+ // Recurse on children.
+ let (child_node_leading,child_node_edges) = iron_top_left_all (edge.child.leading,edge.child.edges)
+ let edge = {gate={edge.gate with left_connection=connection}; child={leading=child_node_leading;edges=child_node_edges}}
+ (leading,edge)
+ | Some (new_leading,new_edge) -> iron_top_left new_leading new_edge
+ // To make this easier, I'll temporarily convert the node into a form where each edge is associated to its leading sequence (instead of the trailing sequence). To help avoiding mistakes, the tuple for this association will be in the opposite order.
+ let trail_node_edges,trailing = List.mapFold (fun leading (edge,trailing) -> (leading,edge),trailing) leading edges
+ let trail_node_edges = List.map (fun (leading,edge) -> iron_top_left leading edge) trail_node_edges
+ // Convert back to the form where each edge is associated with its trailing sequence.
+ let edges,leading = List.mapFoldBack (fun (leading,edge) trailing -> (edge,trailing),leading) trail_node_edges trailing
+ (leading,edges)
+ /// This function irons each edge's trailing sequence into the bottom left of the edge.
+ let rec iron_bottom_left_all (leading:LSeq,edges:(LEdge*LSeq)list) =
+ /// Moves all domains from the trailing sequence to the adjacent edge, up to the end or the first gap. Returns the modified edge and trailing sequence.
+ let rec iron_bottom_left (trailing:LSeq) (edge:LEdge) : (LEdge*LSeq) =
+ /// Moves one domain from the trailing sequence to the adjacent edge, if possible. Returns the modified edge and trailing sequence. If there's no domain to move, returns None.
+ let iron_bottom_left_single (trailing:LSeq) (edge:LEdge) : (LEdge*LSeq) option =
+ match trailing with
+ | [] -> None
+ | None::rest -> None
+ | site::rest ->
+ // I've removed a non-gap site immediately following the edge. Convert it to a domain.
+ let domain = match site with
+ | Some (LUnbound dom) -> domainc_to_domain dom None
+ | Some (LPseudoknotBound (dom,pk)) -> domainc_to_domain dom (Some pk)
+ | _ -> failwith "this should never happen (bound domain in a node)"
+ // Attach it to the bottom left of the edge gate.
+ let dgate:DGate =
+ match edge.gate.segments with
+ | [] -> failwith "this should never happen (empty edge gate)"
+ | leftmost_segment::rest_gate ->
+ // Create the overhang if it doesn't exist yet.
+ let strand = match leftmost_segment.bottom_left with None -> {domains=[];kind=DStrandKind.BottomStrand} | Some strand -> strand
+ let strand = {strand with domains=domain::strand.domains}
+ {edge.gate with segments={leftmost_segment with bottom_left = Some strand}::rest_gate}
+ Some ({edge with gate=dgate},rest)
+ let updated = iron_bottom_left_single trailing edge
+ match updated with
+ | None ->
+ // Set the bottom connection for the leftmost gate. See if it has a bottom connection to the rest of the node.
+ let has_bottom_connection = trailing = []
+ let connection = match edge.gate.left_connection with
+ | None | Some BottomLink -> if has_bottom_connection then Some BottomLink else None
+ | Some TopLink | Some DoubleLink -> if has_bottom_connection then Some DoubleLink else Some TopLink
+ // Recurse on children.
+ let (child_node_leading,child_node_edges) = iron_bottom_left_all (edge.child.leading,edge.child.edges)
+ let edge = {gate={edge.gate with left_connection=connection}; child={leading=child_node_leading;edges=child_node_edges}}
+ (edge,trailing)
+ | Some (new_trailing,new_edge) -> iron_bottom_left new_edge new_trailing
+ let edges = List.map (fun (edge,trailing) -> iron_bottom_left trailing edge) edges
+ (leading,edges)
+ /// This function irons all domains in an edge's child node's leading sequence into the top right of the edge.
+ let rec iron_top_right (edge:LEdge) : LEdge =
+ /// Moves one domain in the child node's leading sequence into the edge's top right overhang. Returns the updated edge, or None if no changes were made.
+ let iron_top_right_single (edge:LEdge) : LEdge option =
+ match edge.child.leading with
+ | [] -> None
+ | None::rest -> None
+ | site::rest ->
+ // I've removed a non-gap site at the start of the node.
+ let domain = match site with
+ | Some (LUnbound dom) -> domainc_to_domain dom None
+ | Some (LPseudoknotBound (dom,pk)) -> domainc_to_domain dom (Some pk)
+ | _ -> failwith "this should never happen (bound domain in a node)"
+ // Attach it to the top right of the edge gate.
+ let dgate:DGate =
+ match List.rev edge.gate.segments with
+ | [] -> failwith "this should never happen (empty edge gate)"
+ | rightmost_segment::rest_gate ->
+ // Create the overhang if it doesn't exist yet.
+ let strand = match rightmost_segment.top_right with None -> {domains=[];kind=TopStrand} | Some strand -> strand
+ let strand = {strand with domains=strand.domains@[domain]}
+ {edge.gate with segments = {rightmost_segment with top_right = Some strand}::rest_gate |> List.rev}
+ Some {edge with gate=dgate;child={edge.child with leading=rest}}
+ let updated = iron_top_right_single edge
+ match updated with
+ | None ->
+ // Set the top connection for the rightmost gate. See if it has a top connection to the rest of the node.
+ let has_top_connection = edge.child.leading = []
+ match List.rev edge.gate.segments with
+ | [] -> failwith "this should never happen (empty edge gate)"
+ | rightmost_segment::rest_gate ->
+ let connection = match rightmost_segment.connection with
+ | None | Some TopLink -> if has_top_connection then Some TopLink else None
+ | Some BottomLink | Some DoubleLink -> if has_top_connection then Some DoubleLink else Some BottomLink
+ let rightmost_segment = {rightmost_segment with connection=connection}
+ let dgate = {edge.gate with segments=List.rev (rightmost_segment::rest_gate)}
+ {edge with gate=dgate}
+ | Some edge -> iron_top_right edge
+ /// This function irons all domains in an edge's child node's final trailing sequence into the bottom right of the edge.
+ let rec iron_bottom_right (edge:LEdge) : LEdge =
+ /// Moves one domain in the child node's final trailing sequence into the edge's bottom right overhang. Returns the updated edge, or None if no changes were made.
+ let iron_bottom_right_single (edge:LEdge) : LEdge option =
+ // I need the last child node edge.
+ match List.rev edge.child.edges with
+ | [] ->
+ // If the child node has no edges, I'll need to use the leading sequence instead (it'll end up being a right-hairpin).
+ match List.rev edge.child.leading with
+ | [] -> None
+ | None::rest -> None
+ | site::rest ->
+ let domain = match site with
+ | Some (LUnbound dom) -> domainc_to_domain dom None
+ | Some (LPseudoknotBound (dom,pk)) -> domainc_to_domain dom (Some pk)
+ | _ -> failwith "this should never happen (bound domain in a node)"
+ // Attach it to the bottom right of the edge gate.
+ let dgate:DGate =
+ match List.rev edge.gate.segments with
+ | [] -> failwith "this should never happen (empty edge gate)"
+ | rightmost_segment::rest_gate ->
+ // Create the overhang if it doesn't exist yet.
+ let strand = match rightmost_segment.bottom_right with None -> {domains=[];kind=DStrandKind.BottomStrand} | Some strand -> strand
+ let strand = {strand with domains=strand.domains@[domain]}
+ {edge.gate with segments={rightmost_segment with bottom_right = Some strand}::rest_gate |> List.rev}
+ // Return the altered DGate and child node.
+ Some {edge with gate=dgate;child={leading=List.rev rest;edges=[]}}
+ | (last_child_edge,trailing)::other_child_edges ->
+ match List.rev trailing with
+ | [] -> None
+ | None::rest -> None
+ | site::rest ->
+ let domain = match site with
+ | Some (LUnbound dom) -> domainc_to_domain dom None
+ | Some (LPseudoknotBound (dom,pk)) -> domainc_to_domain dom (Some pk)
+ | _ -> failwith "this should never happen (bound domain in a node)"
+ // Attach it to the bottom right of the edge gate.
+ let dgate:DGate =
+ match List.rev edge.gate.segments with
+ | [] -> failwith "this should never happen (empty edge gate)"
+ | rightmost_segment::rest_gate ->
+ // Create the overhang if it doesn't exist yet.
+ let strand = match rightmost_segment.bottom_right with None -> {domains=[];kind=DStrandKind.BottomStrand} | Some strand -> strand
+ let strand = {strand with domains=strand.domains@[domain]}
+ {edge.gate with segments={rightmost_segment with bottom_right = Some strand}::rest_gate |> List.rev}
+ // Rebuild the last edge of the child node, to subtract the final trailing site.
+ let updated_last_child_edge = (last_child_edge,List.rev rest)
+ // Rebuild the child node's edges list, with the updated last edge.
+ let updated_child_edges = List.rev (updated_last_child_edge::other_child_edges)
+ // Return the altered DGate and child node.
+ Some {edge with gate=dgate;child={edge.child with edges=updated_child_edges}}
+ let updated = iron_bottom_right_single edge
+ match updated with
+ | None ->
+ // Set the bottom connection for the rightmost gate. See if it has a bottom connection to the rest of the node.
+ let has_bottom_connection = match (List.rev edge.child.edges) with [] -> edge.child.leading = [] | (_,trailing)::_ -> trailing = []
+ match List.rev edge.gate.segments with
+ | [] -> failwith "this should never happen (empty edge gate)"
+ | rightmost_segment::rest_gate ->
+ let connection = match rightmost_segment.connection with
+ | None | Some BottomLink -> if has_bottom_connection then Some BottomLink else None
+ | Some TopLink | Some DoubleLink -> if has_bottom_connection then Some DoubleLink else Some TopLink
+ let rightmost_segment = {rightmost_segment with connection=connection}
+ let dgate = {edge.gate with segments =List.rev (rightmost_segment::rest_gate)}
+ {edge with gate=dgate}
+ | Some edge -> iron_bottom_right edge
+ // Get a version of the node where all non-gap domains have been moved to the edges.
+ let rec iron_graph (root:LNode) : LNode =
+ let (leading,edges) = iron_top_left_all (root.leading,root.edges)
+ let (leading,edges) = iron_bottom_left_all (leading,edges)
+ let edges = List.map (fun (edge,trailing) -> (iron_top_right edge),trailing) edges
+ let edges = List.map (fun (edge,trailing) -> (iron_bottom_right edge),trailing) edges
+ // Recurse on child nodes.
+ let edges = List.map (fun (edge,trailing) -> {edge with child=iron_graph edge.child}, trailing) edges
+ // Now I have a graph where the nodes don't have any site, except for gaps.
+ {leading=leading;edges=edges}
+ // Special handling of the root node. Because it does not have an in-edge, and it only has a single out-edge, the leading and trailing loop back. Note that I'm going to be using new names for each step (leading1, leading2...) because this makes it far easier to view each step's result while debugging.
+ let (edge,trailing) = match root.edges with [(edge,trailing)] -> (edge,trailing) | _ -> failwith "root node does not have 1 edge"
+ // Move the edge's trailing to the leading, so that iron_top_left_all can handle it properly.
+ let leading1 = trailing@root.leading
+ let edges1=[(edge,[])]
+ let (leading2,edges2) = iron_top_left_all (leading1,edges1)
+ // Move the leading into the edge's trailing, so that iron_bottom_left_all can handle it properly.
+ let (edge,trailing) = match edges2 with [(edge,trailing)] -> (edge,trailing) | _ -> failwith "root node does not have 1 edge"
+ let edges3=[(edge,trailing@leading2)]
+ let leading3=[]
+ let (leading4,edges4) = iron_bottom_left_all (leading3,edges3)
+ // The right side does not need special handling.
+ let edges5 = List.map (fun (edge,trailing) -> (iron_top_right edge),trailing) edges4
+ let edges6 = List.map (fun (edge,trailing) -> (iron_bottom_right edge),trailing) edges5
+ // Recurse on child nodes.
+ let edges7 = List.map (fun (edge,trailing) -> {edge with child=iron_graph edge.child}, trailing) edges6
+ // Now I have a graph where the nodes don't have any site, except for gaps.
+ {leading=leading4;edges=edges7}
+
+/// This function collapses single-edge nodes, turning them into DBranch terminators.
+let collapse_single_edge_nodes (root:LNode) : LNode =
+ /// This function handles an edge.
+ let rec collapse_edge (edge:LEdge) : LEdge =
+ match edge.child with
+ | {leading=leading;edges=[]} ->
+ // The edge leads to a leaf node. The node is used to terminate the edge on the right. The node should either have a single gap site, or no sites at all.
+ match leading with
+ | [None] -> {edge with child={leading=[];edges=[]}} // The node has a gap, so the two strands of the edge don't connect. The edge is fine as it is.
+ | [] ->
+ // The node does not have a gap, so the two strands of the edge connect. This means that the right side of the edge (upper and lower) need to get joined and become a hairpin.
+ match List.rev edge.gate.segments with
+ | rightmost_segment::rest_of_gate ->
+ let top_right = match rightmost_segment.top_right with None -> [] | Some strand -> strand.domains
+ let bottom_right = match rightmost_segment.bottom_right with None -> [] | Some strand -> strand.domains
+ let updated_rightmost_segment = { rightmost_segment with hairpin_right = Some {domains=(List.rev top_right)@bottom_right;kind=DStrandKind.RightHairpinStrand}
+ top_right = None
+ bottom_right = None
+ connection = None }
+ let dgate = {edge.gate with segments = List.rev (updated_rightmost_segment::rest_of_gate)}
+ // Update the dgate.
+ {edge with gate=dgate;child={leading=[];edges=[]}}
+ | _ -> failwith "this should never happen (empty dgate)"
+ | _ -> failwith "this should never happen (domain found on a node during collapse)"
+ | {leading=leading;edges=edges} ->
+ // The edge leads to a non-leaf node. Recurse on all children.
+ let edges = List.map (fun (edge,trailing) -> (collapse_edge edge,trailing)) edges
+ // Return the edge with the modified children.
+ {edge with child={leading=leading;edges=edges}}
+ // The root node is special, because it doesn't have an incoming edge. This means that it might itself be used to terminate an edge on the left.
+ match root with
+ | {leading=leading;edges=[edge,trailing]} ->
+ // The root node is a leaf. The node is used to terminate the single out-edge on the left. The node should either have a single gap site, or no sites at all. Note that the leading and trailing sequences can be merged for this purpose, as they'll be adjacent.
+ match leading@trailing with
+ | [None] -> {leading=[];edges=[collapse_edge (edge),trailing]} // The node has a gap, so the edge is fine as it is.
+ | [] ->
+ // The node has no gap, so the top-left and bottom-left overhangs need to be joined into a left-hairpin.
+ match edge.gate.segments with
+ | leftmost_segment::rest_of_gate ->
+ let top_left = match leftmost_segment.top_left with None -> [] | Some strand -> strand.domains
+ let bottom_left = match leftmost_segment.bottom_left with None -> [] | Some strand -> strand.domains
+ let updated_leftmost_segment = { leftmost_segment with hairpin_left = Some {domains=bottom_left@(List.rev top_left);kind=DStrandKind.LeftHairpinStrand}
+ top_left = None
+ bottom_left = None }
+ let dgate = {edge.gate with segments= updated_leftmost_segment::rest_of_gate}
+ // Update the dgate and the node, and recurse on the child.
+ {leading=[];edges=[collapse_edge ({edge with gate=dgate}),trailing]}
+ | _ -> failwith "this should never happen (empty dgate)"
+ | _ -> failwith "this should never happen (domain found on a node during collapse)"
+ | {leading=leading;edges=edges} ->
+ // The root node is not a leaf. Recurse on all children.
+ let edges = List.map (fun (edge,trailing) -> (collapse_edge edge),trailing) edges
+ {leading=leading;edges=edges}
+
+/// This function changes the graph's direction (i.e. picks a new root node) so that the root is a leaf node. Note that the root should always be a leaf node at this stage, so concretely I'm just doing validation here.
+let rotate_graph_structure (root:LNode) : LNode =
+ match root.edges with
+ | first::second::more ->
+ failwith "graph root is not a leaf node"
+ | _ -> root
+
+/// This function collapses dual-edge nodes, getting rid of them altogether, joining the two edges into a single edge. Precondition: the graph should be ironed, and the root node should be a leaf.
+let rec collapse_dual_edge_nodes (root:LNode) : LNode =
+ /// If the edge's child node has a single child, then this function collapses the node and returns the modified edge. Otherwise, it does not modify the edge. Either way, it recurses.
+ let rec collapse_edge (edge:LEdge) : LEdge =
+ match edge.child.edges with
+ | [child_edge,trailing] ->
+ // The node has a single child. There are three possible cases: 1) the leading sequence is a gap and the trailing sequence is empty; 2) the leading sequence is empty and the trailing sequence is a gap; 3) both the leading and trailing sequences are empty. Note that there should never be a gap in both the leading and trailing sequences, because that would mean the strands are disconnected.
+ // Look at the right side of the parent segment and the left side of the child segment. Note that these sides cannot be hairpins (or there wouldn't even be a branch), so I don't need to check for that.
+ match List.rev edge.gate.segments with
+ | last_parent_segment::rest_parent ->
+ match child_edge.gate.segments with
+ | first_child_segment::rest_child ->
+ match (edge.child.leading,trailing) with
+ | [None],[] ->
+ // Case 1. Remove the node. Join the branches with a lower connection.
+ let connected_segment = { last_parent_segment with connection = Some BottomLink }
+ let merged_dgate = {child_edge.gate with segments = ((List.rev rest_parent)@[connected_segment])@child_edge.gate.segments;left_connection=edge.gate.left_connection}
+ // Recurse on the same edge, because it's now pointing to a different node.
+ {child_edge with gate=merged_dgate} |> collapse_edge
+ | [],[None] ->
+ // Case 2. Remove the node. Join the branches with an upper connection.
+ let connected_segment = { last_parent_segment with connection = Some TopLink }
+ let merged_dgate = {child_edge.gate with segments= ((List.rev rest_parent)@[connected_segment])@child_edge.gate.segments;left_connection=edge.gate.left_connection}
+ // Recurse on the same edge, because it's now pointing to a different node.
+ {child_edge with gate=merged_dgate} |> collapse_edge
+ | [],[] ->
+ // Case 3. I'd have to join branches with both upper and lower connections. There are two possible cases: A) the parent branch ends on a double strand and the child branch starts on a double strand; B) any other case.
+ match (last_parent_segment.top_right,last_parent_segment.bottom_right,first_child_segment.top_left,first_child_segment.bottom_left) with
+ | None,None,None,None ->
+ // Case A. Remove the node. Join the segments into a single segment, at the double strand.
+ let merged_segment = { top_left = last_parent_segment.top_left
+ bottom_left = last_parent_segment.bottom_left
+ hairpin_left = last_parent_segment.hairpin_left
+ top_right = first_child_segment.top_right
+ bottom_right = first_child_segment.bottom_right
+ hairpin_right = first_child_segment.hairpin_right
+ double_strand = { domains = last_parent_segment.double_strand.domains@first_child_segment.double_strand.domains; kind = DStrandKind.DoubleStrand };
+ connection = first_child_segment.connection }
+ let merged_dgate = {child_edge.gate with segments=((List.rev rest_parent)@[merged_segment])@rest_child;left_connection=edge.gate.left_connection}
+ // Recurse on the same edge, because it's now pointing to a different node.
+ {child_edge with gate=merged_dgate} |> collapse_edge
+ | _ ->
+ // Case B. The segments have at least one single strand between them. Remove the node. Join the branches with a double connection, forming a bulge.
+ let connected_segment = { last_parent_segment with connection = Some DoubleLink }
+ let merged_dgate = {child_edge.gate with segments=((List.rev rest_parent)@[connected_segment])@child_edge.gate.segments;left_connection=edge.gate.left_connection}
+ // Recurse on the same edge, because it's now pointing to a different node.
+ {child_edge with gate=merged_dgate} |> collapse_edge
+ | _ -> failwith "this should never happen (unexpected dual-edge node content)"
+ | [] -> failwith "this should never happen (empty dgate)"
+ | [] -> failwith "this should never happen (empty dgate)"
+ | _ -> {edge with child=collapse_dual_edge_nodes edge.child} // The node is either a leaf, or it has more than one child. The first case can be ignored, the second case can never be collapsed. Recurse on outgoing edges.
+ let edges = List.map (fun (edge,trailing) -> (collapse_edge edge),trailing) root.edges
+ {root with edges=edges}
+
+/// This function takes a graph that's already fully collapsed, and produces the corresponding DBranch.
+let convert_to_dbranch (root:LNode) : DBranch =
+ match root.edges with
+ | [edge,trailing] ->
+ let rec convert_child child_edge : DBranch =
+ { gate = child_edge.gate
+ children = List.map (fun (edge,_) -> convert_child edge) child_edge.child.edges }
+ convert_child edge
+ | _ -> failwith "this should never happen (root node is not a leaf)"
+
+/// This function converts the intermediate representation into a DSD-style object that can be rendered. If the node is a leaf, then this is a single DStrand. Otherwise, this is a DBranch.
+let from_lgraph (root:LNode) : DOrigamiElement =
+ match root.edges with
+ | [] -> Strand (from_single_node_lgraph root.leading) // Special case: single-node graph. It's just a strand.
+ | _ ->
+ // This is a proper graph. First of all, I need to "iron" it. This gets me a graph where all domains are in the edges.
+ let ironed = iron_root_graph root
+ // Collapse single-edge nodes into DGate terminators. This will get me a graph where all leaf nodes are empty and can be ignored.
+ let collapsed1 = collapse_single_edge_nodes ironed
+ // Ensure that the root is a leaf node. This ensures that any dual-edge nodes have exactly one incoming and one outgoing edge.
+ let rotated = rotate_graph_structure collapsed1
+ // Collapse dual-edge nodes into DGate junctions. This will get me a graph where leaf nodes can be ignored, and all other nodes become branches.
+ let collapsed2 = collapse_dual_edge_nodes rotated
+ // The root node is special because it has no in-edge. The method that sets left_connection assumes the presence of a in_edge, so the result may be wrong. Fixing this is trivial, as the left_connection of a root node is always None.
+ let collapsed2 = match collapsed2.edges with
+ | [edge,trailing] -> { collapsed2 with edges = [{edge with gate={edge.gate with left_connection=None}},trailing]}
+ | _ -> ironed
+ // Convert collapsed graph into a DBranch.
+ convert_to_dbranch collapsed2 |> Branch
+
+let from_logic_dsd (l:RulesDSD.Syntax.Process) : DOrigamiElement =
+ let original_proc:ProcessC = to_concrete_process l
+ let map_site s =
+ match s with
+ | BoundC (dom,b) -> LBound (dom,b)
+ | UnboundC dom -> LUnbound dom
+ let map_strandc (s:StrandC) : LSite list = List.map map_site s
+ let proc:LProcess = List.map map_strandc original_proc
+ /// This function changes the ordering of StrandC instances within proc so that there are no pseudoknots. If a pseudoknot is inevitable, then one of the bonds that make up the pseudoknot should be "unbound" for the purposes of rendering, and marked so that it can be displayed in some other way.
+ let rec reorder_process_avoid_pseudoknots (p:LProcess) : LProcess option =
+ /// Takes an element and a list. Returns the set of all lists generated by inserting that element at each possible position within the list.
+ let distrib e L =
+ let rec aux pre post =
+ seq {
+ match post with
+ | [] -> yield (L @ [e])
+ | h::t -> yield (List.rev pre @ [e] @ post)
+ yield! aux (h::pre) t
+ }
+ aux [] L
+ /// Takes a list of objects, returns a set of lists that are all possible permutations of the original list.
+ let rec perms = function
+ | [] -> Seq.singleton []
+ | h::t -> Seq.collect (distrib h) (perms t)
+ // Get all possible permutations of the strands within the ProcessC.
+ let all_perms : LProcess seq = perms p
+ /// Takes a ProcessC and returns a site involved in a pseudoknot within the process, or None if there is no pseudoknot. The process is converted into a single sequence, which is then traversed. Each time a bond site is found, the traversal begins searching for the matching bond site. This is done recursively, so that at any given time I am searching for the site that matches the last unmatched bond site. When the matching bond site is found, the traversal resumes searching for any bond site. If the traversal ends while still searching for a match for some bond site, it means that the matching bond site was skipped because it was encountered while searching for some other match. This in turn means that there is a pseudoknot, and the pseudoknot involves the unmatched site.
+ let find_pseudoknot (p:LProcess) : BondC option =
+ // For the purpose of finding pseudoknots, all I care about is bonds and their ordering. So I'm getting rid of everything else. I'll filter out non-bond sites, only take the bond ID, and concatenate everything. I'll end up with a list of ints.
+ let bonds_sequence : BondC list = p |> List.map (fun s -> List.choose (fun site -> match site with LBound (_,bond) -> Some bond | _ -> None) s) |> List.concat
+ // This may have eliminated everything.
+ if bonds_sequence = [] then None else
+ /// This function searches the sequence for the matching bond, and recursively searches it for any other matches it encounters. If it turns out to be impossible to match a bond, then that bond is returned.
+ let rec find_match (b:BondC) (sequence:BondC list) : BondC option*BondC list =
+ match sequence with
+ | [] -> Some b,[] // No more bonds. No match found.
+ | [bb] -> (if b = bb then None else Some b),[] // End of the sequence: last chance to match the bond.
+ | bb::rest -> // More bonds.
+ // If this is the match, then I'm satisfied and I'll return the rest of the sequence.
+ if b = bb then None,rest else
+ // This is not the match. I need to start a new search for the match to the new bond.
+ let (pseudoknot,more) = find_match bb rest
+ // Let's see if the new bond was matched.
+ match pseudoknot with
+ | None -> find_match b more // The new bond was matched. I'll keep searching for the match to my own bond.
+ | _ -> (pseudoknot,more) // The new bond was not matched. Return the pseudoknot.
+ /// This functions searches a sequence for pseudoknots. It returns one of the bonds involved in the pseudoknot, or None if there is no pseudoknot.
+ let find_pseudoknot (sequence:BondC list) : BondC option =
+ /// This function implements a recursive search on the sequence.
+ let rec find_pseudoknot_internal (sequence:BondC list) : BondC option*BondC list =
+ // If the sequence is empty, I'm done and I have no pseudoknots.
+ if sequence = [] then None,[] else
+ // Let's see if the first bond has a pseudoknot.
+ let pseudoknot = find_match sequence.Head sequence.Tail
+ match pseudoknot with
+ | None,rest -> find_pseudoknot_internal rest // No pseudoknot so far. Let's look at the next bond.
+ | _ -> pseudoknot // Pseudoknot. Return it.
+ // Begin the recursive search.
+ let (pseudoknot,_) = find_pseudoknot_internal sequence
+ pseudoknot
+ let pseudoknot = find_pseudoknot bonds_sequence
+ pseudoknot
+ /// This function returns true if the process is connected. A process that's not connected would result in disjointed graphs.
+ let is_connected (p:LProcess) : bool =
+ let tagged = List.map (fun st -> (st, ref false)) p
+ let rec tag_by_bond (bond:BondC) =
+ let has_bond (st:LSite list) = List.exists (fun s -> match s with LBound (_,b) -> b=bond | _ -> false) st
+ List.iter (fun (st,tag) -> if has_bond st then tag_strand (st,tag) else ()) tagged
+ and tag_strand (st,tag) =
+ if !tag then () else
+ tag := true
+ List.iter (fun site -> match site with LBound (_,b) -> tag_by_bond b | _ -> ()) st
+ tag_strand tagged.Head
+ not (List.exists (fun t -> false = !(snd t)) tagged)
+ // Find a "good" permutation. A good permutation has no pseudoknots and no unbound strands.
+ match Seq.tryFind (fun pp -> let pseudoknot = find_pseudoknot pp in pseudoknot.IsNone && is_connected pp) all_perms with
+ | Some ok_process -> Some ok_process
+ | None ->
+ // No permutation that avoids pseudoknots could be found. I'll unbind domains one after the other until I end up with a "good" permutation.
+ let all_bonds : BondC list = p |> List.map (fun s -> List.choose (fun site -> match site with LBound (_,bond) -> Some bond | _ -> None) s) |> List.concat |> List.distinct
+ let try_remove_bond (bond:BondC) : LProcess option =
+ // The bound domain will be unbound and marked.
+ let map_site (s:LSite) =
+ match s with
+ | LBound (dom,b) -> (if b = bond then LPseudoknotBound (dom,b) else LBound (dom,b))
+ | other -> other
+ let new_process = List.map (fun s -> List.map map_site s) p
+ reorder_process_avoid_pseudoknots new_process
+ // For each bond, get the process that results from removing that bond (provided that the removal results in a "good" permutation).
+ let candidates:LProcess list = List.choose try_remove_bond all_bonds
+ // Search for the "best" solution.
+ match candidates with
+ | [] -> None
+ | _ ->
+ /// Ranks a process (returns the number of eliminated pseudoknot bonds). The lower, the better.
+ let rank (p:LProcess) = p |> List.concat |> List.sumBy (fun st -> match st with LPseudoknotBound _ -> 1 | _ -> 0)
+ // Find the candidate where the least number of bonds has been eliminated.
+ let pp = List.minBy rank candidates
+ Some pp
+
+ // Get a ProcessC with no pseudoknots.
+ let reordered_proc = match reorder_process_avoid_pseudoknots proc with
+ | Some proc -> proc
+ | None -> failwith "this should never happen (unable to eliminate pseudoknots and/or create a fully connected graph)"
+ // Convert the process into a LSeq. The LSeq is the result of stacking the strands back-to-back and putting a gap between them.
+ let original_lseq = (List.map (fun s -> (List.map Some s)@[None]) reordered_proc) |> List.concat
+ /// This function reorders a LSeq by moving elements from the bottom to the top, in such a way that the first level of a recursive search for bonded couples will only find one couple. This results in the graph only having one out-edge from the root. This is a property that's required later on. Note that doing this is allowed because the full initial LSeq can be considered to be circular.
+ let make_single_root lseq : LSeq =
+ /// This function splits the sequence in two, around a point that's between two bond sites that have no other bond sites between them. Any sequence without pseudoknots has to have at least one such point.
+ let rec take_leading (before:LSeq) (sourceseq:LSeq) =
+ match sourceseq with
+ | [] -> (before,[])
+ | head::rest ->
+ let new_before = (before@[head])
+ match head with
+ | Some (LBound (_,bond)) ->
+ let rec find_match seq =
+ match seq with
+ | (Some (LBound (_,bond2)))::_ -> bond=bond2
+ | [] -> false
+ | _::rest -> find_match rest
+ if find_match rest then new_before,rest else
+ take_leading new_before rest
+ | _ -> take_leading new_before rest
+ let (before,after) = take_leading [] lseq
+ after@before
+ let lseq = make_single_root original_lseq
+ /// This function "processes" a lseq into a node. It examines all sites in sequence. When it finds a bound site, it searches for the matching site in the rest of the sites. The two bound sites become an edge, and sites between them gets split off into a new child node, which gets recursively processed. Examination then resumes from the first site immediately following the second bound site.
+ let rec process_lseq (sourceseq:LSeq) : LNode =
+ // Get the leading part of the node. This is the sequence that goes from the start of the node (the site immediately after the parent-edge), to either the first child-edge, or the end of the node (if the node has no bound sites and therefore no children).
+ let rec take_sequence (leading:LSeq,rest:LSeq) : LSeq*LSeq =
+ match rest with
+ | Some (LBound (_,_))::_ -> (leading,rest) // found a bond site: the leading bit is done. Note I'm not consuming the site at this point.
+ | site::more -> take_sequence (leading@[site],more) // found a non-bond site: add it to the leading bit and recurse.
+ | [] -> (leading,rest) // reached the end: return.
+ // Get the edges, including the actual edge, the child node, and the trailing sequence.
+ let rec take_edges (edges:(LEdge*LSeq)list,rest:LSeq) : (LEdge*LSeq)list*LSeq =
+ match rest with
+ | [] -> (edges,rest) // reached the end: return.
+ | Some (LBound (dom1,bond))::more -> // found a bond site, now I need to scan for the corresponding site.
+ let rec take_child_seq (childseq:LSeq,rest:LSeq) : LSeq*LSeq =
+ match rest with
+ | Some (LBound (_,same_bond))::moremore when same_bond = bond -> (childseq,moremore) // found the bound site. I'm consuming it and returning the child sequence.
+ | site::moremore -> take_child_seq (childseq@[site],moremore) // bound site not yet found, add this to the sequence and recurse.
+ | [] -> failwith "cannot find a matching bond site; this should never happen (bad pseudoknot elimination?)"
+ let (child_seq,moreseq) = take_child_seq ([],more)
+ // Create the edge gate.
+ let edge_gate_segments = [{ top_left = None
+ top_right = None
+ bottom_left = None
+ bottom_right = None
+ hairpin_left = None
+ hairpin_right = None
+ double_strand = { domains = [domainc_to_domain dom1 None]; kind = DoubleStrand }
+ connection = None }]
+ let edge_gate = {segments=edge_gate_segments; left_connection=None}
+ // Recursively create the child node.
+ let child_node = process_lseq child_seq
+ // Get the trailing sequence.
+ let (trailing_sequence,moremoreseq) = take_sequence ([],moreseq)
+ // Make the new edge + trailing sequence.
+ let edge = {gate=edge_gate;child=child_node},trailing_sequence
+ // Append it.
+ let edges = edges@[edge]
+ // Recurse on the following sequence.
+ let (edges,restseq) = take_edges (edges,moremoreseq)
+ (edges,restseq)
+ | _ -> failwith "non-bond site after following a leading/trailing sequence; this should never happen"
+ let (leading,edgesseq) = take_sequence ([],sourceseq)
+ let (edges,_) = take_edges ([],edgesseq)
+ {leading=leading;edges=edges}
+ let topNode = process_lseq lseq
+ let dbranch = from_lgraph topNode
+ dbranch
+
+
+// "Branches" renderer for DSD species
+
+/// Produces the CSS style for the SVG produced by this module. Requires the set of domain->color associations. The rest of the styles are fixed.
+let style cm =
+ let dom_styles = cm |> Lib.string_of_list (fun (id:string, col) -> let id = sanitize_id id in "path."+base_class+".dom_"+id + " { stroke: " + col + " } text."+base_class+".dom_"+id+" { fill: " + col + " }") " " in
+ let base_style = "g { fill: none; } path."+base_class+" { stroke: silver; stroke-width: " + Svg.display_float line_width + "; stroke-linejoin: round; } text."+base_class+" { fill: black; stroke-width: 0; font-family: Verdana,Arial,sans-serif; font-size: " + string (int font_size) + "px; text-anchor: middle } text.fixedwidth { font-family:Lucida Console,monospace } text.pseudoknot { font-weight:bold } path.shortbranchjoin { "+short_branch_join_style+" } path.branchjoin { "+branch_join_style+" }"
+ let path_style = sprintf "path { stroke: silver; stroke-width: %f; stroke-linejoin: round; fill: none; }" line_width
+ let text_style = sprintf "text { stroke: black; fill: black; stroke-width: 0; font-family: Verdana,Arial,sans-serif; font-size: %fpx; text-anchor: middle; }" font_size
+ let base_style = path_style+" "+text_style+" "+base_style
+ let tether_style = "path."+base_class+".tether-pin { stroke : black }"
+ base_style + " " + dom_styles + " " + tether_style
+
+let palette = [ "red"; "green"; "blue"; "orange"; "purple"
+ ; "cyan"; "brown"; "magenta"; "dodgerblue"; "orchid"
+ ; "lawngreen"; "lightskyblue"; "darksalmon"; "teal"; "rosybrown"
+ ; "navajowhite"; "olive"; "darkseagreen"; "darkgoldenrod"; "pink" ]
+
+/// Takes a partial map of domains->colors and a complete list of species, and returns a complete map of domain IDs->colors.
+let dom_map (dcs:Hashtable.t) species_list =
+ let (_,taken_colours) = Hashtable.to_list dcs |> List.unzip
+ let free_colours = palette |> List.filter (fun c -> List.exists ((=) c) taken_colours |> not) in
+ let dom_counter = ref 0 in
+ let ret = Hashtable.empty() in
+ let add d =
+ let name = (d |> from_dsd_domain Sequence.empty).name in
+ match name |> Hashtable.tryFind ret with
+ | None ->
+ let colour = match name |> Hashtable.tryFind dcs with
+ | None ->
+ let c = free_colours.[!dom_counter] in
+ dom_counter := (!dom_counter + 1) % free_colours.Length;
+ c
+ | Some c -> c in
+ Hashtable.add ret name colour
+ | Some _ -> ()
+ let xx = species_list
+ |> List.collect Species.domains
+ |> List.filter Domain.is_toehold
+ |> Lib.remove_duplicates (=)
+ List.iter add xx;
+ ret
+
+/// Returns the CSS style for the SVG representation of the given species. You can pass a partial map of domains->colors; the rest of the domains will get assigned colors automatically.
+let species_style dc (sp:Species.t list) : string =
+ let dc = dom_map dc sp
+ dc |> Hashtable.to_list |> style
+
+let species_to_svg_branches (arrange:arrange_mode) (mode:renderer_mode) (mapping:Sequence.mapping) (rotate_labels:bool) (style:string) (sp:Species.t) : string =
+ let nucleotides = mode = renderer_mode.Nucleotides
+ let g = match sp with
+ | Species.STRAND strand ->
+ let dstrand = from_dsd_strand mapping strand
+ dstrand_to_group mode rotate_labels None false None false false false dstrand
+ | Species.GATE gate ->
+ let dgate = from_dsd_gate mapping gate
+ dgate_to_group mode rotate_labels dgate
+ | Species.ORIGAMI origami ->
+ let dorigami = from_dsd_origami mapping origami
+ dorigami_to_group arrange mode rotate_labels dorigami
+ | Species.UNKNOWN unknown ->
+ unknown_to_group unknown
+ | Species.LogicDsdProcess logic ->
+ let delement = from_logic_dsd logic
+ match delement with
+ | Strand strand -> dstrand_to_group mode rotate_labels None false None false false false strand
+ | Branch branch -> dbranch_to_group arrange mode rotate_labels branch
+ let box = Svg.emerge_groups [g]
+ let ret = Svg.to_string_normalise (not rotate_labels && not nucleotides) style box
+ ret
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/branchesrenderer.fsi b/ClassicDSD/ClassicDSDDotNet/branchesrenderer.fsi
new file mode 100644
index 0000000..2f6c93a
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/branchesrenderer.fsi
@@ -0,0 +1,65 @@
+module Microsoft.Research.DNA.BranchesRenderer
+open Microsoft.Research.CRNEngine
+open Microsoft.Research.DNA.Options
+
+
+type internal DDomain = {
+ name: string;
+ nucleotides: Sequence.t;
+ toehold: bool;
+ complemented: bool;
+ tether: string option;
+ pseudoknot: int option;
+} with
+ member GetComplemented : unit -> DDomain
+ override ToString : unit -> string
+end
+
+type internal DStrandKind = TopStrand | BottomStrand | DoubleStrand | LeftHairpinStrand | RightHairpinStrand
+
+type internal DStrand = {
+ kind: DStrandKind;
+ domains: DDomain list;
+} with
+ override ToString : unit -> string
+
+
+type internal DSegmentConnection = TopLink | BottomLink | DoubleLink
+
+type internal DSegment = {
+ top_left: DStrand option;
+ top_right: DStrand option;
+ bottom_left: DStrand option;
+ bottom_right: DStrand option;
+ double_strand: DStrand;
+ hairpin_left: DStrand option;
+ hairpin_right: DStrand option;
+ connection: DSegmentConnection option;
+} with
+ override ToString : unit -> string
+end
+
+type internal DGate = {
+ left_connection: DSegmentConnection option;
+ segments: DSegment list;
+} with
+ override ToString : unit -> string
+end
+
+type internal DBranch = {
+ gate: DGate;
+ children: DBranch list;
+}
+
+type internal DOrigamiElement = Strand of DStrand | Branch of DBranch
+
+type internal DOrigami = DOrigamiElement list
+
+val internal from_dsd_strand : Sequence.mapping -> Strand.t -> DStrand
+val internal from_dsd_gate : Sequence.mapping -> Gate.t -> DGate
+val internal from_dsd_origami : Sequence.mapping -> Origami.t -> DOrigami
+val internal from_logic_dsd : RulesDSD.Syntax.Process -> DOrigamiElement
+
+val dom_map : Hashtable.t -> Species.t list -> Hashtable.t
+val species_style : Hashtable.t -> Species.t list -> string
+val species_to_svg_branches : arrange_mode -> renderer_mode -> Sequence.mapping -> bool -> string -> Species.t -> string
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/circlesrenderer.fs b/ClassicDSD/ClassicDSDDotNet/circlesrenderer.fs
new file mode 100644
index 0000000..4809e04
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/circlesrenderer.fs
@@ -0,0 +1,621 @@
+[]
+module Microsoft.Research.DNA.CirclesRenderer
+open Microsoft.Research.DNA.LogicDSD
+open Microsoft.Research.DNA.Species
+open Microsoft.Research.CRNEngine.Svg
+
+// FP: I am adapting this from the version in SiteGraphReactor.
+
+//---------------------------
+// Circle based visualisation
+// (NuPack-style)
+// From DnaModelling solution, DnaStructures project, Visualizations.fs file
+//---------------------------
+
+(* Algorithm:
+ - build a circle with edges
+ - collapse edges until they are all turned into children
+ - collapse edges in children recursively
+*)
+
+type svg_domain =
+ | Domain of DomainC
+ | Xing of DomainC
+ | Hole
+ member this.text =
+ match this with
+ | Domain dom -> dom.ToString().Replace("^", "")
+ | Xing _ -> "X"
+ | Hole -> "O"
+ member this.compl =
+ match this with
+ | Domain dom -> Domain { dom with isComplementary = not dom.isComplementary }
+ | _ -> this
+
+/// Represents a circle. The circle is made of ports (which mostly correspond to domains), and may have children (which are other circles connected to it). A circle may be itself the child of another circle, but does not maintain a reference to its parent.
+type circle =
+ /// The center of the circle.
+ { center : float * float
+ /// A rotation to be applied to the circle (to align its ports correctly).
+ ; angle : float
+ /// The circle radius.
+ ; radius : float // Invariant: radius = ports.Length |> circle_radius
+ /// The ports that make up the circle.
+ ; ports : svg_domain[]
+ /// The circle's children. The type of a child is a tuple of: an integer which is the index in the port sequence on which the child is connected to the parent; a domain which is the edge domain connecting the two circles, and the actual child circle.
+ ; children : (int * svg_domain * circle) list
+ /// Edges within the circle, i.e. sites that ought to connect. If there are edges, then the circle can be collapsed further.
+ ; edges : (int*int) []
+ }
+
+let pi = System.Math.PI
+let twopi = 2.0 * pi
+
+let min_side_length = 100.0
+let xing_length_per_char = 30.0
+let circle_has_overhangs ports = Array.exists (fun d -> match d with Domain d -> true | _ -> false) ports
+/// Determines the radius of a circle, based on the ports (domains) in it. The radius is determined so that each arc is min_side_length units long.
+let circle_radius ports =
+ match ports with [|Xing _; Xing _|] -> 4.0
+ | _ -> 0.5*(min_side_length * float ports.Length)/twopi * (if circle_has_overhangs ports then 1.0 else 0.4)
+
+/// Make crossings longer when domain names are long.
+let xing_side_length (b:svg_domain) =
+ match b with
+ | Hole ->
+ min_side_length
+ | Xing dom
+ | Domain dom ->
+ let l = float dom.name.Length * xing_length_per_char
+ max l min_side_length
+
+/// Normalize the tuple so that the smaller int goes first.
+let sort_e (p1:int, p2:int) = min p1 p2, max p1 p2
+
+/// This function receives a circle and an edge within the circle (in the form of a couple of indexes within the circle's ports array). It returns the same circle, except that now it has an additional child. The ports array is split between the parent and the child, and each side of the edge becomes a crossing port, where they join.
+let circle_split (p1, p2) (c:circle) = // Do not split on an edge with a right neighbour
+ /// The ports, sorted so that p1 is guaranteeed to be the lowest.
+ let p1, p2 = sort_e (p1,p2)
+ /// The length (in sites count) of the current circle.
+ let n = c.ports.Length
+ /// The length of the first new circle (parent).
+ let n1 = n - (p2-p1)
+ /// The length of the second new circle (child).
+ let n2 = p2-p1
+ /// This function takes the index of a site in the new parent circle, and returns the index of the corresponding site in the original circle.
+ let m1_inv i = if i < p1 then i
+ else i-p1+p2 // Note that if i == p1 this will return the index of one side of the edge.
+ /// This function takes the index of a site in the original circle, and returns the index of the corresponding site in the new parent circle. Note that this will return a negative number if the site in the original circle is not actually in the new parent circle (i.e. it's in the child circle).
+ let m1 i = if i < p1 then i
+ else i+p1-p2 // Note that if i == p1 this will return the index of one side of the edge.
+ /// This function takes the index of a site in the child circle, and returns the index of the corresponding site in the original circle. Note that the child circle is formed of the sites originally contained between the edge sites; this is why this function doesn't need to take p2 into account.
+ let m2_inv i = i+p1+1
+ /// This function takes the index of a site in the original circle, and returns the index of the corresponding site in the new child circle. Note that the child circle is formed of the sites originally contained between the edge sites; this is why this function doesn't need to take p2 into account. Note that this will return a negative number if the site in the original circle is not actually in the new child circle (i.e. it's in the parent circle).
+ let m2 i = i-p1-1
+ /// Turns a Domain port into a Xing port. Note: if this gets called on a port that's not a Domain, then something went wrong in the earlier phases (edges can only logically be between Domain ports).
+ let make_xing port = match port with Domain dom -> Xing dom | _ -> failwith ""
+ /// The ports of the new parent circle. In the new parent circle's index, the crossing is at index p1.
+ let ports1 = Array.init n1 (fun i -> let port = c.ports.[m1_inv i]
+ if i = p1 then make_xing port
+ else port)
+ /// The ports of the new child circle. In the new parent circle's index, the crossing is always at the last site (i.e. index n2-1).
+ let ports2 = Array.init n2 (fun i -> let port = c.ports.[m2_inv i]
+ if i = n2-1 then make_xing port
+ else port)
+ /// Takes a port index (in the original circle). Returns true if this port will end up in the new parent circle. If called on one of the edge ports, will always return false.
+ let in_c1 p = p < p1 || p > p2
+ /// Divide any existing children between the two circles, according to which circle the child's port belongs to. Note that this assumes that no children is at p1 or p2 (this should be impossible).
+ let cs1, cs2 = c.children |> List.partition (fun (p,_,_) -> in_c1 p)
+ /// This function takes as input the characteristics of a parent circle (port count and radius); the connection port on the parent side; the characteristics of a child circle. It returns the coordinates and rotation angle of the child circle. This will be used both to place the new child relative to the parent, and to reposition any pre-existing children of both of them.
+ let port_circle (pn, pr) (ports:svg_domain[]) (p:int) (cn, cr) =
+ let side_length = xing_side_length ports.[p]
+ let angle = (float p / float pn) * twopi
+ let d = pr + 0.5 * side_length + cr
+ let center = (d * cos angle, d * sin angle)
+ let angle2X = -twopi / float cn
+ ( center
+ , angle - angle2X + pi )
+
+ /// Radius of the new parent circle.
+ let radius1 = circle_radius ports1
+ /// Radius of the new child circle.
+ let radius2 = circle_radius ports2
+
+ /// Takes a pre-existing child of the parent circle, and the port on which it is connected to the parent. Returns the same child, translated and rotated into a position that matches the new shape of the parent circle.
+ let child1 p ch =
+ let center, angle = port_circle (n1, radius1) ports1 p (ch.ports.Length, ch.radius)
+ { ch with center = center; angle = angle }
+ /// Remap the pre-existing children of the new parent circle, so that they are correctly placed.
+ let children1 = cs1 |> List.map (fun (p,s,ch) -> m1 p, s, child1 (m1 p) ch)
+
+ /// Location (center, angle) of the new child circle.
+ let center2, angle2 = port_circle (n1, radius1) ports1 p1 (n2, radius2)
+
+ /// Takes a pre-existing child of the new child circle, and the port on which it is connected to the parent. Returns the same child, translated and rotated into a position that matches the new shape of its parent circle (which is the new child circle).
+ let child2 p ch =
+ let center, angle = port_circle (n2, radius2) ports2 p (ch.ports.Length, ch.radius)
+ { ch with center = center; angle = angle }
+ /// Remap the pre-existing children of the new child circle, so that they are correctly placed.
+ let children2 = cs2 |> List.map (fun (p,s,ch) -> m2 p, s, child2 (m2 p) ch)
+
+ /// Divide the edges of the original circle between the two new circles. Note that this looks at the first site alone because we assume no crossings; if there are crossings, the algorithm will produce wrong results. Also, the edge currently being handled will end up in the child circle at this stage (but we'll remove it soon).
+ let es1, es2 = c.edges |> Array.partition (fst >> in_c1)
+ /// Map the site indexes of the edges that end up in the parent circle, so that they are in the space of its sites.
+ let edges1 = es1 |> Array.map (fun (i,j) -> m1 i, m1 j)
+ /// Map the site indexes of the edges that end up in the child circle, so that they are in the space of its sites. Also, remove the edge currently being handled.
+ let edges2 = es2 |> Array.filter (fun e -> sort_e e <> (p1,p2))
+ |> Array.map (fun (i,j) -> m2 i, m2 j)
+
+ /// The new child circle.
+ let circle2 =
+ { center = center2
+ ; angle = angle2
+ ; radius = radius2
+ ; ports = ports2
+ ; children = children2
+ ; edges = edges2 }
+
+ // The parent circle is different from the old circle, because sites have been removed from it. Therefore, its own position and angle relative to its own parent need to get changed.
+
+ let angleX = -twopi / float n
+ let angle1X = -twopi / float n1
+ let angle1 = c.angle + angleX - angle1X
+
+ let Xx, Xy = c.radius * cos (c.angle + angleX), c.radius * sin (c.angle + angleX)
+ let X1x, X1y = radius1 * cos (angle1 + angle1X), radius1 * sin (angle1 + angle1X)
+ let center1 = fst c.center + Xx - X1x, snd c.center + Xy - X1y
+
+ { center = center1
+ ; angle = angle1
+ ; radius = radius1
+ ; ports = ports1
+ ; children = (p1, c.ports.[p1], circle2)::children1
+ ; edges = edges1
+ }
+
+/// Collapse all edges in the given circle; each collapse will cause the circle to be split, generating a child circle, joined by a crossing.
+let rec collapse_circle (c:circle) =
+ if c.edges.Length = 0 then
+ // If this circle has no edges, then recursively collapse all children.
+ let children = c.children |> List.map (fun (i, s, ch) -> (i, s, collapse_circle ch))
+ { c with children = children }
+ else
+ // If this circle has edges, collapse the first and then recurse on the resulting circle.
+ c |> circle_split c.edges.[0] |> collapse_circle
+
+/// Padding around a rendering.
+let pad = 12.0
+
+/// Translates the circle so that the entire figure is in the first quadrant. Also returns the width and height of the figure.
+let into_view (c:circle) =
+ /// Returns an enumeration of the corners of the circle and its children (in this context, by corner of a circle, we mean a corner of a box that contains the circle). Returned corners are in the top-level space; in order to do this, I provide the function with the angular and location delta of the current child.
+ let rec corners da (dx, dy) (c:circle) =
+ let rotate (x,y) =
+ ( x * cos da - y * sin da
+ , x * sin da + y * cos da )
+ let translate (x,y) = (x + dx, y + dy)
+ let transform = rotate >> translate
+ seq {
+ // Transform the center and return its corners.
+ let x, y = c.center |> transform
+ yield (x + c.radius * 2.0, y + c.radius * 2.0)
+ yield (x - c.radius * 2.0, y - c.radius * 2.0)
+ // Recurse on the children, passing along the parent's delta angle and position.
+ yield! c.children |> Seq.collect (fun (i,_,ch) -> corners (c.angle+da) (x, y) ch)
+ }
+ // Start the enumeration on the topmost circle, which has angle 0 and is centered on the origin.
+ let corners = corners 0.0 (0.0, 0.0) c
+ // Determine the corners of the box that contains all corners (this could be done more efficiently, but it's very unlikely to be a long enumeration anyway).
+ let min_x = corners |> Seq.map fst |> Seq.min
+ let max_x = corners |> Seq.map fst |> Seq.max
+ let min_y = corners |> Seq.map snd |> Seq.min
+ let max_y = corners |> Seq.map snd |> Seq.max
+ // Determine the width and height of the box.
+ let width = max_x - min_x
+ let height = max_y - min_y
+ // Translate the center of the topmost circle so that the entire figure is in positive coordinates. Add some padding, too.
+ let cx, cy = c.center
+ ( { c with center = (cx - min_x + pad, cy - min_y + pad) }
+ , width + 2.0*pad
+ , height + 2.0*pad )
+
+/// Size of an empty overhang, in site units (e.g. 0.2 means it's 20% the length of a regular domain).
+let overhang_to_hole = 0.2
+
+/// Generates the SVG string for the given circle. The supplied style, scale, width and height are not used, but they are integrated in the resulting string.
+let circle_to_svg style scale (c:circle, width, height) =
+ /// Generates the SVG class for the given domain (so that it can be styled), for a text element.
+ let dom_class (dom:svg_domain) = match dom with Hole -> "" | Domain dom | Xing dom -> if dom.isToehold then sprintf "svgdsd dom_%s" dom.name else ""
+ /// Converts a circle to SVG; note that this will be recursed over the circle's children. Parameters include the delta angle and position from the parent; these need to be applied to the circle's SVG elements.
+ let rec convert da (dx,dy) (c:circle) =
+ // Each site will get an equal portion of the circle.
+ let n = c.ports.Length
+ /// This is the size in radians of the arc for a site.
+ let a = twopi / (float n)
+ /// Rotates a point by the delta angle.
+ let rotate (x,y) =
+ ( x * cos da - y * sin da
+ , x * sin da + y * cos da )
+ /// Translates a point by the delta position.
+ let translate (x,y) = (x + dx, y + dy)
+ /// Transforms a point by the delta angle and position; this brings it into the correct reference for rendering.
+ let transform = rotate >> translate
+ /// Transforms a site index into a position on the circle. Note that the size index may be fractional in this context (so we can get positions between sites).
+ let pos i =
+ let x, y = c.center
+ let v = a * i + c.angle
+ ( x + c.radius*cos v
+ , y + c.radius*sin v) |> transform
+ /// Makes an arc between two positions on the circle, specified as site indexes (e.g. 0.5 indicates a point on the circle between the center of the first two sites). The domain passed as a parameter determines the CSS class of the arc.
+ let rim v1 v2 b =
+ let x1, y1 = v1 |> pos
+ let x2, y2 = v2 |> pos
+ let v = a * 0.5*(v1+v2) + c.angle + da
+ let r = v * 360.0 / twopi
+ sprintf "" (dom_class b) x1 y1 c.radius c.radius r x2 y2
+ /// Draws the arc for a normal domain. It covers 0.5 site units to either side of the domain site.
+ let arc i b = rim (float i - 0.5) (float i + 0.5) b
+ /// Draws the label for a normal domain.
+ let label i b =
+ // Determine the position of the site on the circle.
+ let x, y = i |> float |> pos
+ // Determine the angular position of the site, in radians.
+ let v = a * float i + c.angle + da
+ // Determine the rotation of the text, in degrees (for SVG).
+ let r = 90.0 + v * 360.0 / twopi
+ // Output the text element. It is at the same position as the center of the site, except it's rotated by 90°.
+ sprintf "%s" (dom_class b) x y r x y b.text
+ /// Experimental: in a "degenerate" circle (one where all domains are either crossings or holes), hole terminators will get drawn along the crossing axis, rather than along the circle.
+ let degenerate = not (circle_has_overhangs c.ports)
+ let port_width = 4.0
+ /// Generates the SVG string for a port.
+ let port i prev b next =
+ // The port can be a domain, a hole, or a crossing.
+ match b with
+ | Hole ->
+ // Figure out where the neighboring overhangs start. If they were Xing type domains, then this hole needs to be wider. This can happen on either or both sides, or none.
+ let overhang_dist_prev = match prev with Xing _ -> (1.0 - overhang_to_hole) | _ -> 0.5
+ let overhang_dist_next = match next with Xing _ -> (1.0 - overhang_to_hole) | _ -> 0.5
+ // This is a hole. It gets rendered as a perpendicular dash at the start of the next port, plus an arrow at the end of the previous port.
+ let l = 3.0
+ // Draw the arrow. Note that this needs to be styled as the _previous_ domain.
+ // Determine the arrow's vector, expressed in radians. This can be determined as the angular position of the terminator on the circle. In the degenerate case, the angular position of the previous domain is used instead, plus a 90° rotation to make it point towards the center (this way, it points along the crossing's axis).
+ let arrv = if degenerate then
+ a * (float i - 1.0) + c.angle + da + 0.5*pi
+ else
+ a * (float i - overhang_dist_prev) + c.angle + da
+ // Determine the arrow's placement. This is obtained by taking the angular position of the terminator on the circle, and using the 'pos' function to convert it to Cartesian. In the degenerate case, we use the angular position of the previous domain (plus the port width, converted to an angular distance).
+ let arrx, arry = if degenerate then
+ float i - 1.0 + (asin (port_width / c.radius) / a) |> pos
+ else
+ float i - overhang_dist_prev |> pos
+ let arr1x, arr1y = arrx - l * cos arrv, arry - l * sin arrv
+ let arr2x, arr2y = arrx + l * cos arrv, arry + l * sin arrv
+ let arr3x, arr3y = arrx + 3.0 * l * cos (arrv + 0.5*pi), arry + 3.0 * l * sin (arrv + 0.5*pi)
+ let arr = sprintf "" (dom_class prev) arr1x arr1y arr2x arr2y arr3x arr3y
+ // Draw the dash. Note that this needs to be styled as the _next_ domain.
+ // Determine the dash's vector, expressed in radians. This can be determined as the angular position of the terminator on the circle. In the degenerate case, the angular position of the next domain is used instead, plus a 90° rotation to make it point towards the center (this way, it points along the crossing's axis).
+ let ev = if degenerate then
+ a * (float i + 1.0) + c.angle + da - 0.5*pi
+ else
+ a * (float i + overhang_dist_next) + c.angle + da
+ // Determine the dash's placement. This is obtained by taking the angular position of the terminator on the circle, and using the 'pos' function to convert it to Cartesian. In the degenerate case, we use the angular position of the next domain (minus the port width, converted to an angular distance).
+ let ex,ey = if degenerate then
+ float i + 1.0 - (asin (port_width / c.radius) / a) |> pos
+ else
+ float i + overhang_dist_next |> pos
+ let e1x, e1y = ex - l * cos ev, ey - l * sin ev
+ let e2x, e2y = ex + l * cos ev, ey + l * sin ev
+ let e = sprintf "" (dom_class next) e1x e1y e2x e2y
+ // Output the SVG text combining both parts.
+ sprintf "%s\n%s" arr e
+ | Xing d ->
+ // This is a crossing. It gets rendered as two parallel lines directed outwards from the circle, plus two arc segments to connect it to the rest of the circle. Note that, because both circles are going to draw this, there are going to be two overlapping paths for each side in the final SVG.
+ let overhang_size_next = match next with Hole -> overhang_to_hole | _ -> 0.5
+ let overhang_size_prev = match prev with Hole -> overhang_to_hole | _ -> 0.5
+ // Figure out the positions of the attachment points of the straight lines. I'll need them in site index angular units for the arc function, and in Cartesian coordinates for the path statements.
+ let dv = asin (port_width/ c.radius) / a
+ let ax1, ay1 = float i - dv |> pos
+ let ax2, ay2 = float i + dv |> pos
+ let v = a * float i + c.angle + da
+ // I'm extending the line a little bit in order to fake a miter join with the arc. The magic number here depends on the line thickness. A better solution would require rewriting this so that there is only one path declaration per side, instead of two.
+ let side_length = 3.7 + xing_side_length b
+ let bx1, by1 = ax1 + 0.5 * side_length * cos v, ay1 + 0.5 * side_length * sin v
+ let bx2, by2 = ax2 + 0.5 * side_length * cos v, ay2 + 0.5 * side_length * sin v
+ // Output the SVG text. Note that we are not adding the labels here. This is done further down, in the 'child' function.
+ [ rim (float i - overhang_size_prev) (float i - dv) b
+ ; rim (float i + dv) (float i + overhang_size_next) b
+ ; sprintf "" (dom_class b) ax1 ay1 bx1 by1
+ ; sprintf "" (dom_class b) ax2 ay2 bx2 by2 ]
+ |> String.concat "\n"
+ | b ->
+ // This is a domain. It gets rendered as an arc.
+ sprintf "%s\n%s" (arc i b) (label i b)
+ /// Gathers all renderings of sites on the circle as SVG strings. Note that I am retrieving the previous and next port at each step; the changes I made to the renderer need knowledge of neighbors for some types of ports.
+ let port_str = c.ports |> Array.mapi (fun i dom ->
+ let prev = c.ports.[if i = 0 then c.ports.Length-1 else i-1]
+ let next = c.ports.[if i = c.ports.Length-1 then 0 else i+1]
+ port i prev dom next)
+ /// This function draws a straight edge between two sites. I don't know in which cases this is supposed to happen, if any.
+ let edge (i, j) =
+ let x1, y1 = i |> float |> pos
+ let x2, y2 = j |> float |> pos
+ sprintf "" x1 y1 x2 y2
+ /// This would render any remaining circle edges (as straight lines) and gather them in a set of SVG strings, but from what I understand there should never be any circle edges at this stage. I couldn't find any case where this would happen.
+ let edges_str = c.edges |> Array.map edge
+ /// This function renders a child circle recursively. It requires the position (in site index units) of the attachment point, the domain that connects the circles, and the child circle itself. Note that at this stage the child circle is already centered at the correct distance from the origin (i.e. the parent).
+ let child (i, b:svg_domain, ch) =
+ /// The Cartesian coordinates of the attachment point position.
+ let x, y = i |> float |> pos
+ /// The angle of the attachment point position, in radians.
+ let v = a * float i + c.angle + da
+ /// The rotation of the label text, in degrees.
+ let r = v * 360.0 / twopi
+ let dx = xing_side_length b / 4.0
+ // Add the labels for the connecting domain, then add the recursively generated circle (giving it the angular and Cartesian deltas required to transform it back into top-level space).
+ [ sprintf "%s" (dom_class b) x y r x y dx b.text
+ ; sprintf "%s" (dom_class b) x y (r+180.0) x y dx b.compl.text
+ ; convert (c.angle + da) (transform c.center) ch ]
+ |> String.concat "\n"
+ let children_str = c.children |> List.map child |> Array.ofList
+ [| port_str; edges_str; children_str |] |> Array.concat |> String.concat "\n"
+ // Recursively convert the circle, bracket it with an SVG element, add style, scale and size.
+ c |> convert 0.0 (0.0, 0.0) |> sprintf "" (width*scale) (height*scale) style scale
+
+// The following functions are used to convert a strand graph object into the initial circle.
+
+type port = {strand:int;site:int}
+type edge = (port*port)
+
+/// Converts the edges to their representation in a global sequence made by arranging all strands one after the other. In this representation, an edge is an int couple where each int is the index of a site in the global sequence, and the two sites match. Returned edges are reverse-ordered by the position of their lowest-index site (e.g. [(9,12),(5,8),(1,4)]).
+let get_edges (S:StrandC[]) (E:Set) =
+ /// The offsets array. This maps each strand (by index) to its starting position in a sequence of all sites, plus holes between strands (e.g. if S contains three strands, respectively made of 2, 3 and 2 sites, then the offsets array is [0,3,7]).
+ let offsets = Array.init S.Length (fun i -> if i = 0 then 0 else i + (S.[0..i-1] |> Array.map(fun s -> s.Length) |> Array.sum))
+ //S
+ //|> Seq.fold (fun (n,l) st -> (n+1, (n,1+st.Length)::l)) (1,[0,0])
+ //|> snd
+ //|> Map.ofSeq
+ /// Maps a port (i.e. an int*int where the first item is the strand index and the second is the site index within the strand) to a port in the global sequence (i.e. an int).
+ let port_map (a,b) = offsets.[a] + b
+ /// Maps an edge (i.e. a couple of ports) to an edge in the global sequence (i.e. two ints that are the indexes of two matching sites in the global sequence).
+ let edge_map (a,b) = port_map a, port_map b
+
+ E
+ |> Set.toArray
+ |> Array.map(fun (p,p') -> (p.strand, p.site), (p'.strand, p'.site))
+ |> Seq.map edge_map
+ // I now have the edges as represented in the global sequence.
+ |> Seq.map sort_e
+ |> Seq.toArray
+ // I now have the edges in the global sequence, normalized so that the lowest index site is always first.
+ // I will reverse sort them on the first site.
+ |> Array.sortWith (fun (a1,b1) (a2,b2) -> a2-a1) //ensure right-neighbours are taken first
+
+/// Reorders the set of strands (with corresponding edges) according to the order supplied (the input order array must be a permutation of 0..S.Length-1). Returns the reordered set of strands, and the edges as represented in the global sequence.
+let reorderBy (order:int[]) (S:StrandC[]) (E:Set) =
+ /// The order is a map from a strand's index in the old array, to the strand's index in the new array.
+ /// The strands array, reordered according to the specified order.
+ let S' = Array.zeroCreate S.Length
+ Array.iteri (fun i v -> Array.set S' v S.[i]) order
+ //let S' = [|0..S.Length-1|] |> Array.map(fun i -> S.[order.[i]])
+ /// The edges, changed so that they refer to the correct strands in the reordered strands array.
+ let E' =
+ E
+ |> Set.map(fun (p,p') ->
+ {p with site = p.site; strand = order.[p.strand]},
+ {p' with site = p'.site; strand = order.[p'.strand]})
+ S', get_edges S' E'
+
+/// Returns a permutation of the strands array that avoids pseudoknots. Returns the reordered set of strands, and the edges as represented in the global sequence.
+let find_perm (S:StrandC[]) (E:Set) =
+
+ /// Takes an element and a list. Returns the set of all lists generated by inserting that element at each possible position within the list.
+ let distrib e L =
+ let rec aux pre post =
+ seq {
+ match post with
+ | [] -> yield (L @ [e])
+ | h::t -> yield (List.rev pre @ [e] @ post)
+ yield! aux (h::pre) t
+ }
+ aux [] L
+
+ /// Takes a list of objects, returns a set of lists that are all possible permutations of the original list.
+ let rec perms = function
+ | [] -> Seq.singleton []
+ | h::t -> Seq.collect (distrib h) (perms t)
+
+ /// Returns true if the edges would cross. We call this situation a pseudoknot. Pseudoknots cannot be rendered by this algorithm.
+ let pseudoknot (e1,e1') (e2, e2') =
+ (e1>e2 && e1e2'||e1'e2 && e1'e2'||e1 perms
+ |> Seq.map(fun l -> 0::l |> List.toArray)
+ |> Seq.map(fun order -> reorderBy order S E)
+ // Now I have the set of all possible ways to reorder the strands; for each of these orderings, I also have the set of edges, expressed as couples of ints where each int is the index of a site in the sequence formed by arranging the strands one after the other in the specified order. I search this set for an ordering that has no pseudoknots.
+ |> Seq.tryFind(fun (_, E') ->
+ E'|> Seq.forall (fun e ->
+ E' |> Seq.forall(fun e' -> not (pseudoknot e e' || pseudoknot e' e))))
+
+/// Returns the circle made of all the domains in all the strands in the given species. This circle will then require collapsing.
+let make_base_circle (ports:svg_domain[]) (edges:(int*int)[]) =
+ { center = (0.0, 0.0)
+ ; angle = 0.0
+ ; radius = ports |> circle_radius
+ ; ports = ports
+ ; children = []
+ ; edges = edges
+ }
+
+/// Converts a species in an uncollapsed circle representation. Requires the strands and the species (only the strand graph of the species is actually used).
+let from_logic_dsd (l:RulesDSD.Syntax.Process) : circle =
+ let c = Microsoft.Research.DNA.LogicDSD.to_concrete_process l
+
+ /// Most of the algorithms here operate on the assumption that bonds are represented as edges, which are couples of ports (where a port is a position in a strand). In a ProcessC object, there isn't the notion of a port; rather, each site can have a bond ID associated to it. This function converts from the bond ID representation to the edges representation.
+ let map_strand_bonds_to_edges (existing:Map) (strand_idx:int,strand:StrandC) =
+ let map_site_bond_to_edge (existing:Map) (site_idx:int,site:SiteC) =
+ match site with
+ | UnboundC _ -> existing
+ | BoundC (_,b:int) ->
+ match Map.tryFind b existing with
+ | None ->
+ Map.add b ({strand=strand_idx;site=site_idx},{strand=0;site=0}) existing
+ | Some (from,_) ->
+ Map.add b (from,{strand=strand_idx;site=site_idx}) existing
+ List.mapi (fun i site -> i,site) strand |> List.fold map_site_bond_to_edge existing
+ let bonds_as_edges = List.mapi (fun i strand -> i,strand) c |> List.fold map_strand_bonds_to_edges Map.empty
+
+ /// The strands and edges, rearranged so that there are no pseudoknots (if possible). The edges will be remapped so that their sites are indexes in the global sequence (all the strands one after the other, with holes between strands).
+ let S, E =
+ let SS = c |> List.toArray
+ let EE = bonds_as_edges |> Map.toSeq |> Seq.map (fun (_,v) -> v) |> Set.ofSeq
+ match find_perm SS EE with
+ | Some (a,b) -> a,b
+ | None -> failwith "Cannot visualize pseudoknot"
+
+ /// The global sequence. This is a sequence of sites (in the form of svg_domain objects) which corresponds to all the strands aligned one after the other, in the order determined above. A 'hole' domain is inserted after each strand, making the total length of the sequence equal to the sum of all domains, plus number of strands.
+ let ports =
+ S
+ |> Array.fold (fun acc st ->
+ let d =
+ st
+ |> List.map (fun s -> match s with | BoundC (d,_) -> d | UnboundC d -> d)
+ |> List.map (fun d -> Domain d)
+ |> List.rev
+ Hole::d@acc) List.empty
+ |> List.rev
+ |> List.toArray
+
+ make_base_circle ports E
+
+let from_domains (doms:Domain.t list) =
+ let map_domain (dom:Domain.t) =
+ { name = Domain.get_name (Domain.unstar dom)
+ isComplementary = Domain.is_complemented dom
+ isToehold = Domain.is_toehold dom
+ tag = NoTagC }
+ |> Domain
+ List.map map_domain doms
+
+let from_strand (strand:Strand.t) =
+ let domains = match strand with
+ | Strand.Upper s -> from_domains s
+ | Strand.Lower s -> from_domains s |> List.rev
+ let domains = Hole::domains
+ make_base_circle (Array.ofList domains) [||]
+
+/// Converts a Classic DSD segment in a circle.
+let from_segment (segment:Segment.t) =
+ match segment with
+ | Segment.Double (lb,lt,s,rt,rb) ->
+ let top = from_domains (lt @ s @ rt)
+ let bottom = from_domains (lb @ (List.map (fun d -> Domain.complement d) s) @ rb) |> List.rev
+ let domains = Hole::top@Hole::bottom
+ let edges = [1..s.Length] |> List.map (fun i -> (i+lt.Length,domains.Length-i-lb.Length))
+ make_base_circle (Array.ofList domains) (Array.ofList edges)
+ | Segment.Hairpin (ob,ot,s,hp,side) ->
+ match side with
+ | Segment.Left ->
+ let domains = from_domains ((List.rev ob) @ (List.map (fun d -> Domain.complement d) s |> List.rev) @ (List.rev hp) @ s @ ot)
+ let domains = Hole::domains
+ let edges = [1..s.Length] |> List.map (fun i -> (i+ob.Length,domains.Length-i-ot.Length))
+ make_base_circle (Array.ofList domains) (Array.ofList edges)
+ | Segment.Right ->
+ let domains = from_domains (ot @ s @ (List.rev hp) @ (List.map (fun d -> Domain.complement d) s |> List.rev) @ (List.rev ob))
+ let domains = Hole::domains
+ let edges = [1..s.Length] |> List.map (fun i -> (i+ot.Length,domains.Length-i-ob.Length))
+ make_base_circle (Array.ofList domains) (Array.ofList edges)
+
+let from_gate (gate:Gate.t) =
+ let lower_join_circles (circles:circle list) : circle =
+ /// Bottom-fuses two circles. The last strand of each circle is bottom, and edges are in the form (top,bottom).
+ let fuse (left:circle) (right:circle) : circle =
+ let left_fuse_point = Array.findIndexBack (fun (d:svg_domain) -> d = svg_domain.Hole) left.ports
+ let (left_top, left_bottom) = List.splitAt left_fuse_point (left.ports |> List.ofArray)
+ let right_fuse_point = Array.findIndexBack (fun (d:svg_domain) -> d = svg_domain.Hole) right.ports
+ let (right_top, right_bottom) = List.splitAt right_fuse_point (right.ports |> List.ofArray)
+ let bottom = right_bottom@(left_bottom.Tail)
+ let domains = left_top @ right_top @ bottom
+ // The indexes within edges in the left circle are shifted if they are after the fuse point.
+ let left_edges =
+ let shift = right_top.Length+right_bottom.Length-1
+ left.edges |> Array.map (fun (top,bottom) -> (if top < left_fuse_point then top else top+shift),(if bottom < left_fuse_point then bottom else bottom+shift))
+ // The right circle always remains contiguous, so edges from the right circle are always shifted.
+ let right_edges =
+ let shift = left_top.Length
+ right.edges |> Array.map (fun (top,bottom) -> (top+shift,bottom+shift))
+ let edges = Array.concat [left_edges;right_edges]
+ make_base_circle (Array.ofList domains) edges
+ List.fold fuse circles.Head circles.Tail
+ let upper_join_circles (circles:circle list) : circle =
+ /// Top-fuses two circles. The last strand of each circle is bottom.
+ let fuse (left:circle) (right:circle) : circle =
+ let left_fuse_point = Array.findIndexBack (fun (d:svg_domain) -> d = svg_domain.Hole) left.ports
+ let (left_top, left_bottom) = List.splitAt left_fuse_point (left.ports |> List.ofArray)
+ let right_all = List.ofArray right.ports
+ let domains = left_bottom @ left_top @ (right_all.Tail)
+ // The indexes within edges in the left circle are shifted forward if they are before the fuse point, and shifted backwards if they are after the fuse point.
+ let left_edges = left.edges |> Array.map (fun (top,bottom) -> (if top < left_fuse_point then (top+left_bottom.Length) else (top-left_top.Length)),(if bottom < left_fuse_point then (bottom+left_bottom.Length) else (bottom-left_top.Length)))
+ // The right circle always remains continguous, so edges from the right circle are always shifted.
+ let right_edges =
+ let shift = left.ports.Length-1
+ right.edges |> Array.map (fun (top,bottom) -> (top+shift,bottom+shift))
+ let edges = Array.concat [left_edges;right_edges]
+ make_base_circle (Array.ofList domains) edges
+ List.fold fuse circles.Head circles.Tail
+ List.map (fun segments -> segments |> List.map from_segment |> lower_join_circles) gate |> upper_join_circles
+
+let arrange_origami style (origami:Origami.t) =
+ let origami_sep = { Microsoft.Research.CRNEngine.Svg.x = 16.0; Microsoft.Research.CRNEngine.Svg.y = 16.0 }
+ let species_skip = 10.0
+ let letter_width = 8.0
+ let origami_round = 32.0
+ let parts = origami |> List.map (fun el -> match el with Origami.C_strand s -> from_strand s | Origami.C_gate g -> from_gate g) |> List.map collapse_circle |> List.map into_view
+ let to_box (circle,width,height) : Microsoft.Research.CRNEngine.Svg.box =
+ { box_group = { name = ""
+ ; content = circle_to_svg "" 1.0 (circle,width,height) |> Microsoft.Research.CRNEngine.Svg.Raw
+ ; anchors = []
+ ; debug_anchors = false
+ ; sub_groups = []
+ ; offset = None
+ }
+ ; box_dim = { x = width; y = height } }
+ let b = parts |> List.map to_box |> Microsoft.Research.CRNEngine.Svg.stackv origami_sep species_skip
+ let border_label = "" in
+ let border_inset = (String.length border_label |> float) * letter_width / 2.0 in
+ let border_offset = { Microsoft.Research.CRNEngine.Svg.x = 2.0; Microsoft.Research.CRNEngine.Svg.y = 2.0 } in
+ let border_dim = b.box_dim |> Microsoft.Research.CRNEngine.Svg.translate_point_by (border_offset |> Microsoft.Research.CRNEngine.Svg.scale_by -1.0) in
+ let border = { Microsoft.Research.CRNEngine.Svg.path_class = "svgdsd origami-border" |> Some
+ ; Microsoft.Research.CRNEngine.Svg.commands = Microsoft.Research.CRNEngine.Svg.rounded_box border_offset border_dim origami_round
+ ; Microsoft.Research.CRNEngine.Svg.path_label = { Microsoft.Research.CRNEngine.Svg.label_text = border_label
+ ; Microsoft.Research.CRNEngine.Svg.label_anchor = Microsoft.Research.CRNEngine.Svg.sub b.box_dim origami_sep |> Microsoft.Research.CRNEngine.Svg.translate_point_by { x = -border_inset; y = 0.0 }
+ ; Microsoft.Research.CRNEngine.Svg.label_class = Some "svgdsd"
+ ; Microsoft.Research.CRNEngine.Svg.letter_width = Microsoft.Research.CRNEngine.Svg.default_letter_width
+ ; Microsoft.Research.CRNEngine.Svg.label_dir = Microsoft.Research.CRNEngine.Svg.sub b.box_dim origami_sep |> Microsoft.Research.CRNEngine.Svg.translate_point_by { x = -border_inset; y = 0.0 } }
+ |> Some }
+ let g = {b.box_group with content = Paths [border]}
+ let box = Microsoft.Research.CRNEngine.Svg.emerge_groups [g]
+ Microsoft.Research.CRNEngine.Svg.to_string_normalise false style box
+
+let species_to_svg_circles style (proc:Species.t) =
+ match proc with
+ | UNKNOWN unknown ->
+ let g = { Microsoft.Research.CRNEngine.Svg.name = unknown
+ Microsoft.Research.CRNEngine.Svg.content = Microsoft.Research.CRNEngine.Svg.Raw unknown
+ Microsoft.Research.CRNEngine.Svg.anchors = []
+ Microsoft.Research.CRNEngine.Svg.debug_anchors = false
+ Microsoft.Research.CRNEngine.Svg.sub_groups = []
+ Microsoft.Research.CRNEngine.Svg.offset = None }
+ let box = Microsoft.Research.CRNEngine.Svg.emerge_groups [g]
+ Microsoft.Research.CRNEngine.Svg.to_string_normalise true style box
+ | STRAND strand ->
+ from_strand strand |> collapse_circle |> into_view |> circle_to_svg style 1.0
+ | GATE gate ->
+ from_gate gate |> collapse_circle |> into_view |> circle_to_svg style 1.0
+ | ORIGAMI origami ->
+ arrange_origami style origami
+ | LogicDsdProcess proc ->
+ from_logic_dsd proc |> collapse_circle |> into_view |> circle_to_svg style 1.0
diff --git a/ClassicDSD/ClassicDSDDotNet/circlesrenderer.fsi b/ClassicDSD/ClassicDSDDotNet/circlesrenderer.fsi
new file mode 100644
index 0000000..903bbe7
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/circlesrenderer.fsi
@@ -0,0 +1,3 @@
+module Microsoft.Research.DNA.CirclesRenderer
+
+val species_to_svg_circles : string -> Species.t -> string
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/defaultDatabase.fs b/ClassicDSD/ClassicDSDDotNet/defaultDatabase.fs
new file mode 100644
index 0000000..f38168e
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/defaultDatabase.fs
@@ -0,0 +1,3006 @@
+[]
+module Microsoft.Research.DNA.DefaultDatabase
+
+let toeholds = "TATTCC
+GCTA
+GTCA
+TACCAA
+CATCG
+ACTACAC
+CTCAG
+CTCAATC
+CCTACG
+TCTCCA
+CCCT
+GACA
+ACCT
+TAGCCA
+CACACA
+AGAC"
+let specificities = "CCCAAAACAAAACAAAACAA
+CCCTTTTCTAAACTAAACAA
+CCCTTTACATTACATAACAA
+CCCTTATCATATCAATACAA
+CCCTTAACTTAACAAATCTA
+CCCTATTCAATTCAAATCAA
+CCCTATACTATACAATACTA
+CCCTAATCTAATCATAACTA
+CCCTAAACTTATCTAAACAT
+CCCATTTCAAATCAAAACTT
+CCCATTACTAATCAATTCAA
+CCCATATCTATACATTACAA
+CCCATAACTATTCTAAACTA
+CCCAATTCTTAACATATCAA
+CCCAATACTATTCATAACAT
+CCCAAATCTTAACTATACTA
+CCTATACCTTAACTTAACAA
+CCATATCCATAACTTTACAA
+CCATAACCTATACTTATCAA
+CCATTTCCTTTTCTTAACTA
+CCATTACCATATCTTATCAT
+CCAAAACCATAACATAACTT
+CCAATTCCAAAACTTATCTA
+CCAATACCATTACTATTCAA
+CCTTAACCTTTACTTTACTT
+CCTTTTCCTAATCTTTACAT
+CCTTTACCAAAACATTTCAA
+CCTAATCCTTATCATTACTA
+CCTATTCCTTTACAAATCAT
+CCAAAACAAAACCTATACAA
+CCTTTACATAACCTAATCAA
+CCTTATCTAAACCAATACAT
+CCTTATCAATACCTATTCTA
+CCTTAACAAATCCAAAACTA
+CCTATTCAAATCCTTTTCAA
+CCTATACAATACCATTACAT
+CCTAAACTTATCCTATTCAT
+CCTAAACATTACCTAAACTT
+CCATTACTTAACCTTTACTA
+CCATAACAATTCCAATTCAT
+CCAATTCATAACCAAAACAT
+CCAATACTAATCCAATACTT
+CCAAATCTTAACCAATTCTA
+CCAAATCAATTCCTTAACAT
+CCATATCAAAACAAAACCAA
+CCTATACTAAACTAAACCAA
+CCTAATCTTTACATAACCAA
+CCTAATCATATCTATACCAA
+CCTTTTCTTATCAAATCCAA
+CCTTTTCATTACAATACCTA
+CCTTAACTATTCAATACCAA
+CCAATACAAATCATAACCTA
+CCAATTCTATACAATTCCAA
+CCAAAACTAAACATTACCAT
+CCATTACATTACTAATCCAA
+CCATTTCTATTCTTAACCAA
+CCATATCTTATCTAAACCTT
+CCTTTACTTTACAAAACAAC
+CCATAACTATACTTATCAAC
+CCATTTCAATTCAAATCAAC
+CCTATTCTAATCAATACAAC
+CTTAACCCAAATCTAATCTA
+CAATACCCATATCATATCTA
+CAAATCCCAATTCTATTCTT
+CATTACCCTATTCTTTTCTA
+CATAACCCTAAACAATTCTT
+CTTTTCCCAATACTAATCAT
+CTTATCCCATTTCATTTCTA
+CTTTACCTATACCAAATCTT
+CTTATCCTAAACCTTAACTT
+CTTAACCATATCCATTACTT
+CTAATCCATTACCATATCTT
+CATAACCTATTCCTATACTT
+CAATACCTAATCCTTATCTT
+CTATACCAAATCTTTACCAA
+CATAACCAATACTTTTCCAA
+CATTTCCAAAACTTAACCTA
+CAAATCCATATCATTTCCAA
+CAATTCCTAATCTATTCCTA
+CAATACCATTTCTTATCCTA
+CTTAACCTTATCATTACCTA
+CTTTTCCAATTCATATCCAA
+CTTTACCATAACTTATCCAT
+CTAAACCTTAACTATTCCAA
+CAAATCCTTTTCTAAACAAC
+CTTTTCCTATTCTATTCAAC
+CTTATCCATTTCATTACAAC
+CTATACCTTTACTATACATC
+CTATTCCTTATCTTATCTAC
+CTAAACCAATTCTAATCTAC
+CATATCCTATACATATCAAC
+CAATTCCATAACATAACAAC
+CTTTACAATACCCTAATCTT
+CTTAACATAACCCATATCAT
+CTATACAAATCCCATTTCTT
+CATAACTAAACCCTTTTCTT
+CAAAACAAAACCAAATCCTA
+CTTTTCAATACCTAATCCTA
+CTTTACTTAACCATATCCTA
+CTTATCTAATCCAATTCCTA
+CTATTCATATCCAAAACCTA
+CTAATCATAACCATTTCCTT
+CTAAACAATTCCTATACCTA
+CATATCAAAACCTTAACAAC
+CTATTCTTAACCTTTACAAC
+CTATTCAAATCCTTATCATC
+CTAATCTAAACCATAACTTC
+CTTAACTATACCTATACAAC
+CTTATCTTATCCTAAACTAC
+CTTATCATTACCAAAACATC
+CAAAACTAATCCTTTACTAC
+CAAAACATTACCTTTTCAAC
+CAAATCAATTCCATATCTAC
+CATTTCTATTCCTAATCAAC
+CATATCTTTACCATTACTAC
+CATTTCAAAACAAAACCCAA
+CTAATCTTAACATAACCCAA
+CTAATCAATACTATACCCAA
+CTATACTATACAAATCCCAA
+CTATACATAACAATACCCAT
+CTATTCTAAACTAAACCCTT
+CTTAACAAATCATTACCCAA
+CTTTTCTTATCAATTCCCAA
+CTTTTCATTACTAATCCCAT
+CAATACATATCATATCCCAA
+CAATTCATAACTTTACCCTA
+CAATTCAATTCTTAACCCAT
+CATATCTATACATTTCCCAA
+CATTACTAAACTTATCCCTA
+CAAAACTTTTCAAAACCAAC
+CTTTACATTTCTATACCAAC
+CTTAACTTATCTAATCCATC
+CTATACTTATCATAACCTTC
+CTAAACTATTCTTTACCATC
+CATTTCTTTTCTAAACCTTC
+CATTACAATTCAAATCCTAC
+CATTACTTTACATTACCTAC
+CATATCATTTCTTATCCAAC
+CAATTCTTTACAATTCCATC
+CATTACATTACAAAACAACC
+CTAAACTTTACTAAACATCC
+CTAAACATTTCATATCAACC
+CTTTTCTATACTTAACAACC
+CTTTACTAATCAATACAACC
+CAATACAAAACTTAACTACC
+CATAACTTAACTATACTACC
+CATAACAATACTTTTCAACC
+CATAACATATCTTAACATCC
+ATTTCCCATATCTTTTCCTA
+TTATCCCATTACTTTACCTT
+AAATCCCTAAACAATTCAAC
+TTTACCCAAAACATTTCAAC
+TTTTCCCTTAACAAATCTAC
+TATACCCTATACTATTCTAC
+TATTCCCAATACAAATCATC
+TAAACCCAAATCAATTCTTC
+ATAACCCTATTCATTTCTAC
+AATTCCATTTCCTTTTCTAC
+TTATCCTTTTCCATTTCTTC
+TTATCCATATCCTTAACTAC
+TTTTCCATAACCTATTCTTC
+TATACCTTTACCTTATCTTC
+ATATCCAATACCAATTCTAC
+AATTCCTATTCCAATACTTC
+AAAACCAAATCTTTTCCCTA
+TTTTCCAATTCTATTCCCTA
+TTATCCTATACTATTCCAAC
+AATTCCTTAACTTTTCCAAC
+ATAACCTATTCATTTCCTAC
+TAATCCTAAACATATCCTAC
+TTAACCAAAACATTACAACC
+AATACCATAACATTTCATCC
+AATACCAATTCATTACTACC
+AAAACCTAATCTTTACATCC
+ATAACCTTAACAAATCAACC
+ATAACCATTACTTTACTTCC
+TAAACCATATCTATTCAACC
+TTTACCAATACATATCTTCC
+TTATCCAAATCAAATCTACC
+AAAACAAATCCCTATACTAC
+TTTACTAATCCCAAAACTAC
+TTAACATATCCCAATACATC
+TTAACAATTCCCTAATCTTC
+TATACAAAACCCTAAACATC
+AAATCATAACCCTATTCATC
+AAAACTATTCCCATTACATC
+AAAACTAAACCCAAATCTTC
+ATTTCAAAACCTTAACCAAC
+TAATCTAAACCATTACCAAC
+TAATCAATACCTAAACCATC
+TATTCAAATCCTATACCTAC
+TTTACATAACCTTTACCTTC
+TTTACAATACCAAATCCAAC
+TTTTCTTTACCATAACCATC
+TTTTCTAATCCTTATCCTTC
+AATTCTTAACCAAAACCTAC
+AATTCAATTCCATATCCATC
+ATTTCTATACCTATTCCTAC
+ATTTCATATCCAATACCATC
+AAAACTTAACCTTATCTACC
+TTTACTTTTCCTTTTCTACC
+TTATCTTATCCTAAACTACC
+TTAACATTACCTAATCTTCC
+AATACATTTCCTTAACTTCC
+AAATCATTACCAATTCTACC
+AAATCAAAACAAAACCCAAC
+TTTTCATAACATATCCCAAC
+TTAACTAATCAATACCCAAC
+TTAACAAAACTTAACCCTAC
+TTATCTATACAAATCCCATC
+TATACTAAACATAACCCATC
+TATTCAATACTATACCCTAC
+TAAACATAACAATTCCCTAC
+TAATCATATCTAAACCCTTC
+ATAACAATACATTTCCCAAC
+ATATCTTAACATTACCCATC
+ATATCTAATCTAATCCCTAC
+ATTACAATTCAAAACCAACC
+TAAACTTTTCAAATCCAACC
+TATTCTATTCATTACCAACC
+TATACATATCATAACCATCC
+TATACATTACTAAACCTACC
+TTATCAATTCTATTCCAACC
+TTTACTATACTAATCCATCC
+TTTACAAATCTTTACCTACC
+AATTCATTTCAATTCCATCC
+AATACTATTCTTATCCTACC
+ATAACTTTACAATACCATCC
+TTTTCATTACAAAACAACCC
+AAATCTTTACATATCAACCC
+AATTCTAAACAATACAACCC
+AATTCTTTTCTAAACTACCC
+ATAACATTTCATAACATCCC
+ATTACTTAACAAATCTACCC
+TAATCATTTCTATACATCCC
+TATTCTTATCAAATCATCCC
+TTATCAAATCAAAACTTCCC
+CATTACCTTTTCAAAACACA
+CAAAACCATTACATTACACA
+CAATACTATTCAATACCTCA
+CAAATCATATCAAAACACCA
+CTTATCAAATCTATACACCT
+CATTTCATTTCAATTCACCT
+CAATTCTAATCATTTCACCA
+CAAATCTATTCTAATCTCCA
+CAATACTTTTCTTTTCACAC
+AAAACCCTAATCATATCACA
+ATTACCTTATCCATAACACA
+TTTACCTTTTCATAACACCA
+ATATCCTTATCTTATCACCA
+ATTTCCATTACATAACTCCT
+TATTCCTTTACTTATCTCCA
+AAATCCAAAACTATTCACAC
+AATACTTTACCCAATTCACA
+TTAACTATACCCATTTCACT
+TAAACTTATCCATTTCCACA
+ATATCTTTTCCAATTCCTCA
+AAATCTATTCCATTACACCA
+TTTACTTATCTTTTCCCTCA
+CCTTATCCATTACAAACAAA
+CCAAATCCTATTCAATCAAA
+CCTAAACCTTTTCATACTAA
+CTAATCCCTTATCTTACAAA
+CATTACCAAAACCATACAAA
+CATTTCCTTTACCTTACTAA
+CAAAACCTAAACTTACCAAA
+CAAATCTTTTCCCATTCAAA
+AAAACCCATTTCCTAACAAA
+TTTACCCTTTTCCAAACTAA
+TAATCCCTTATCCAAACATA
+ATATCCTAATCCCTTTCAAA
+ATTACCTATACCCTTACATA
+TTTACCTAAACCTAACCAAA
+TTATCCCTTTACACAAAACA
+TATACCATTTCACCAAAACA
+CTATTCCCAAACAATACTAA
+CATATCCCTAACTATACTTA
+CAATTCCCTATCAAAACTTT
+CTATACCCTTTCATAACTAA
+CTATTCCAATCTAAACAAAC
+CATATCCAAACTAATCTAAC
+TAAACCCTTACAATACTAAC
+TATTCCCTAACAATTCAATC
+TAAACCAATCCCATATCATA
+AAAACCTTTCCTAATCCTAA
+TTAACCATACCTTTTCCTAA
+AAATCCTATCCATAACAAAC
+TTTTCCTTTCCAAAACATAC
+TTTTCCTAACCATTTCAAAC
+AAATCCATACTTTACCCAAA
+TATACCAAACTATTCCCAAA
+TAAACCTTACTTATCCCATA
+TAATCCTTTCTTAACCAAAC
+AATTCCAATCATATCCAAAC
+TATACCTATCTATACCAATC
+TAATCCATTCATTTCCTTAC
+TTAACCTAACTAAACAAACC
+ATTTCCTTACTATTCAAACC
+ATTTCCTATCTTAACATACC
+TAAACCTATCATTACATACC
+TAAACAATCCCTTTACAAAC
+ATTACTTTCCCTATACAAAC
+ATTACAAACCCTTTTCATAC
+ATATCATTCCCTTATCAAAC
+ATAACTATCCCATAACTAAC
+AAAACATACCCAATACATAC
+TAATCTATCCCTAATCATAC
+TAAACTAACCCTATTCTATC
+TAAACATTCCCATATCTATC
+TTTTCTTACCTTTACCAAAC
+AAATCTAACCTTTTCCTAAC
+AATACATACCATTACCTAAC
+ATATCATACCTATACCTTAC
+ATTTCAATCCTTAACCTAAC
+TATTCTTTCCTATTCCTATC
+TTAACTTACCATTTCCATTC
+TTTTCAAACCTTATCCATTC
+ATTACTATCCTTTACAAACC
+TATACAATCCATTTCATACC
+TTAACTTTCCTTATCATACC
+TTTTCTATCCAATACATTCC
+TTTACATTCCTATACTATCC
+AATACTAACCTAAACATTCC
+ATTTCTAACCATAACTATCC
+TAAACAAACAAAACCCAAAC
+ATTACTAACTAATCCCAAAC
+ATTACATACATAACCCTAAC
+ATATCAATCAATACCCATAC
+ATATCAAACTAAACCCTATC
+ATAACTAACATTACCCAATC
+AATTCAAACATATCCCATAC
+AAAACTTTCAAATCCCTAAC
+TATTCATACAATTCCCAATC
+TAAACTATCTTAACCCTTAC
+AATTCTATCAAAACCAAACC
+TTATCTTTCTAATCCAAACC
+TTATCTAACAATACCATACC
+TAATCTTTCATTACCTAACC
+TATACTTACAAATCCAATCC
+TATACTATCTATACCTATCC
+TATTCATTCTAAACCTTACC
+TATTCTAACTTATCCTAACC
+ATTTCATTCAATTCCATACC
+ATTTCTTTCTTTACCAATCC
+ATAACATACAAAACAAACCC
+TAATCTTACTAAACATACCC
+TAATCAAACAATTCAAACCC
+AATACAAACTTAACTAACCC
+AAATCAATCTAAACAATCCC
+ATAACAAACTATTCTTACCC
+TAATCCAATCCTTTACTACA
+ATTTCCAAACCTATACTTCA
+ATTACCATACATAACAACCA
+AAAACCATTCTAATCAACCA
+AATACCTAACATTTCAACCT
+TATTCCATACAATTCTACAC
+AAATCCTTACATTACTTCAC
+TTTACCATTCAATACTTCTC
+ATATCTATCTTTTCCCAACA
+TATACTTTCATAACCTTCCA
+CAAAACCCTTACAAACAAAA
+CTTTACCCAAACTAACAAAA
+CTAAACCCAATCATTCAAAA
+CATTTCCCATTCAATCAAAA
+CTAATCCTATCCTATCAAAA
+AATACCCATACCTTACAAAA
+TTAACCCAATCCATACAAAA
+TAATCCCAAACCTTTCTAAA
+ATTACCCTAACCAAACATAA
+AATTCCCTTTCCAAACTAAA
+AATTCCCATTCCATTCATAT
+ATTACCCATTCAAACCAAAA
+TTAACCCTTTCTTACCATAA
+AAATCCCATACTAACCATAA
+ATATCCCTATCATTCCAAAA
+ATATCCCAATCTTACTTAAC
+AATACCTTACCCTTACTTAA
+TATACCCAACCATATCATAA
+AATACCCTTCCAAATCATTT
+TTTTCCCAACTTTTCCATAA
+ATAACCCATCAATTCAAAAC
+TATTCCAACCCAAAACTTAA
+ATATCCATCCCAAATCTTTA
+TATTCCTACCCATTTCTTTT
+ATAACCAACCAAATCCTAAA
+TTAACCTTCCTAATCCTTAT
+ATTACCAACCTATTCTTTAC
+TTTACATCCCAATTCCTAAA
+AAAACAACCCAATACCTATA
+AATTCTTCCCAAAACCTAAA
+ATTACTTCCCATATCCTTTA
+TTTTCATCCCTAAACCAATA
+TATACAACCCTTAACAAAAC
+ATAACATCCCTTATCTAAAC
+AAATCAACCCATTACTAAAC
+AAAACTTCCCTATACAAAAC
+AATACTACCCTAATCTAATC
+TTAACTACCCAAATCAAAAC
+TATTCTACCCTTTTCTATAC
+TTTACAACCTATACCCAAAA
+AAAACTACCTATTCCCATAA
+AAAACATCCTTTACCCTAAA
+ATTACTACCATTTCCCTAAA
+TTTTCAACCTTATCCCTTAA
+TAATCATCCTTAACCAAAAC
+ATATCTTCCAAAACCTAAAC
+ATATCAACCATATCCATAAC
+AATACATCCTAAACCATTAC
+AAATCTTCCTTTTCCATTAC
+TTTTCTTCCATAACCATATC
+ATATCTACCTTAACAAAACC
+TTTTCTACCAAAACATATCC
+TTAACAACCATTACTAAACC
+TTAACTTCCTATACAAATCC
+TTATCATCCATATCATAACC
+AATACTTCCTTATCAATACC
+TAATCTACAAAACCCAAAAC
+ATTTCAACATAACCCTAAAC
+ATTTCTTCAATACCCAATAC
+ATAACAACAAATCCCAAATC
+ATAACTACTTAACCCATAAC
+AATTCTACTAAACCCTTTAC
+TTATCAACTATACCCTATAC
+TTATCTTCTAATCCCATTAC
+TTATCTACTTATCCCTAATC
+TATACTACATATCCCTTAAC
+TATTCAACAATTCCCATATC
+TAAACTACATTTCCCAATTC
+TAATCTTCATTACCCTTATC
+AAATCATCAATTCCAAAACC
+TTAACATCTTTTCCAATACC
+TATACTTCTATTCCTAAACC
+TATACATCATTTCCATATCC
+TATTCATCTAAACCAAATCC
+TAAACAACTAATCCATAACC
+TAAACATCAAAACCTATACC
+TAATCAACATTACCAATTCC
+ATATCATCTTATCCTAATCC
+AATACAACAATACCTTAACC
+ATTACATCAATACAAAACCC
+TTTACTACTTTACTAAACCC
+TTTACTTCAAAACTATTCCC
+AATTCATCATAACTAATCCC
+ATAACTTCTTTTCAATACCC
+ATTTCTACAATTCATTACCC
+ATTTCATCTTTACATTTCCC
+ATTACAACATATCTATACCC
+ATTTCCCTACTTAACTTTCA
+AATTCAACCCTATTCATACA
+AAATCTACCCATTTCTTTCA
+TATTCTTCTTTACCCATTCA
+TAAACTTCATAACCAAACCA
+CAAAACTCCTATTCAAAACA
+CTTTTCTCCAATTCTAAACA
+CTTTACACCTTTTCATAACA
+CTTATCACCTAATCAAATCA
+CTTAACACCAATACAATACA
+CTTAACTCCATTTCAAATCT
+CTATACACCTAAACTAAACA
+CTATACTCCAAATCATTACA
+CTAATCACCTTTACAAAACT
+CTAATCTCCTAATCTTAACT
+CATATCTCCATTACATAACA
+CAATTCACCAATTCATATCA
+CAAATCACCAAATCTATACA
+CAAAACACCATAACAAATCA
+CTAAACTCTATACCTAAACA
+CATTACTCTTAACCTAATCA
+CATAACACTTTTCCTATACA
+CAATACTCAAATCCTTAACA
+CTATTCACTTTACCTTTACA
+CTAAACACTATTCCATTTCA
+CATAACTCATTTCAAAACCA
+CTTTACTCATAACAATACCT
+CTTATCTCTTATCAAATCCT
+CAATTCTCTTTTCTAATCCA
+CAATACACATTACTTAACCA
+CATATCACAATACATATCCA
+CATTTCACAAATCTTAACAC
+CTATTCTCAATTCTTTACTC
+CTTTTCACTAAACATTACTC
+CATTACACTATACTATACAC
+ATAACCTCCAATACTTAACA
+TTATCCTCATATCCATTACA
+AAAACCTCTAATCTATTCCA
+TAATCCTCAATACTTTTCCA
+AATACCACATTTCTTATCTC
+AAAACACCCTTTTCTTAACA
+TTTTCACCCATTTCTTTACA
+TTTACTCCCTTATCTTATCA
+TTATCACCCTATACTTATCA
+TATACACCCATATCTAAACT
+TAATCTCCCTTTACTATACA
+ATAACTCCCTATTCTATTCA
+AAATCACCCAAAACTTTACA
+AAAACTCCCATAACTTATCT
+ATATCTCCAATACCATAACA
+TAAACTCCTATACCAATACA
+AATTCTCCTTAACCATATCA
+ATTACTCCAAATCCAAATCA
+ATTTCTCCATTTCCTTTTCA
+ATAACACCTAAACCTTATCA
+TAAACACCAAATCATTTCCA
+TTATCTCCTAAACTTTTCAC
+AAATCTCAAAACCCAATTCA
+TTTTCACTAAACCCTATTCA
+TTATCTCTATACCCATTTCT
+TTATCTCATATCCCAAATCT
+TATTCTCTAATCCCAATACT
+AATTCTCATTACCCTATACT
+AAATCTCTTATCCCTTTTCT
+AAATCACATATCCTAAACCA
+TTTTCACATTTCCATAACCA
+TAAACACTTTTCCTTTACCA
+TAATCACTATTCCAAATCCA
+ATTACACTTTACCATTTCAC
+TATTCACTATACCTTATCAC
+AAAACTCATTTCAATTCCCA
+TTAACACAATACATTTCCCA
+TTAACTCAAATCTAATCCCA
+ATATCTCAATACTAAACACC
+TAAACTCTTTACTTAACACC
+TAATCACAAAACTAATCTCC
+TTTACTCAATTCTTTACACC
+ATATCACTAATCTTAACTCC
+ATATCTCTTTTCTTTTCACC
+AATTCACCCTTAACTTACAA
+TAATCACCTTATCCAAACAA
+ATTTCACCTAATCCTATCAA
+AAATCTCCATATCCTTACTA
+TTAACACCATTTCTAACCAA
+ATTTCTCTATTCCCTAACAA
+ATTACTCATAACAATCCCTA
+TAAACACATAACTAACCCTA
+TATACACTTAACATTCCCTT
+ATAACTCTTAACTTTCCCAT
+AATACACCAATTCCTACAAA
+CAAATCTCAAAACACCAAAA
+CATTTCTCTATTCTCCAAAA
+AATTCCACAAAACTCCTAAA
+TTAACCACATAACACCTAAA
+TTATCCACTAATCTCCTATA
+TTTACCACAATTCTCCTTAA
+TTTTCCTCTAAACACCTTAA
+TTTTCCACTTAACTCCAAAT
+TATTCCTCATTACTCCATAA
+AAATCCACATATCACCAATA
+TAAACCACTTATCACAAAAC
+AATACCTCTTTACTCAAAAC
+TATTCTCCCTAAACACAAAA
+ATATCACCAATACACCATAA
+TTAACTCCAATTCACCAAAT
+AAAACACAAATCTCCCAAAA
+TTTACACAATTCACCCATAA
+TTAACACTTATCACCCAATA
+ATAACACATTACACCCAAAT
+AATACTCTAAACTCCCTATA
+TTAACCTCAAACTTTACTTC
+ATTTCCACATTCTATACACA
+AATACTCCTAACATATCTCA
+ATTTCACAATCCAAATCACA
+AAAACCACCAAACTATCAAA
+TTTACCTCCATACTATCTAA
+TATTCCACCTATCTATCATA
+TATACCTCCTAACAATCAAT
+TAATCCACCTTACAATCTAA
+TAAACCTCCTTACTTTCATA
+ATTACCACCTAACATTCTAA
+ATATCCTCCAAACATTCATA
+ATATCCACCATTCTTTCTAA
+AAATCCTCCTATCTTTCAAT
+TATACCACTTTCCTTACTTA
+ATAACCACTATCCATACTTT
+ATTACCTCATTCCTTTCTTT
+AATTCCTCTTTCCAATCTTA
+TATACTCCCAATCTAACTAA
+ATTACACCCTAACTAACTTA
+TTTTCTCCCATTCAAACAAT
+TATTCACCAAACCAAACTTA
+TTTACACCTTACCAATCATA
+AATACACAAACCCATTCTTA
+TTTACACTAACCCTATCTTT
+TATTCACATACCCAATCTAT
+TATACTCATTCCCATACATA
+TTTTCTCATACCATACCAAA
+AATACTCAAACCATTCCAAT
+ATATCACATTCCTTACCTAA
+ATTTCACTTACCTATCCAAA
+TATTCTCAATCCTAACCTAA
+TTAACTCTAACCTTACCATA
+TTTACTCTATCCATTCCTAA
+TTTTCTCTTACCAATCCTTT
+TATACTCTTTCCTATCTAAC
+AAAACACTATCCAATCTTAC
+TAATCTCTAACTAACCCAAA
+ATTTCTCAAACAAACCCATA
+AATTCTCTTTCTATCCCTAA
+TAAACTCAATCATACCCATA
+TAATCTCATTCAATCCCAAT
+TATACACATTCTTTCCAAAC
+AATTCACTTTCTAACCAATC
+AATTCACAAACTATCCTAAC
+ATTACTCTTACTATCAAACC
+ATAACTCATACATACTAACC
+ATTACACATACATTCATTCC
+ATTTCCTCCTTTCAACAAAA
+TTATCACAACCAATACTTAC
+TTATCACTTCCTATTCATTC
+AAAACTCTACTTTTCTTCCA
+ATAACACTACCCTTTCATTA
+AATACACTACTTACCCTTAA
+AAATCACTCCCATTACTTTA
+AAACCAATTCATATCTAACC
+TTTCCAAATCATTTCTATCC
+TATCCATATCTTATCTTACC
+ATACCATTTCTTTTCAATCC
+AAACCTTATCTATTCTAACC
+AAACCAAAACTAATCTTTCC
+TTACAAATCCCAATTCATAC
+TATCAAATCCATAACCTTAC
+AAACAATACCTTAACTAACC
+TTACTATTCCTAAACTTACC
+TAACAATTCCATTACAATCC
+AAACTATACCATATCATTCC
+AAACAAATCTATTCCTTACC
+TTTCAAAACTTTTCCTTTCC
+TAACTAATCATTTCCTATCC
+ATACTAATCTTATCCATTCC
+AATCATAACTATACCATTCC
+TATCTAATCTAATCTAACCC
+ATTCAAATCAAATCAATCCC
+ATTCTATACTAATCATACCC
+ATTCTATTCTATACTATCCC
+AAACTAAACAAATCTTTCCC
+AATCTTATCTTTACTTACCC
+TTTCATTTCTTATCTATCCC
+TATCTTTTCTATTCATTCCC
+TATCCTAAACTTTACTACCA
+ATACCTTAACTATACTTCCA
+AATCCAATTCTTTACATCCA
+TAACCATAACTTATCAACAC
+TATCTATTCCATATCTTCCA
+ATTCTTTTCCTTTTCATCCA
+ATTCTAATCCAATTCTTCCT
+AAACTTTTCCAAAACATCCA
+TATCAATACCAATTCATCCT
+TAACAAAACCAATACTACAC
+ATACTTTACCAAAACTACAC
+AAACATATCCAAATCTTCAC
+TTACAATACTATTCCAACCA
+AAACATTACATTTCCATCCA
+ATTCATTACTTTACCTACCA
+ATACAATTCATATCCTACCA
+TTACTATACTTAACCTACCT
+TATCTTTACATTACAACCCA
+ATACTTAACATAACTACCCA
+ATACTTTTCAATACATCCCA
+ATTCTAAACATTTCATCCCA
+AAACTATTCTTTTCAACCCA
+TTTCAATACAATACTACCCT
+TTTCATATCATTACTTCCCA
+TTTCTTATCATATCAACCCT
+TATCTATACATATCTTCCCT
+AATCATTTCATTTCTACCAC
+TAACTTATCAATTCTTCCAC
+AATCAATTCTTAACATCCAC
+TAACTTTACTTTTCTACACC
+AAACATAACTTTACATCACC
+TAACATTTCAAAACTACACC
+TTTCAATTCCCTAAACACAA
+AATCATATCCCTTAACACTA
+TATCAAAACCTAATCACCAA
+TTACATTACTATACACCCAA
+CCCAAACATATCAATCTAAA
+CCCTTTCTTTTCATTCTAAA
+CCCTTACATTTCTAACTATA
+TATCCCATAACTATCTTAAC
+ATTCCTTAACCCATACTAAA
+TATCCTTATCCCTAACTAAT
+TTTCCTTTTCCCTTACATAA
+ATTCCAATACCCAAACAATA
+ATTCCATTTCCCAAACTTAT
+TAACCAAATCCATACCAAAA
+ATACCTATTCCTTACCAATA
+AATCCTAATCCAATCCATAA
+AAACCATATCCTATCCAATA
+TATCCAAAACCAATCCTATA
+TAACCTATACCATTCCTTAA
+ATACCTAAACCTTTCTAAAC
+TAACCTTTACCTTACTATAC
+ATACCAATACAAACCCATTA
+TATCCTATTCAATCCCATTA
+TAACCATTACATTCCCTTTA
+TTTCCTATACATACCCTATA
+ATTCCTTTACTATCCCAATA
+AAACCTTTTCATTCCAAAAC
+TTACCTAATCTTTCCAATAC
+AATCCATTACTTTCCTTAAC
+ATTCTTAACCCATACCTAAA
+TATCATTACCCTTACCTTAA
+TTACTAAACCCTAACCTATA
+TTTCTTTACCCAAACCATTA
+TTACATTTCCCATTCTTAAC
+ATTCATAACCCAATCTTATC
+TTACATAACCAAACCCTTTA
+TAACTTAACCTTACCCATTT
+TTACTTATCCTATCCCTATT
+AATCTAAACCATACCTTAAC
+TTACATATCAATCCCTATTC
+TTACAAAACAAACCATTACC
+TATCTTAACAATCCTTTACC
+ATTCCATAACCATACAAACA
+TAACCCTAAACTCTATACAT
+AATCCCAATACTCATACTTA
+TTTCCCTATTCTCTTACTTT
+TAACCCATTTCTCTTTCTTA
+TATCCCTTTACACAAACTTT
+ATACCCTATACACATTCTTT
+AATCCCTAATCACATACATT
+AAACCCTTTTCTCTACAAAA
+TTTCCCTTATCACTACTAAA
+ATACCCATATCACAACATAA
+CTTACAATCATAACATAACC
+ATACAAACCCTTTACTTTAC
+CTTTCATACTTATCATTCCA
+AAACAATCCCATAACACAAA
+AAACTATCATTACACCCAAA
+TTTCTTTCATTTCTCCCAAA
+TTACAAACATTTCACCCTAA
+TTACTATCTATTCACCCATA
+TAACTTACAATACTCCCTAA
+ATACTTACATAACTCCCATA
+AAACTTTCATATCTCCCTAT
+AAACAAACTTTTCTCCTAAC
+TATCTAACTTTACACCTATC
+TAACATTCTATACTCCTATC
+TAACATACAAATCACCTAAC
+ATACATTCTTATCTCCAATC
+AAACTTACTTTTCACAAACC
+TAACTAACTAAACTCAAACC
+TAACAATCAAATCTCCATCA
+CCAAACAAACAAACATTACA
+CCTTTCTAACATACATTTCA
+CCTTTCAATCAAACAATACT
+CCTTACTAACAATCTTTACT
+CCTTACATTCAAACTTTTCA
+CCTTACAAACTTTCAATACA
+CCTATCATACTATCATTTCA
+CCTATCAAACTTACTTTACT
+CCTAACTATCTAACAATTCA
+CCTAACAATCATTCATTTCT
+CCATTCAAACTAACTATTCA
+CCATACTTACTAACATTTCT
+CCATACAATCTTACATATCA
+CCAATCTTACAAACTATACT
+CCAAACTATCAATCAAAACT
+CTATCTTACCAATCAATTCA
+CTTACTTACCTAACTAATCA
+CTAACATTCTATCCAATTCT
+CATACATTCATACCTATTCT
+CAATCATACATTCCTTATCT
+CAAACTTACATACAATTCCA
+CATTCTTACATTCATATCAC
+CAATCATTCATTCAATTCTC
+AAACCCAAACATTCTTTTCA
+TTACCCTAACTTTCTAATCA
+TTACCCAATCAATCTATTCT
+ATACCCTTTCATACTTTTCT
+AATCCCATTCTTTCTTATCT
+TTACCTATCCATACTAATCT
+TTACCATTCCAATCATATCT
+TATCCAATCCAAACTTAACT
+AATCCTTTCCATACAATTCT
+TATCATTCCCAATCTAATCT
+TAACTATCCCATTCAATTCT
+AAACATACCCTATCTTTTCT
+ATACTAACCAATCTTTTCCT
+TTTCTAACATACCCTAATCT
+TTTCATACTAACCCATATCT
+TTACTAACAATCCCATAACT
+TTACAATCTAACCCTAAACT
+TATCATACATTCCCAAAACT
+AATCAAACTTACCCTTAACT
+TTTCAATCAATCCTAATCCT
+ATACTTTCAATCCATATCCT
+AATCAATCATTCCATTTCCT
+ATACATACATACCATAACAC
+ATTCAAACTAACTTTTCTCC
+CCAATCTAACTTACAAACAA
+CCTTACTTTCTTTCAAACAA
+CCTTTCATACTTACTAACTA
+CCTATCTTTCTAACATACTA
+CCTATCTATCAAACTAACAT
+CCATACTAACTATCTTACAA
+CCATTCATACATTCATACAA
+CCATTCTATCATACATACTT
+CCAAACATTCTTACTATCAA
+CCAAACTTACATACTTACTA
+CCAATCATTCTATCAAACAT
+CTAACAATCTTACCTTACAA
+CATTCAATCATTCCATACAA
+ATTCCCAATCTATCTAACAA
+TTTCCCATACTAACTTTCAA
+TTTCCATTCCTTTCATTCAA
+AATCCATACCTTTCTATCTA
+TTACCAAACCATTCTATCAA
+AATCCTATCTAACCATTCAA
+TTTCCATACTAACCTTTCAA
+TTTCCTAACTTTCCATTCTA
+TAACCAATCAAACCAATCTA
+TAACCTAACTATCCTTTCAT
+TATCCATTCTTACCATACTA
+AAACCTATCATACCAAACAT
+AATCCTTACTTACCTATCAT
+TTTCCAATCTTTCAAACCAA
+AATCCAAACATTCTTACCAA
+ATACCTTTCTATCATACCAA
+ATACCATACTTTCTATCCAA
+ATTCCAAACTTTCATTCCTT
+TTTCCTTACAATCAATCCAA
+TTACCTTACTATCTAACAAC
+TTACCAATCTATCAATCATC
+TTACTTACCCTTACATTCAA
+ATTCTTTCCCTTTCTTTCAT
+TTACATTCCCTAACAAACTA
+ATTCTTACCAATCCAATCAA
+TTACATACCATTCCTATCTA
+AATCATACCTTTCCAAACTA
+AATCTTTCCAAACCTAACTA
+ATTCTAACCTAACCTATCTT
+AAACATTCCTTACATTCCAA
+TTTCATTCCATACATACCAT
+TTACTTTCCTAACTTTCCTA
+TATCTATCCTTTCTTTCCAA
+TAACAAACCATACTTTCCAT
+AATCTTACCTTACTATCCAT
+ATACTATCCAAACTTACAAC
+TATCAATCCAATCATACAAC
+ATACAATCCTATCAAACTAC
+TTTCAAACAAACCCTTTCTA
+TATCTTTCTATCCAATCCTA
+ATTCAATCTTTCCTATCCTA
+AATCATTCAAACCTAACCTA
+TTTCTTACTATCCTTACCTT
+TATCTTACAAACCATTCCAT
+TAACTTTCTAACCTATCAAC
+AATCTATCTTACCTTTCTAC
+TTTCTATCAAACATACCCTA
+ATTCATACAATCAAACCCTA
+TATCAAACATACTTACCCTT
+ATTCATTCATACATACCTTC
+AAACTAACATTCTTTCCTTC
+AAACCATTCAAACAAACACA
+ATTCTATCCATTCTAACACA
+AATCTAACCATTCATTCTCA
+CCAATCAATCTAACTTCAAA
+CCTTTCTTTCAATCTTCAAA
+AATCCCTTACAATCAACAAA
+ATTCCCTAACAAACTTCTAA
+ATTCCTATCCTAACATCAAA
+CCTAACATTCATACACATAA
+CCTAACTTTCTATCTCATAT
+CCATACATACAACTATCTTA
+CCATTCTTACTTCAATCTTT
+AAACCCTATCAACTAACATA
+ATTCCCTTTCTACTTACATT
+TAACCTTACATCCTATCATT
+TATCCCAAACTTCATCAAAA
+TAACCCTTACTCTAAACTTA
+AAACCCATACACATTACTTA
+TTACCCATTCACTTAACTTT
+TATCCCTATCTCTTTTCTTA
+TAACATCATTTCCCATACTT
+AAACTTCTTTACCCAATCTT
+AATCATCTTTTCCCAACAAA
+TTTCATCATAACTCCCAATT
+TTTCAACTAATCACCCTATT
+TATCAACAATACTCCCTTTT
+TAACTTCAATACACCCTAAT
+ATACTACAATTCTCCCATTT
+AAACAACTTTTCACCCTTTT
+TTACTTCAAAACTCCTAAAC
+AATCTACAAAACACCTATAC
+AAACATCTAATCTCCTATAC
+AAACTTCATATCACCTAATC
+ATTCTTCTAAACACCATAAC
+ATACATCTATACTCCAAATC
+TAACTACATATCTCCTTTAC
+TTTCTTCATTTCTCCTTATC
+TTACAACATAACACCAATAC
+TTACATCAAATCACCTTTTC
+TTACTACTATACACCTTTAC
+AATCTACTTATCTCAAAACC
+TTTCTACTATTCTCTTAACC
+TATCAACTTTACTCTATACC
+TATCTTCTTAACACTTAACC
+ATACAACTTAACTCATTACC
+ATTCAACATTTCACAATACC
+AATCATCATTACTCAAATCC
+TTTCATCTATTCACCAAACA
+ATACTACTTTTCTCTAACCA
+CTTTCCATCAAACATACAAT
+CTATCCTACATACTAACAAT
+CTATCCAACTATCATTCATT
+CTAACCTACTAACATACTAT
+CATACCAACTTACTAACTAT
+CAAACCTTCATACATTCAAT
+CAAACCTACAATCTATCTAT
+CATTCTTCATACCTAACATT
+CATTCAACTAACCTTACAAT
+CTATCAACAAACAAACCAAA
+CATACAACTTACAATCCAAA
+CAAACAACATTCATACCTAA
+CAATCTACTATCTAACCATA
+CTTACTACAAACTATCCTAA
+CTTACAACTATCATACCATA
+CTTTCTACTTTCAAACCTAA
+CTAACTTCAATCAATCCATA
+CTAACATCATACTTTCCAAA
+CTATCTACATACTATCCATT
+CTATCATCATTCTAACCTTA
+CTAACTACAATCTTACTAAC
+CATACTTCATTCTTACAATC
+CAAACATCTATCTTTCTTAC
+CTAACAACTTTCTTTCAATC
+AATCCAACATACAAACCTTA
+TTTCCTACTTACATTCCTTA
+TATCCATCAATCTATCCTTA
+AATCCATCTTTCTTACCTTT
+AAACCAACAATCTAACTTAC
+TTACCTACATTCAAACTTTC
+TAACCATCTTACTAACATAC
+ATTCCTTCTATCTATCTTAC
+ATACCATCTAACTTACTTTC
+AAACCTACTAACAAACATTC
+TTACTACCCATACAAACTAT
+AAACATCCAATCTTTCCATA
+TTTCAACCATTCATTCCATA
+AAACAACCAAACATTCTTAC
+TATCTACCATACAATCTTTC
+TAACATCCTTACTTTCTTTC
+AATCAACCTTACATACTATC
+TATCATCAATCCCTAACTTT
+AATCAACATACCAAACCATA
+ATTCATCAAACCTATCATAC
+TAACAACAAACCAATCATTC
+AAACTACAAACTTTCCCTAA
+TTTCTACATACTTACCCTTA
+TTACAACTAACATTCCCTTA
+ATTCTACAATCAAACCCTAA
+AATCTTCAAACATACCCTTT
+AAACAACATTCATTCCCATA
+TAACAACTATCTATCCTTAC
+ATACTTCTATCAATCCTTTC
+TAACTACTTACATTCCATAC
+TAACATCTTACAAACCTTTC
+ATTCTACTTTCATACTTACC
+TATCTACTAACTTACTTTCC
+TTACTTCTTACTTTCTTACC
+TTTCTTCTTTCAATCTATCC
+ATACAACAATCATTCTTTCC
+CAATCTTCTTACTTACAACA
+AATCCTTCTTTCTATCAACA
+ATACATCCATACATTCAACA
+TTACAACCATACTAACTACA
+ATTCATCCTATCATTCTTCA
+ATTCTTCAATCTTTCCTACA
+ATACATCATACTTTCCATCA
+ATACTTCATTCATACCTTCT
+ATTCAACTTACTTACAACCA
+TATCATCTAACTTTCTACCA
+TTACATCTTTCATTCAACCA
+TAACTTCTAACAAACAACAC
+TATCTTCATACTATCTACAC
+TAACAACCTATCTTACACAA
+AAACTACCTTACTATCACAA
+TTACTACATTCTAACACCAA
+CAATCCAACAAACTTCAAAA
+CTTACCATCTAACTTCTAAA
+CTTTCCTTCAATCTTCATAA
+CTTTCCTACAAACAACAATA
+CTTTCCAACTTTCTTCAATA
+CTAACCATCATACTACATAA
+CATACCTTCAAACTACAAAT
+CATACCATCAATCATCAATA
+CATTCCATCTTACATCATAA
+CAAACCAACTAACAACTTAA
+CAATCCTTCTTACTACAATA
+CAATCCTACTTACTTCTTAT
+CAATCCATCTATCTACTAAT
+CAAACTTCTAACAACCTTAA
+CTATCTTCAAACTACCATAT
+ATACCCAACATACATCTAAA
+TTACCCTTCTAACATCTTAA
+ATTCCCATCATTCTACTATA
+TAACCAACCTTTCTACTTAA
+ATACAACCCAATCAACTAAA
+TATCAACCCTATCATCTATA
+TTACATCCCTTTCATCTAAT
+TTACTTCCAAACCTTCTTAA
+AATCTTCCTAACCATCTTTA
+AAACTTCCTATCCTACTTAT
+ATTCTACCAATCCTTCATTA
+ATTCTTCCATACCAACTTAT
+TTTCTTCCTTTCTACCATTA
+AATCATCCATTCTTCCATTT
+AATCTACCTTTCAACCAATT
+TATCTTCCAATCAACCATAT
+TTTCTACCTAACTTCCTATA
+TAACTACCAAACTTCATAAC
+ATACTACCATTCTACTAACA
+TAACTTCCATTCACATATCT
+CTTTCATCAAACTCTTTCAA
+TATCATCCTTTCACTAACAA
+TTTCATCCAAACACATACAA
+ATTCAACCTAACACAACAAA
+ATACTTCCTTACACTACTAA
+CATACCTACATCATACTTAA
+CTTACCTTCTACATACATTA
+CATTCATCCAACTTTCAAAA
+CATACATCTTCCTAACATTA
+CTTTCTTCTACCTAACTTTT
+CTTACTTCTTCCAATCAATT
+CAAACTACTACAATCCAAAA
+CAATCATCTACTATCCATAT
+CTTTCAACTTCTAACTAAAC
+CATTCTACATCAAACATAAC
+CTTACATCTACAAACTTTAC
+TTTCCCAACAACAATCATAA
+TAACCCAACTTCATTCATTA
+ATACCTTCCTACTTTCATAA
+TTTCCATCCTTCATACATAA
+TTTCCTTCCAACTATCAATA
+TTACCATCCTACATTCTATA
+ATTCCTACCAACTTACATTT
+ATACCAACCATCTATCATTA
+ATACCTACCTTCTTTCTATT
+TATCCTACAACCATACTTTA
+ATTCCAACTACCATTCTTTT
+AAACCTTCATCCTTACTATA
+AAACCATCATCTAACCTTTA
+TTACCAACATCTTACCTATT
+TAACCTTCTTCAAACTTAAC
+AATCCTACTACTAACTTATC
+TTACCTTCAACTTACATAAC
+TATCCAACTTCATACATTAC
+ATTCATCTTCCCTATCTTTA
+AAACATCAACCCAATCTATA
+AATCAACTACCTTTCCTTTA
+AAACTACTACCAATCATAAC
+TATCTACATCCATTCATATC
+AATCTTCTACCTAACAAATC
+TTTCCAACAACTTTCAAACA
+TTTCAACAACCTTACATTCA
+CAAACCATCTCTATTCTTAA
+CTTACCTACTCTTATCTTAA
+TAACCTACCACATAACATAA
+TATCCTTCACTAATCATTAC
+CAATCAACTCATAACTTACA
+CATACTACTCAATACACAAA
+ATTCCATCTCTATTCACAAA
+AAACACTAAACAATCCCTTA
+TTTCACAATACAATCAATCC
+TTACACTAATCTAACAATCC
+AAACTCATTTCCATACTCAA
+AATCACTTTACCCAACATTA
+TTACACATTTCCCTACATTA
+TTTCACTATTCCCAACTATA
+TTTCACTTATCCCATCATTT
+AATCACATATCCCTTCTTTA
+TAACTCTATACCATCCTTAA
+AAACACTTTTCCTTCCTTAT
+AAACACAAAACACATTACCA
+TTACTCATAACACTATACCA
+TTACTCAAAACTCATAACCT
+TATCTCAATACACTTTACCT
+TAACTCAAATCACTTATCCA
+TAACACATAACTCAATTCCT
+AATCACAAATCTCTTAACCT
+AAACTCTAATCTCAAAACAC
+TTTCTCTTATCTCATTACAC
+TTTCTCTATTCACAAAACTC
+TTACTCTTAACTCTAATCAC
+TATCTCTAAACACAATTCAC
+TAACACAATTCTCAATACTC
+ATACACTATACTCAAATCTC
+AATCTCATATCTCTATTCAC
+AAACTCTTTTCACTTAACTC
+TTACACTTAACACCTTACTT
+TATCACATTACTCCTAACTT
+ATACTCATTACACCTAACAT
+ATACTCAATTCACCATTCTT
+AATCTCTTTACTCATTCAAC
+CCTTACTCAATCATACAATA
+AATCCACTTACTAACATTAC
+TTACCACTTTCAAACAATAC
+TATCCTCATTCTATCATTTC
+ATTCCTCTATCTTTCATTAC
+AAACCACTATCTTACAATTC
+ATTCACCTTACATACCATTT
+TATCTCCAATCAATCTTTAC
+AAACACCTATCAAACTATAC
+AAACTCCAAACATTCTATTC
+TTACTCTATCCCATTCAATA
+ATTCTCTAACCTATCTATAC
+TATCACTATCCTTTCAATAC
+TTTCTCATTCCTAACTATTC
+ATTCTCAAACCAAACATTTC
+ATTCTCTTTCCATTCTAATC
+AAACCTCTAACATACATACA
+TTACACAATCCAAACTAACA
+ATACACATACCATACTTTCA
+ATACACTTTCAAACCATACA
+ATACACAAACATACCAAACT
+TAACACTATCTTTCATACCA
+AAACCTCAATCTATCTTCAA
+ATTCTCCATTCTTACTACAA
+TTTCTCCTATCTAACTTCTA
+ATTCACCATACAAACATCAA
+ATTCACATTCCAATCTACAA
+TATCACTTACCAAACTTCAA
+TATCTCTTACCTATCACAAA
+TTACCTCAAACTACTATTCT
+ATACCACTAACTACATTACT
+AAACCACAAACATCAATCAA
+TTTCCACATTCAACAATCAA
+TATCCACAATCTTCATTCTA
+TAACCTCTTACATCTATCAT
+AATCCACATACTACAATCTT
+TTACACCAAACTTCAATCTA
+AATCACCTAACTTCTTTCTA
+AATCACCAATCATCAAACTA
+AAACACCATTCTACTATCTA
+ATACTCCTTACTTCATACTA
+TAACTCCTAACATCTAACTA
+TTACACCTTTCAACATTCTA
+TTTCTCAATCCTACTTTCTA
+ATTCACAAACCATCTTTCTT
+TATCACAATCTACCAATCAT
+AATCACTAACATCCATTCAT
+AAACACATTCTACCTTTCTT
+TAACACTTACAACATTCCTA
+ATACTCTAACAACAATCCTT
+TTTCACATACTTCATACCTA
+TAACTCTTACTACTAACCTT
+AAACTCAATCATCAATCTAC
+ATACTCTTTCTTCTATCTTC
+AATCTCTATCTTCTTACTAC
+AAACTCCTTTCATCTACAAA
+TTACTCCATACTTCTACTAA
+ATTCTCATACCAACTACAAA
+ATTCACTTTCCTTCTACATA
+TAACTCATACTCATATCTTC
+ATACCTCTTTCACAATCATT
+TTTCCTCATACTCTACTTTA
+TTACCACATCTATCATACTT
+TATCCACTACATTCTAACTT
+ATTCCTCAACTATCAATCTT
+AATCTCAACCAATCTTACTA
+TATCTCATCTTTCTTACACA
+ATACCACAACAATCATCAAA
+TAACCACTTCAAACATCTAA
+TTACCTCTACAAACAACATA
+ATACCTCATCATTCTACAAT
+ATACACCTACTTTCATCTAA
+TATCACCTTCATTCTTCTAA
+TAACACCAACATTCAACTAT
+TAACACCTTCTTACAACTTA
+TTTCACCAACTAACAACTAA
+TTACTCCTACTATCTACTAT
+ATACACCATCTTACTTCATA
+ATTCACTACCTATCATCTTA
+ATTCCACTTCTAACTCAAAA
+TTTCCTCTTCAATCACTAAA
+TATCTCCTACAATCTCAAAA
+AATCTCCATCTTTCTCTAAA
+TTTCTCCAACATACTCTTAA
+TAACTCCATCATACTCAAAT
+ATTCCACAACTTCAACTTTA
+AATCCTCTACTACATCTTTT
+ATTCTCCTTCATCATCATTA
+TTTCACCTACATCTACATTT
+ATACTCCAACTTCTTCATTT
+TATCACCATCACTAATCATA
+CTTTCACACTAAACTTACTT
+CATACACTCTATACATTCTT
+CAAACTCTCAATTCACAAAA
+CTTTCTCACAAATCACATAA
+CTTTCTCTCTATTCTCAATA
+CTTACACACAATACACTAAA
+CTTACACTCATTTCACATTA
+CTTACTCACATTTCTCAAAT
+CTATCTCACTATTCACTAAT
+CTATCTCTCATTACACTTAA
+CTAACACTCTTTACACAAAT
+CATACTCACTTTTCACTTAA
+CATACTCTCTTATCACAATT
+CAATCTCACATAACACAATA
+CAAACACACTATACTCATAA
+CAAACACTCAAAACACTTTA
+CAAACTCACTAATCTCTATA
+TATCCTCTCATAACTCTAAA
+TTTCCACTCTAAACTCTTTA
+TAACCACACTTATCTCTTAA
+AATCTCCTCTTTTCTCATTA
+AAACTCTCTTTCAATCTTCA
+CATTCACTCATACTTCTATA
+CTATCACACAAACATCTATT
+TAACCTCACTTACAACTTTT
+TTACTCACTTACCATCAATT
+TATCTCACAATCCAACTAAT
+TATCACACATACCTTCAAAT
+ATTCTCACATTCCTACAATT
+TTACACACAATCATCCATTA
+AATCACACTATCTTCCAATA
+AAACTCACAAACATCCTTTT
+ATTCACTCAAACAACCATTT
+ATACACTCATTCATCCTATT
+TAACACTCTAACATCCAATT
+TAACACACTAACTACCTTTA
+TTTCTCTCAATCTTCCTTTT
+ATTCTCTCTTACATCAATAC
+TAACTCTCATACAACAATTC
+TTTCACACTTTCATCAAATC
+ATACACACTTACTTCATTTC
+ATACTCTCTATCATCTTTTC
+TAACTCACTATCAACAAACA
+AATCACTCATACTACAACAA
+ATACTCACATACATCTCTAA
+TATCTCTCTAACTCAAACTT
+AATCTCACTAACACTATCAT
+AATCTCTCATTCTCAACTAA
+TTTCACTCTTTCTCATCTAT
+TATCACTCTATCTCTCATAA
+CATTCTCTCAACAAACTATA
+CAATCTCTCTTCTATCTATT
+CATTCACACATCTAACAATT
+AAACACACATCAATCAAACA
+TTACTCTCAACTAACAACAA
+TTACACTCTTCAATCATCAA
+TTTCTCACTTCTATCTCAAA
+ATTCACACAACAAACTCAAA
+AAACACTCAACTTCTATACT
+CTTTCACTCTCATAACTTAA
+CAATCACACTCTAAACTTTA
+CATACACACTCAAAACTAAT
+CTATCACTCACTTTTCTTAT
+AATCCTCACTCATTACATTA
+ATCAAAACTATCCCATTACT
+AACCATTACCTTACAATCAT
+TTCCAAAACATACTTACCTA
+TTCCTATACAAACTAACCAT
+TTCCAATTCAATCAAACCTA
+TACCTTAACTTACATACTTC
+AACAATACTTACCTATCTAC
+TTCTATACTTTCCATTCTAC
+ATCCATATCTTACTTACTCA
+AACAAAACCAAACAATCTCA
+AACCCAATACTTTCTTCTTA
+TACCTAAACCTTTCAACTTA
+AACCTTATCCATTCATCATA
+TACCATATCCTTACTACATA
+TTCCATTACAAACCTTCAAA
+AACCAATACATACCATCTAA
+ATCCATAACATACCTTCTTT
+TTCCTTTTCTTTCCTTCTAA
+TACCAAATCATACAACCAAA
+ATCCTAATCAATCTACCAAA
+AACCAATTCTAACTACCATA
+TACCAAAACTATCTTCCAAA
+TACCTTTTCATTCTTCTAAC
+AACAAATCCCAAACTACTTA
+TTCTAAACCCATACTTCTTA
+TACTAATCCCTATCAACATA
+AACATTTCCTATCCATCAAA
+TTCATATCCTAACCAACTAA
+TACTTTTCCAATCCTACTAA
+TACAATTCCATTCCAACAAT
+AACATAACCTTACCAACATA
+ATCTAATCATACCCAACTTA
+TACAAATCAAACCCATCATA
+TACTATTCTTTCCCTACTTA
+TTCTTTTCTTACCCATCTTT
+ATCAATTCATTCCCTTCATA
+ATCTTATCTATCCCTACATA
+AACTAAACATTCCAACCTAA
+ATCATAACTTACTACCCTAA
+TTCTAATCTTACAACCCTTA
+AACATATCATTCAACCCTAT
+ATCCATTTCCATTCTCTTTA
+TTCCTAAACTAACCACAAAA
+ATCCTTATCTATCCTCAATA
+AACCTTTACTAACTCCTTTA
+TTCCAATACTTACACTAAAC
+AACTTAACCCAAACACATTA
+TACTTTACCCAATCACAAAT
+AACTATTCCCTTACTCATTA
+TTCAATTCCTTTCCTCAAAA
+ATCTATACCATACCTCTAAA
+ATCAAATCCATACCACAATA
+TACTTATCCTTACCTCATAA
+TTCAATACCAAACCACATAA
+TACAATACCTATCACCTTTA
+TACTATACCTAACTCTAAAC
+TACAAAACTTTCCCACTAAA
+AACATTACAATCCTCCATTA
+TTCATTACATACACCATTTC
+TACTTAACTATCTCCAATTC
+AACAATTCAATCTCCATATC
+AACTTTACTAACTCTAAACC
+TACATTACTTTCTCTTTACC
+ATCAATACAAACACTAATCC
+ATCTATTCTATCACTATACC
+ATCTTAACAAACTCATATCC
+AACTTTTCATACTCAATTCC
+TTCATTTCATTCACCTTACA
+ATCTTTACTTACTCCTTACA
+ATCATATCTTTCACCATTCT
+TTCTTATCAATCACCAATCA
+ATCTAAACAATCACTTACCA
+AACCTATTCAACCTTTCATT
+ATCCAAATCTTCAAACAACA
+TACCATTTCTACAATCAACA
+TACATATCCAACATACAACA
+ATCATTTCCATCAAACTACA
+TTCATAACCATCAATCATCA
+TTCAAAACATCCTTTCAACA
+AACTAATCAACTATCATCCA
+ATCTTTTCAACAATCTTCCT
+TACATAACATCATACAACAC
+AACTTATCTTCTTTCAACAC
+TTCAAATCATCATTCATCTC
+TACATTTCTTCTTACATCTC
+ATCCTTTACAACATTCACAA
+TTCTATTCCTTCTAACACAA
+TACTAAACCAACTAACTCAA
+TTCTTTACCATCTTTCACTA
+AACTATACATCCAAACACTA
+TTCCCATATCAACATCAAAT
+TTCCCAAATCTACTACTATT
+TACCCTATTCTACAACATTT
+AACCCTAATCATCTTCTATT
+TACCTATACCTACTTCAATT
+ATCCTTAACCATCAACATAT
+TTCTTAACCTACTACCAATT
+ATCATTACCTACAACCTAAT
+ATCCCTTTTCTCATTTCATA
+TACCCATTTCACTTTACATA
+TTCCCTAAACACTTTTCATA
+AACCCTATACTCTTAACATA
+AACCTAATCCTCAATTCATA
+TTCCTATTCTCTAATCAAAC
+AACCATAACTCATTTCTACA
+TACAAACTATCATACTACCT
+AACAAACTTTCTTTCTTCAC
+AACATTCAAACTTACCACAA
+TTCTAACCAATCTACCAAAT
+ATCAAACTTACCCTACTTTT
+TTCTAACATTCCAACCTATT
+TTCATACTAACCATCCAAAT
+TACATACATACCTACCTAAT
+AACTTACAATCCTTCCAAAT
+AACTAACTAACCTACAATAC
+TTCTTACTATCCTTCAATTC
+TACTATCTTACCTTCAAATC
+AACATACTTACCATCAATTC
+AACTATCATTCCTACTATTC
+AACAAACAAACAACCCAATT
+AACAATCATTCTTCCCAAAT
+TTCTTACATACAACCTATTC
+TTCATACAATCTACCAAATC
+TACAATCTATCATCCATTTC
+ATCAATCAATCAACCTTATC
+AACAATCTTTCCATCTAACA
+ATCTATCTTTCTTCCAAACA
+AACTATCTATCTACCTTTCA
+ATCTAACTTACAACCATTCA
+TACATACTATCAACTTTCCA
+AACTTACTAACAACAAACAC
+CATCTATCATACACATAACT
+TTCAATCTAACCACTAAACT
+TTCAAACTAACTCTTATCCT
+TACTAACAATCTCTAAACCT
+TTCATTCAATCACAATACAC
+ATCATACATTCACTAAACTC
+TACATTCATACACTATTCTC
+CAACATACTATCACAATCTA
+TACTTTCAATCCACTAACTT
+TACAATCAAACTCCTTACAT
+AACATTCTTACACCATACAT
+TTCTATCTAACACATACCTT
+ATCTATCAAACACTTTCAAC
+ATCAATCTTACTCTTACATC
+ATCTAACAAACTCAAACATC
+TTCAAACATTCTCATACACA
+ATCTTACTTTCTCAAACTCA
+TTCATTCTATCTCAATCACA
+CTTCTTACATTCTCTACTTA
+TACTAACTTTCCACATCTTA
+AACTTTCTATCCTCATCTTT
+TACTATCAATCTCCTTCTTA
+ATCATTCATTCTCCATCTTA
+TACATTCTAACTCCTACTTT
+TACTTACTTACTCAACCATA
+AACTAACATACACAACCTTT
+ATCTTACAAACCTCACTTTA
+TTCTATCATACCTCTCTTTT
+AACTTTCATTCCACACTATA
+ATCATACTTTCCTCACAATA
+AACATACAAACACCTCTTAA
+ATCATTCTTTCTCTCTATAC
+CTACAAACTACTTACTAATC
+TTCAATCATCAATCCTATTC
+CTACTATCAACATTCAATCA
+CATCATTCTACATACAATCA
+ATCCTAACATCTATCAATCA
+TACTTTCTTCTTTCCTAACA
+ATCTTTCATCTAACCTATCA
+TTCTTTCAACTTACCTTACT
+TTCTAACTACATACAAACCA
+CTACATTCAACATACTTCAA
+CATCAATCTACATTCTTCTA
+CTACTTACTACTTTCATCAA
+CTACTTTCTTCATTCTACTA
+TACAAACATCCTAACATCTA
+ATCAAACAACAAACCAACAA
+TACTTACATCAAACCTACAA
+ATCTTTCTACTAACCATCAA
+CTACAATCATCTTTCTCAAA
+AACATACCAACTTCATTACT
+CTTCTAACTACAACATACAT
+CTACATACTTCAACTATCTT
+CAACATTCATCATCATTCTT
+TTCCATACAACATCATACAT
+TACCTAACAACTACTTACAT
+AACCATACATCTTCTTACTT
+CAACAAACAACAACATCATA
+CAACTATCTTCATCTTCATA
+CAACAATCTTCTACAACATT
+TACCTTACATCTACATCATT
+ATCCTATCTACTTCAACATT
+AACCTTTCTACAACTTCATT
+AACCTTACTTCATCAACTTT
+AACCTATCATCAACTACTAT
+TTCATACCATCAACATCTTT
+TTCAATCCTACATCATCATT
+TTCAAACCTACTACTACTTT
+TACTATCCAACTACAACTAT
+ATCAATCCATCTACTACAAT
+AACAATCCAACATCTTCTAT
+CTACTAACTTCTTCACTATA
+AACCAATCAACAACTCTATA
+TACAATCCTTCTACTCAATA
+AACTAACCTTCTTCTCTATT
+AACATTCCATCATCTCAATT
+TACATTCCTTCAACACTAAT
+CATCTTTCAACTCAACTATT
+CCTTCAAACTCAATTCTTTA
+CCTACAAACACTATACATTT
+CTACCTAACACTTATCATTT
+CTTCTTTCTCTTTACTCAAA
+CATCATACTCATTACTCTTA
+CATCTAACACTTTACACTAA
+CATCTTACTCTAATCTCATA
+CTTCATTCTCAAATCTCAAT
+CTTCTATCTCAAAACACTAA
+AACCAAACACAAAACTCTAA
+TTCCTTTCACAATACTCTAA
+TTCCAATCACTAAACTCATA
+TTCCAAACTCAATTCTCTTA
+TACCATTCACATATCTCTTA
+ATCCTTACACATAACTCAAT
+AACCTAACTCTTAACTCTTT
+AACCATTCTCTAAACACTTA
+ATCTATCCACTATTCTCTAA
+TACAAACCACAATTCACTAA
+TACTTTCCACTTATCTCTAT
+TTCTTACCACTTTTCACTTA
+TTCTTTCCTCTATACTCATA
+AACTATCCTCATATCACTAA
+ATCATTCCTCTTTTCTCTTT
+TTCTTTCTCTAATCACCAAA
+TTCCTATCACAATCTACATT
+TACTTACCTCTAACTACATT
+TTCCTTACTCAAACTCAATT
+TACCATACTCTTACACTATT
+TACCAATCTCTAACACATAT
+TACTAACCACTATCACTTTT
+AACAAACCTCTCATAACATA
+AACTTCAAACAATCCATACA
+AACAACTAACTTCTATACTC
+AACAACCTATCTTCTAACAT
+TTCATCAAACATCTATCCTT
+TTCAACATACTACAATCCAT
+TACTACAATCAACTTACCAT
+AACTACTATCATCATTCTTC
+AACATCATTCAACTTTCTTC
+AACTTCATTCTTCATTCACA
+TACTTCTATCTACTTTCTCA
+TACTTCTTACATCATACTCA
+ATCTTCAATCTTCTAACTCA
+AACATCTTTCATCAAACACT
+AACTTCTAACTACATACACT
+TACATCAATCCATCTACTTT
+ATCAACTATCCAACTTCTTT
+AACTACATACCTACTTCAAT
+AACAACAAACTACTTCCTAA
+TTCATCCATACATCACATTT
+TACTACCTTACTACACATTT
+TACATCTTACCATCACTATT
+AACATCTATCCTACACTTTT
+AACAACATTCCTTCACATAT
+TACAACTTTCACAATACACA
+ATCTTCTTTCTCAATACTCA
+ATCTACTTACACTATTCACA
+TTCATCTAACACAAAACTCA
+TTCAACAATCTCTATACTCA
+TTCAACTTACTCATTACTCT
+TACTACATTCTCAAATCTCA
+ATCAACCTAACACTTACTAT
+TTCTACAAACACAATCTACA
+TTCATCATACACTTTCTACT
+AACTACCAATCTCATCATAT
+TACATCTACATTCTATCACA
+TTCAACTACCATACATCAAT
+TACAACAACATTCAACCTTA
+ATCATCTACTATCAACTTAC
+ATCTACAACCTAACACTTAT
+TTCATCTTCATTCCTCATTA
+AACTTCTTCTTTCACCATTA
+TACTACTTCTATCTCCTTTT
+AACATCAACAATCACTTAAC
+TACAACTACTTTCACATAAC
+ATCATCAACTACTATCTACA
+TACATCATCTACAAACTTCA
+TTCTTCTACTACTTACTACT
+ATCTTCATCTTCTTACTTCA
+TACCAACTACAACTTCTTTT
+AACCTACAACATCATCTTAT
+TACAACATCCAACTTCATAT
+TACTACTACAACCTACATAT
+AACTACAACTACCTTCTAAT
+TACTTCAACATCAACCTTTT
+ATCAACATCAACTTCCATAT
+TACTTCATCAACATCTATTC
+ATCTACTACTACAACTTTTC
+ATCTACATCATCTACATTTC
+ATCATCATCATCAACTAATC
+AACAACTTCTTCTACAAATC
+ATCAACTTCATCTTCTAACA
+TTCTTCTTCAACTACTTACA
+ATCAACAACTTCTTCATACT
+TTCTACTTCAACAACAACTA
+TTCTTCAACTCAAATCACAA
+CTTCAACTCAAATCTCATTT
+CTACTACTCAATACTCTATT
+CAACTACTCTTAACTCATTT
+CAACATCACATTACTCTTTT
+CAACAACTCATATCTCTAAT
+AACAACTCTTACTCATAACT
+ATCAACACTACTACATCTAT
+AACATCACAACTCATTTCAT
+AACAACACACATTACACTTA
+TTCTACACACTTAACACTTT
+TTCATCACTCATTTCACATA
+TACTTCACACAAATCACTTA
+TACATCTCACTATACACATA
+ATCAACTCACATTTCTCATT
+AACTACACTCAATCATTCAT
+ATCTCATAACTAACCCATAT
+TACACTAAACTATCCTTTTC
+ATCTCATTTCCATACATCAA
+AACACTTATCATTCCTACAA
+TACACTTTTCTTACCAACTA
+AACACTTTACTTACATCCAA
+TTCTCTATACTTCTTTCACA
+TACACTTAACTTCCATCATT
+AACACAAAACATCAACTCAA
+ATCTCAAAACTCTTATCACA
+TACACATATCTCTAATCACA
+TACTCTAATCACTTATCTCA
+TTCTCTTAACTCTATTCTCA
+TTCTCAATACACTAAACTCA
+AACTCATTACTCTTTACTCA
+ATCACAAATCACATTTCTCA
+TACACAATACTCAATCCTAT
+ATCACTAATCTCATACTACA
+TACACTATTCACATACTTCT
+TTCACAATTCTCTTACATCA
+AACTCTTATCTCAAACATCA
+TTCTCTAAACTCATACACAA
+ATCACTATACACAAACACAT
+ATCTCTTTACTCAAACTCTA
+TACTCAAATCTCAATCTCAA
+TTCACATAACTCTTTCTCAA
+TTCTCTTTTCACATTCTCAA
+TACACATTACACATCCTAAT
+AACTCATATCACTACTTTTC
+TACTCTATTCTCATCTTACA
+ATCTCAATTCACAACATACA
+AACACATTTCTCTTCTTACT
+AACTCTATCATTCATCCAAA
+TACTCATACTATCCACTTAA
+AACTCTTTCAATCCTCTTAT
+TTCACATTCTTTCTCTTAAC
+ATCACTTTCTTACACATTAC
+TTCACTAACAAACACAAACA
+ATCACATACTTCAACATATC
+AACTCTAACTACATCATATC
+AACACAATCTACTTCTTTTC
+TTCTCATTCTTCATCATACA
+ATCTCTATCTACATCTTTCA
+TTCACAAACATCTTCATTCA
+TACTCTTACAACTTCAACAA
+ATCTCTAACATCATCAACTA
+TTCACTTACTACTACTACTA
+AACTCAAACTTCTACTCTTT
+AACACTATCATCATCTCTTT
+ATCACAATCAACTCTTACAT
+AACACTAACTTCTCTATCTT
+TACTCAATCACTTAACCTTT
+ATCTCTTACTCATATCTCAA
+TTCTCAAACACATTACTCAA
+TTCTCATACACAAATCTCTT
+TACTCATTCACAATCATTCT
+AACACATACACTAACTACAA
+TTCACTATCTCAAACTCTTA
+TACACAAACTCTAACTCATT
+AACTCAACTACTCTATCAAT
+TACTCATCTCTTATCACATA
+TACTCTACTCATACAACAAT
+AACACTACACTTACTCTAAT
+ACAAAACATACTCCACATTA
+ACAAAACTTCTATCCTATCA
+ACTATACATCCTTACTTCTA
+ACTTATCTTCATACCATCTA
+TCTAAACAACCATTCTCATA
+TCTAATCAACTTTCCACAAA
+ACAATTCAACATCTTTCCTT
+ACATTACAACTACTATCATC
+TCATAACATCTACATTCTCT
+ACATAACTTCATCTTACTCT
+ACAATACCTACTTCTTCATT
+ACAAATCTACCTTCATCAAT
+TCTTAACATCATCCTACATT
+TCTAATCTACATCCAACTTT
+TCTAAACTACTACCTTCATT
+TCATATCTACAACCTACAAT
+TCAATACTTCAACCATCAAT
+ACAATACATCTTCCAACTAT
+TCTTTACAACAACATCCTAA
+ACATTTCATCAACAACCTAT
+ACTTTACTACTTCTACCTAA
+TCTATTCATCTTCATCCTTA
+ACTATTCTTCAACTACTTAC
+ACTATACTTCTTCAACATTC
+ACAATTCTTCTACATCAACA
+ACTTTTCAACAACTACACAA
+TCATATCATCATCTACTCAA
+ACTTATCATCTACCTCTTTA
+ACATTTCTTCATCCTCTATA
+ACATTACTACATCACCATAT
+ACTTTTCTACACAATTCTCA
+TCTTAACTTCTCTTTCATCA
+TCAAATCATCTCATTCTCTA
+TCAAAACACTTAACACCAAA
+ACTTTACACTTTACTCCAAA
+ACTTAACACATATCACCTAA
+ACTAAACACAAAACTCCATA
+TCAATACACAATTCTCCAAA
+TCTATACACTAACTTACTTC
+ACAATACTCAAACTTTCACT
+ACTAATCACAATCCATCTAT
+TCAAATCTCTTTCCACTTTA
+TCTTATCTCAATCCACTATT
+TCAATTCACATTCCACAATT
+TCAAAACTCTAACCTCATTT
+TCATTACACATTCACCTATA
+ACATATCACATACTCCAATA
+TCTTTTCTCATACACCTTTT
+ACTATTCACAAACTCATAAC
+TCATTTCACTATCTCATTAC
+TCAATTCTCATTCTCATATC
+TCTTATCACTAACACATATC
+TCTATTCTCTTACTCTTTAC
+ACTAAACTCAATCTCTTATC
+ACTAATCTCTAACTCAATTC
+TCTTTTCACTTTCTCAAACA
+TCATTACTCTATCACTAACA
+TCTATACTCATTCACAATCA
+ACATAACACAATCTCAACAA
+TCATTTCTCAAACACTCTAA
+ACTTAACTCTACAACATTCA
+TCTTTACTCTTCAACTATCT
+TCATAACTCTTCTTCTACAA
+ACAAATCACTTCATCTACTA
+ACATATCTCTACTACACTTT
+TCTAACATACATCTTCCTTA
+ACATTCATTCATCCACAAAT
+ACAATCAAACCTCATTCTAT
+ACAAACTAACACTAACTTCA
+TCTATCAATCACTATCTTCA
+ACTTACATACTCTATCTCTA
+TCATACTATCTCATCATTCA
+ACAAACAACAACCAACAATT
+ACATACAACATCTACCTTAT
+TCAATCTACAACTACATATC
+TCAAACTACATCTCAATACT
+ACAAACATCTTCACTTTCTT
+TCATACATCTACTCAACAAT
+ACTTACTACTTCACAACTTT
+TCTAACAACACTAAACTCAA
+ACTTTCAACACAAAACTCTT
+ACTTACAACTCTTTACTCTA
+ACTATCTACTCTATACTCAT
+ACTATCATCACTAATCACTA
+ACTAACTACACAATACACTA
+ACTAACATCACAATTCTCAT
+TCAATCATCTCTTAACTCTA
+TCTTACATCACTTTACACAT
+TCAAACTTCACAAACTACTA
+ACTTACTTCACTAACACATA
+TCATTCTTCTCTTACACATT
+TCTAACTTCTCAATCACATT
+TCTTTCTACACTATCACTTT
+ACATACTACTCAAACACAAT
+ACTTTCATCACATTCACATT
+ACTAACACATTCACTCATAT
+TCAACATTCAACTCAATCAT
+ACTACATACTACACATTCAT
+ACAACTATCAACACTTCTAT
+TCAACATACTCAATACTCTA
+ACTACATTCTCTTTTCTCTA
+TCTACTAACACATACTCAAT
+ACTACAATCTCATACACTAT
+ACATCTTACACTTACTCATT
+ACAACTAACTCAACTCTTAT
+ACTCTAAACTTACCACTATA
+TCACTTAACTACTTCAATCT
+TCACATAACAACATCAACAA
+ACACAAATCACATATCACTA
+TCTCAATTCACATTTCTCTT
+TCACAATACACTTTCACAAT
+ACTCAATACTCATTCACTTT
+ACACTATACACATCACTTAT
+TATCACCCATAACCTACTAT
+TTACACCCTTTACCACATTT
+AAACTCCCTATACACTTTAC
+TTTCTCCCTTAACACTATAC
+TAACACCCTAATCACTATTC
+CTTTCTCCTATCTACTATCA
+CATACTCCATACTTCTATCA
+CATTCACCTTTCTTCTTTCT
+AATCCCACATACTCTTCTTT
+CTAACACACATACACAATAC
+CTAACTCACACTATTCTCTT
+TTCCCAATTCCTATCAACTT
+AACCCTTAACACATAACTCA
+ATCCCAAAACACTATCATCA
+TACCCTTTACACTTACACTA
+TACCCTTATCACAATCACTT
+AACCCATAACACTTCTTCAA
+TACATACCCTAATCCTAATC
+ATCAAACCCAAATCCTTTCA
+ATCATACCTATTCCCAAACA
+TTCTATCCCAATACCTTCAA
+AACTTACCCAATTCCTTCTA
+AACTTTCCCATTACCATCAT
+TTCATTCCCATACTCAATAC
+ATCTTACCCTTACTCATTTC
+ATCTTTCCCTATCTCTAACA
+ATCTAACCCATTCTCTATCT
+TTCCATTCTTCCTTTCTTCA
+ATCCATACTACCTTTCACAA
+ATCCAATCCATCTACTTTCT
+TACCAAACTTCCAACAATCA
+TACCTTTCATCTTCCATTCA
+ATCCAAACATCAACCACATA
+CAACCAAACAACACAAATCT
+CATCAAACCTACACTTTCAT
+CAACCATACAACTCTCTTAT
+CAACTTTCCACAATCTAACT
+TACCTATCTCCAATCAACAT
+ATCCTTTCTCAATCCAACAA
+AACATCCAATACCCTTTACT
+TTCTTCCAAATCCCTCAATT
+TACATCCTTAACCCTCTATT
+TTCTTCATACCCTAACAACA
+TTCATCCTTTCTACATACCA
+AACTACTTTCCCTACATTCT
+TTCTACTAACCTTCCAATCT
+TACATCCATTCATCCTTCAA
+TTCCATCATTCACATATCTC
+AACTTCCTATCACATTTCTC
+AACCAACTTTCACTATCTCA
+TACTTCCTTACACTAACTCT
+ATCCTACTATCTCTTCCATA
+ATCATCCTAACTCATCTTTC
+TTCAACCATTCACCTCAAAT
+AACAACCAAACACACAATTC
+TTCTACCATACTCACATTTC
+ATCCAACATCAACCTTCTAT
+AACCTTCAACTACAACTAAC
+TTCTTCCTTCTTCTTCTTAC
+ATCTACCTACAACAACTACA
+AACCTACTTCTACCACTTTT
+AACCATCTACTTCCACATAT
+TACTTCCATCAACTCCATTT
+TACAACCTTCTACTCTATTC
+AACATCCTACTTCACTAATC
+TACAACCATCTACTCATACA
+TACTACCATCATCACTTTCA
+TTCTACCTTCAACACAACAA
+TACCATCAACACATTCATCA
+TACCAACAACTCTAACATCT
+TTCCATCTTCACTAACACTT
+ATCAACCAACTCATTCACTA
+ATCTTCCTACACATACACTT
+TTCCTTCTACTCATCTATCA
+AACCTTCTTCTCAACTTTCT
+TACCTACTACTCTTCAAACT
+TTCCTTCATCACAACTAACT
+TTCCTACATCTCTACATCTA
+AACCATCATCACTTCATCTA
+TTCCAACTTCACATCTTCTA
+TTCAACCTCTAACACTTTTC
+CAACTACACTATCACATACA
+TACATCACCATACACTATCA
+TACTACACAAACCTCTTACA
+AACTTCTCAAACCACATTCA
+AACTACCTCAATCACATCAA
+TACAACTCAACCTTCCTAAT
+TACTACTCATCCTACAAACT
+ATCTACACTTCCATCAAACT
+AACTTCACTACCAACTTACT
+AACATCTCTACATCTTACCA
+TTCTTCACATCCATCATCTA
+ATCATCTCAACCAACATCTT
+TTCTTCTCTACCTTCTTCTT
+TTCTACTCAACATCCATCAA
+TTCAACACAACTTCCTACTA
+TTCAACTCTACTACCAACAT
+ATCATCACATCATCCTCAAA
+TTCATCTCTTCTTCCTCTTA
+ATCTTCTCATCACTAATCTC
+AACTACTCTTCTCTAACTTC
+ATCTTCACTTCACTACCTTA
+TACTTCTCTTCACATCCATA
+ATCTACTCTACACTTCCATT
+TACAACACTTCTCTTCAAAC
+TACACCAAACAACACTTACA
+AACACCTTTCAACTCTTTCA
+AACCTCATTCTCTATCACTT
+AACCTCAAACTCTACTTATC
+TTCCTCTAACTCAACTACTT
+TACCACTATCACATCATCAT
+AACCACTAACTCTCTTCAAT
+ATCACAACTTCCTACATACT
+ATCTCATCTTCAACCTAACA
+TTCACATCATCCAACTACAT
+TACACTTCAACCTACTTCTT
+ATCACTACTTCTACCTACTA
+AACACAACTACATCCAACTA
+TTCTCATCAACCATCTCATT
+TACTCAACATCACTTTTCTC
+TTCACTTCTACACAATCTTC
+AACACATCAACTCTTTCATC
+TTCTCTACAACTCTACCATT
+TACACAACAACACAACAAAC
+AACTCATCATCACATCAATC
+TACTCTTCAACACTACATTC
+ATCACTTCATCTCAACAACA
+TTCTCTTCTTCTCATCTACT
+TTCACTACAACACTTCACAA
+ATCTCTACTTCACACTTCAA
+TTCTCAACACTAACCTTTCT
+TTCACAACACATTCCATCTA
+AACACTTCTCATACTACTAC
+AACTCTTCTCTATCTTCTTC
+ATCTCAACTCTTTCTACTCA
+ATCTCTTCACTTACCACAAA
+AACTCTACACAAACCTCATA
+TACACATCTCATTCACCTTA
+TACACTACTCTATCACACAA
+AACTCACTATCACTTCCTTT
+AACACACTTACACATCTACA
+AACTCTCTATCACCACTAAT
+AACACACAATCACTCATTCA
+ATCACTCAACCTAACTCTAT
+AACACTCTTCTCTAACTCTT
+ATCTCTCTACTCTACAATCT
+TTCACACTACACTACATCAT
+ATCTCACATCTCAACATCAT
+ATCACACTTCACTTCTACTT
+TCATTACCTATCCACCATTT
+ACAAATCCCAAACTCTATCA
+ACTTATCCTAACTCCAATCA
+TCTAAACCATCTTCAAACTC
+CTCTAAACTACCTACTACAT
+CACAATTCTACCATCTACAT
+ACATTTCCAACAACCTTCTA
+TCTATACCCATCAACACTAT
+ACAATTCCCAACTTCTCAAT
+ACAAAACCTTCATCCACTAA
+ACCATTTCTACTCAATCTCT
+CACAAATCTACTCCTTCAAT
+TCATATCCTACTCATCCATT
+TCAATTCCTACACTACCAAT
+TCTTTACCTTCACTTCAACA
+ACTTAACCAACACATCATCA
+TCTTTTCCATCTCTACTACT
+ACATAACCATCACTCCTTAT
+TCTATTCCAACTCACAAATC
+CACAATACATCACACTACAA
+CACTAAACTCCTATCTTTCT
+TCCAATACACAATCCTTACT
+CTCTATACACTATCCATCTT
+CTCATATCACATACCTACAT
+CTCAATTCTCTTACCTCTAA
+CACATAACTCTAACCACTAA
+CTCTATTCACAAACTCCTAA
+CACATTTCACTTTCTCCTAA
+CACAAAACACATACACCTAA
+CTCTTAACTCATTCTCATAC
+CTCTTTACACTTTCACAATC
+ACCATAACACCTTTCACTAT
+ACCTAATCACATTCTCCTTA
+TCCAATTCACTATCTCCATA
+ACCTTATCTCTTTCACCTAT
+ACTATACCACAAACACCTTA
+ACTAATCCACATTCACTTCA
+CTCATTACTCATCAACCAAT
+CTCAAATCTCAACTTCCAAT
+CACTTAACACTACTACCTAT
+CACTAATCTCTTCTACATAC
+CTCATTTCTCTACTTCTCAA
+CACATATCTCATCTCAAATC
+ACCTAAACACTTCTCCATAT
+ACCATTACACTACACTTATC
+CTCAATACTCTACACATACT
+CACTTATCACTTCACATTCT
+TCCTTTACTCTTCTCAATCA
+TCCTTTTCACATCTCTTTCT
+CACTATACTCAACTCATCAA
+CACTTTTCTCATCACAACAT
+TCCAAATCACAACACATCTA
+ACCAAAACTCTTCACTTCTA
+ACCTATTCTCACTACACAAT
+TCAAATCCACTCATCACTAT
+ACTAACAAACCCATTCTACA
+ACTAACTTACCTTCTATCCA
+TCAAACAATCCCTTCAACTA
+TCATACAAACCTTCAACCAA
+ACATTCTAACCAACAACCTA
+TCTTTCATTCCATCAACCTA
+ACAATCTTTCCCATCACAAT
+ACTATCTTACTCCAATCAAC
+TCTAACTAACCACTTACACT
+ACAAACTTTCCACTATCACT
+ACAATCTATCTCCTACCTTT
+ACTTTCTATCCACTACAACA
+TCTTACAATCCTCAACATCA
+ACATTCTTTCCTCTTCTTCA
+ACAATCATACCTCTACACTA
+TCATTCTACCATTCCTCTAA
+TCTTTCTTCCAAACCACTTA
+TCATTCATCCAATCCTCATT
+TCAATCTTCCTATCACCATA
+ACATACTTCCTTACACCATT
+TCTATCTTCTACCATACTAC
+TCATTCAACCTACATCCTTT
+ACTATCAACTTCCATCCAAT
+TCAATCAACCATCTTCAACT
+ACATACCTACTACTCTTCAA
+ACAAACCAACCACAAACATT
+TCTATCACTACTTCCAACTT
+ACAAACTCATCTCCTCTTTT
+TCATACACTACACTCTTTTC
+TCTTACACATCTCACTATCT
+TCTTTCTCAACACACTCAAA
+TCTAACTCACTAACACCTAT
+ACAATCTCTCAAACACTACA
+TCATTCACTCAACACTAACT
+TCAATCTCACAACTCTACAA
+ACTATCACACATCACTACTA
+TCTAACACTCACTTACTCTT
+ACAATCACACTCTTACTCAT
+ACAACTTACTTTCCCTAACA
+ACAACAAACCTATCCACTTA
+TCTTCATACCAAACTCTACA
+ACTACTTTCTACTAACCACA
+ACTTCTTACTTCCTACTAAC
+TCTTCAATCTTCCTTCTATC
+TCATCAAACCAACAACACAA
+ACATCTTTCCAACATCTCAA
+ACTTCATTCCATCTCATCTA
+TCTTCTAACACCATACATCA
+TCAACAATCACCAATCTCTA
+ACATCTATCACCTATCTCAT
+ACAACTTTCTCTATCCACAA
+TCTTCTTTCACTTTCCTCAA
+ACATCATTCTCATTCCTCAT
+TCATCTAACTCTTACTCCAA
+ACTTCTATCTCTTTCACCTA
+TCTACTATCACTATCTCTCA
+TCATCATACTCTACTAACCA
+ACTACTTACTCTTCATCCAA
+ACATCAATCCACTACTCTAT
+TCAACTACACATCCTCATAT
+ACAACATCACTACTCAACTA
+ACAACACAACACAACACATT
+ACTCATTTCCTAACTCCTTA
+ACTCATATCTACCAAACAAC
+ACACTATTCATCATTCCTCT
+ACACATTACCATCATCCTAT
+TCTCAAATCTCTAACCCTTT
+ACTCTTTTCACATACCTCTA
+TCTCATAACACAATCCTCTA
+TCTCTATTCACTTACACCAA
+TCACTTTACACATTCTCCAA
+ACACAAAACTCATACTCTCA
+ACTCTTAACTCTACATTCCA
+TCTCTAATCACTACAAACTC
+TCACAATTCTCAACTAACTC
+TCACTAAACTCCAACTTCAT
+TCACATATCTCATCCTACTT
+ACTCTTTACTCAACCATCTT
+ACTCATTACACAACTACCAA
+ACACATTTCTCTTCTACCTA
+TCTCAAAACACAACAACAAC
+ACACTTTTCTCATCATCTCA
+TCACTTATCTCTACTTCTCT
+ACTCTATCTAACACCTTCTT
+ACACAATCACCACTTTCTAT
+CTATCCTTCATCCATCAAAC
+CATTCCTTCCTTCATCTCTA
+TTACTCCCTTTTCCCTTTCA
+ATTCTCCCATTACCTAACCA
+ATACTCCCAAAACCATACCT
+CTTACCACTAACCAACTCTA
+CTATCCTCTTACCACCTATT
+CTATCCACAATCTCTTTTCC
+CTTTCACCATTCCTCCAATT
+CAAACTCCATTCCACCTTAT
+TTACCACCTAACCTCTAATC
+AATCCACCAATCACATTACC
+CTTACCTCTATCCTCAATCT
+CTAACTCCTTTCCACAAACT
+CTATCACCTATCACCATACT
+AAACCCTCCATTCACTTACT
+TTACCCTCTAACCACTTTCT
+TTACCCACTTACACCTAACT
+TAACCTCCTTACCTCATTCT
+TTTCCTCCAAACTCCATTCT
+TATCTCCCAATCTCATTCCT
+TAACTCCCATACACTTACAC
+CAAACCTCATACCACAACTA
+CAATCACCATACCTCTTCTA
+TTACCTCCAATCCACTTCTT
+AATCACCCTATCTCATCCTA
+CTAACCACCTTTCACTCTTA
+CAAACCACAACCACAAACTT
+CAATCTCCTTCACAACTATC
+CAATCCTCTACTCTTCTACA
+CTTACTCCTTCTCAACTTCA
+CATACCTCAACTCCTCTAAT
+AAACCACCCAACACACAATT
+CATACACCTACTCTCATACT
+CATTCCACTACTCACTACAT
+CATTCTCCAACACTCTACTA
+TATCCACCTTCTCTCAACTT
+TTTCCACCTACACACACAAA
+ATACCACCAACTCTCACATA
+CAAACACCTCATACCTCTTA
+CATTCTCACCTAACCTCAAA
+CTTACTCTCCTTTCCTCATA
+CTAACTCTCCAATCTCCTTT
+ATACCTCCTCAATCTCTTTC
+CTTACACCACTAACTCTTCA
+TAACCACCACTTACACATCA
+AAACCCACACAACAAACTCT
+AACCCATTACCCTACAACTA
+CAACCTTTCATCCTAACTAC
+ATCCCATACATCCATTCATC
+TACCCAATCATCTTACCCAT
+CATCCTAACAACCTTCATAC
+CAACTAACCTTCCAACATAC
+CTTCATACCAACATCCCAAA
+CTTCAATCCTTCTTCCCAAT
+TTCCCATTCTACCTACAAAC
+ATCCATTCCTACCATCTAAC
+CTTCCTTTCAACCATCATCT
+AACCCAAACTACCAACACTA
+TTCCTAACCCTTCTACTCTA
+AACCCTTTCTTCACATTTCC
+ATCCCTATCTTCTCAAACCA
+CTTCAAACCCAACACTCATA
+TACCCTAACCAACTCACAAA
+CAACTTACCTCTTTCCCATT
+TTCCCTTACCTCATCAATCT
+ATCCCAATCTCTTCCACTTT
+TTCCCTTTCACAACACCATA
+ATCCATCTATCCCAATACCA
+ATCTACCAAACCCTAAACAC
+ATCTTCCATTCCCTTCATCA
+AACATCCCTTTCCTCCTATT
+ATCTACCCATTCTCCAACAT
+TACTTCCCTTACTCTCAAAC
+AACTTCCAACAACCTTACCA
+ATCATCCAACTACCATTCCT
+AACCCTACATCTCTCATCAT
+CTTCATCTCTATCCCATACA
+CATCAACTCTTACCCAAACT
+CAACAACACTTTCCTAACAC
+CTTCTACACTTACCCTACAA
+CTACAACCTCTTACTCCTTT
+CTACAACACCAATCCACATA
+CAACATCTCCATACCACATT
+CATCTACACCATACTCCTAT
+CTACATCACCATTCACATCA
+CTTCAACACCTATCTCTCAA
+AACCAACACAACCCAAACTT
+CATCATCACTACCATTCACT
+CTTCTTCACATCCAACAACT
+CTACTACACATCCTTCTTCT
+CTTCATCACAACAACTACCA
+CTTCTACTCCTACTACACTT
+CTACATCTCAACCTCCTAAT
+CATCTACTCATCCACCTAAT
+CTACTTCTCATCACTTTACC
+CATCTTCTCTACACTATTCC
+CAACTTCACTTCTCATTTCC
+TACCATCTCATCTCTATTCC
+TACCTTCACAACTCCTTTCT
+ATCCTTCACTACTCTAACAC
+CTACTTCACCATCTCTACTT
+CAACTTCTCTTCCACTACTT
+CATCAACACATCACAACCAA
+TTCCTACTCTACCACATCTT
+ATCCTACACAACACTACCTA
+CTTCTTCTCCAACTCTCAAA
+CATCATCTCCTTCACTCAAT
+CATCTTCACCTTCTCACTAA
+CTACAACTCCTTCTCTCTAA
+ATCCATCACCTACACACTAA
+ATCCAACTCCATCACACAAT
+TTCCAACACTACCTCACTTA
+ATCCTTCTCACATCTACCAA
+TACCTACACTCTTCTTCTCA
+TACCTTCTCTCAACAACTCA
+ATCACCTAACCCTTCATCAT
+ATCCACAAACTCAAAACCCA
+TACACCTATCCTCTAACATC
+AACCACTTTCTCCTATCTCT
+ATCCTCTATCACTTTCCTCA
+AACCACAATCACAAACTCAC
+TTCTCCATTCCACATACTCT
+ATCTCCTTACCACTAACACT
+ATCCACATACACCTTCCTAT
+TACCTCAATCTCCATCTTAC
+TACCTCTTTCACTACCCATT
+ATCACCATACTCCATCATAC
+TTCTCCAAACTCCAACTTTC
+ATCTCCTAACTCCTTCAATC
+AACCTCTTACACCTACTACA
+TACCACATTCACCAACTACT
+TACACCATTCCTCATCAACT
+TTCACCTTACACAACCAACA
+TACACCCAAACTCTTCACTA
+TACTCCATACCACATCACAA
+AACTCCTATCACCTTCTCTA
+TTCACCAATCACCATCACTA
+TACTCCAATCTCACTTTTCC
+AACTCCTTTCACCTCAAACT
+CAACTCATCCTTTCTCACAA
+ATCACATCCATCATCCTCAA
+AACCTCTACATCCCACTTAT
+AACACCTACTTCTCCCTAAT
+CTACACTTCTACTCCTATCT
+CAACTCTTCATCACATACCT
+ATCTCCAACATCCTCTAACT
+CAACTCTACTTCCACATCAT
+CTTCTCAACAACTCATCAAC
+CTACTCTACCAACACACTTA
+CAACACAACCTTCACACATA
+CAACACTTCCTACACTCTTT
+CATCTCTTCTTCCTCTCTTA
+TTCCACATCCTACTCTCATA
+CATCTCTACCTCAATCACAT
+CTACTCAACTCTATCACCTA
+CAACTCAACACTTCCCTTAT
+CTACACTACACCATCTTCAT
+TTCACCTACACTTCATCTTC
+CTTCTCTTCACATCAACACA
+CAACACTACCACTTCTCTAT
+CTTCACATCTCAACCTCTTT
+CTTCACAACTCATCTCCAAT
+CATCACTTCTCTACACCAAT
+TACACCTTCACTTCTCCATT
+CTACACAACACATCTCTTCA
+TACTCCTACTCATCACAACA
+CTTCTCTACACACTACTTTC
+CTACTCATCTCACATCTTCT
+AACACCATCACTCTACATCA
+ATCACCAACACACAACTTCT
+ATCTCCATCACACTTCTCTT
+ATCACCTTCTCACTCAACAT
+AACTCCAACTCTCTCTTCTT
+CATCACTACTCTCACACTAT
+TTCTCACTAACACCCTTACA
+TTCTCTCTTCCTTTCCACAA
+ATCTCTCAACTTCCCATTTC
+AACACTCATCCAACATCCTA
+ATCACACAACCTACAACCTT
+TTCACTCTACCATCCACAAT
+TACTCTCATCCTTCCACATT
+TACTCACAACTCCTACTCAT
+TTCACACATCACTCTAATCC
+TACTCACTTCTCACCTATCT
+TACACACTCCATTCCACTAT
+TACACACACTTCACTATCCA
+TACACTCTCATCCTCATCTT
+ATCTCACTCAACACATCAAC
+TTCTCACACCTACTCACTTT
+ATCACTCTCTACCTCTCATT
+AACTCTCACTTCCTCACAAT
+AACTCACACACAAACACCTA
+TACTCTCTCACTACTTCCAA
+TTCACTCACTCTACCACTTT
+CTCAAAACCTATCCTACCAA
+TCTAATCCCTAACCCAACAA
+ACTAAACCCTTTCCCATCTA
+TCAATACCCAAACCCTACTA
+ACTATTCCCTTACACCAATC
+CACTATTCATCCCTATTCCT
+CACTTTACAACCCAAATCAC
+CTCATAACAACCTAAACCCA
+TCCTTAACATCCCATAACTC
+TCCTAAACCTTCATCCCTTT
+ACATTACCCTACATCCCTAT
+CTCTTATCCATCCTACATCT
+TCCATATCAACCCATCTTCA
+TCTTATCCCTACTTCCAACA
+ACTTTTCCCTTCAACCTACA
+TCATAACCCTTCTACCTACT
+ACCAAATCCTACTCTTATCC
+TCCTATACAACCTCCCATAT
+CTCTTTTCCTACACAATCCA
+ACATATCCCATCTCATACCT
+TCAAAACCCTACTCATTCAC
+ACCTTTACCTTCACCTACTT
+TCCTATTCCATCTCTTCCAA
+TCTTAACCCAACTCTACAAC
+TCCATTTCCCATCACTCATT
+ACCTTAACCAACACTCAAAC
+CTCTAATCCTCAAACCTATC
+CACATTACCACTAACCTCAA
+TCCTAATCCACAAACCACAA
+ACTTTACCCACTTACCTCAA
+TCATTTCCCACATACACCTA
+ACCCTTATCACAACTTACCT
+ACCCATATCACTTCCATCAT
+TCCCTTAACACTACCTCAAT
+TCCCATTTCACTCATCACTT
+ACCCTAAACACTCTCTTACT
+TCTAACCTTTCCCAAAACCT
+ACAATCCTTACCCATTACCT
+TCTTACTATCCCTTAACCCA
+ACATACATTCCCTTTTCCCA
+ACTTTCTTACCCATAACCCT
+ACCTAACTATCCCTACTATC
+TCTATCTAACCCAACCATCA
+TCTATCATTCCCAACCTCTA
+TCTTACCTAACCTCCAAACT
+TCAATCCAATCCTCCTAACT
+ACTTACCATTCCTCTTTCCA
+TCAAACCATACCACTTTCCT
+TCTTTCAAACCCTCATACAC
+TCAAACATACCCACATACTC
+TCATTCCAAACCACTTCCTA
+TCCTTTCATACCCTCACATT
+TCTAACCCATACTCCTCTTT
+ACCAATCTTCTTCCTATTCC
+ACCAAACTTCCATCTTCCTA
+ACCTATCAACCATCATCCTT
+ACCATTCTTCCTACTACCTT
+TCTATCCTACCTACATCCTT
+ACCTTACTTCCAACTCCAAT
+ACCAATCAACCTTCTCTTAC
+ACTAACCATCCATCCTCTAT
+TCTTTCCAACCAACTCATAC
+TCCTATCTACCAACACAACA
+TCCATACATCACATATCCCA
+ACAAACCTTCACAAATCCCA
+TCCTATCATCCACTTCATTC
+ACTAACCTACACTTCCCTAT
+TCCTTACAACCTCTTCATCT
+TCATTCCTACTCAACAACCT
+TCCTTACTACCTCAACTCTT
+ACCATTCAACTCTTCCTCTA
+ACCTAACAACACTACCACTA
+TCTATCCATCCACATCTCTT
+ACATTCCATCTCTTCCACTT
+TCCATACTACACACTTATCC
+ACTATCCTTCTCTCAATCCA
+ACAATCCATCACACAAACCT
+ACTATCCAACACTCTATCAC
+ACCATACAACTCACTACAAC
+TCAAACCTACCTCTCTACAT
+ACATACCATCCTCACTTCAT
+TCTAACCAACACACATCTAC
+ACATTCCTTCACTCATCTCT
+TCATACCTTCTCCACACTTT
+TCTTACCACATACCCTTTTC
+ACTTACCTCATTCCCTATCA
+ACTTTCCTCATACCCATACT
+ACTTTCCACAATCATTCCCA
+TCATACCACTTTCAATCCCA
+TCAATCCTCAAACCTCAACA
+ACAAACACCCTTTCACTACA
+TCATACTCCCATACACTTCA
+TCAAACTCTTCCCTTTACAC
+TCTATCTCATCCATTACCCA
+TCAAACACATCCTATTCCCA
+TCAATCACTTCCCAATCACT
+ACATTCACCTACTCCATACT
+ACATTCTCCATCACTACCAT
+TCTTTCACCTTCTCTTCTAC
+CTCAATCACATCTCCTCAAT
+CACTTACACTACACCTCTAT
+ACTATCTCCTTCTCACCATT
+TCTTACTCCTTCACACAAAC
+ACTTACACCAACTCACTAAC
+ACATACACCATCACACACAA
+CACAAACTCACCTTTCCTAT
+CACAATCACTCAATCCACTA
+ACTTTCTCCTCATACCACTT
+ACTAACTCCTCAATCTCCAA
+TCATTCTCTCCATTCCACTA
+ACTTACTCTCCTAACCACTA
+ACTTTCACACCATTCACCAA
+ACATACTCACCAATCTCACA
+CTCAATCTCTCTTCAACTCA
+CACTATCTCACTTCACCAAT
+CTCATACACACTACTCATCA
+CACTAACACTCACTTCTACT
+CTCTTTCACACTCAACACAT
+CTCTAACTCACACTCTCTTT
+CACATACTCACTCACTCTAT
+ACTACCTTTCTCTACTCCTA
+ACATCCTAACACCTCTCTAT
+ACATCCAAACACTCACAAAC
+TCAACATCCACATTCCTACT
+ACTACTTCCACTTTCTCTAC
+TCTACTACACCTATCCTCTT
+ACAACAACTCCTTTCTCCTA
+TCTACATCTCCATACTCCTT
+ACTTCATCCTCATTCTCTCA
+ACATCTACTCCTTACACTCA
+TCTACTTCTCCAAACACTCA
+TCATCATCACATCCCAATCA
+ACTTCTTCACAACCCTATCT
+ACAACTTCTCTTCCTTTCCA
+TCATCTTCTCAACATACCCA
+TCATCAACCTCAACTTCCAT
+ACTACAACTCAACCCTTCAA
+TCTTCAACACAACCAACCAA
+ACTTCTACCTCTACTCCATT
+TCTTCATCACCTACACCTTT
+ACTACATCACCATCTCCTAT
+TCAACTTCACCTTCACTTTC
+TCTTCTTCCTCTTCTCAACA
+ACTTCAACCACAACTCAACA
+ACAACTACTCCATCTCTACA
+TCAACAACACCTACTCTACT
+ACATCATCTCCTTCTCATCA
+TCATCTACACTCTACCCAAT
+TCTTCTACTCTCTTCACACA
+TCTACAACACTCACTTCAAC
+TCTACTCATCACCTACACAT
+ACTACTCTACACCATCTCAT
+TCTTCACTACTCACATTCCT
+ACAACTCATCTCTCTTTCTC
+ACAACTCTTCACACTACACA
+TCATCACTACCACTCACTAT
+ACTACACATCCTCTCTCAAT
+ACATCACTCTACTCTCTAAC
+ACTCTATACCCTATCTCCTA
+ACTCTTATCCCAACTCTCAA
+TCACTAATCCCTACTCACAT
+TCTCCATTCATCTCACTTAC
+ACACATACACCCTTCTTATC
+ACACAAACACCAACCAATTC
+TCTCAAACTCTACCCTAACT
+ACTCATTCACTTCCAATCCA
+ACACTATCTCTACAAACCCA
+TCACTAACACATCTAACCCA
+TCACTTTCACTACCCATCAA
+TCTCATACACTTCCCTTCAT
+TCACATTCTCCATCACCTTT
+ACACATTCCACTACACTCAA
+TCTCATTCCTCAACACACAT
+TCACTTACTCCAACACTCTA
+ACTCAATCACACTATACCCA
+TCACAATCTCACATCCATAC
+TCACTATCACTCAACCTCAT
+TCTCTAACTCACTCAACCAT
+ACTCAAACACTCTCATCACA
+ACTCATCTACACTCATACTC
+TCACTCATTCACACACTAAC
+TAACCCTCAATCCCTTATCC
+CCAAACCACAAACCCACAAA
+CCTATCCACTATCCCTCTAA
+CCAATCCACATTCTCCCTTA
+CCATTCCACTTACTCCCAAT
+CTATCCCACTAACCCTCTTA
+TATCCCACCAATCACCCTTA
+ATTCCCACTACCCTATACCT
+AATCCCTCTACCAATACCCA
+AATCTCCCTACCCTTTCTCT
+CTTTCCTCAACCCTACAACT
+TATCCCTCATCTACCCAACA
+AAACCTCCATCCTTCTACCT
+AATCCTCCTACAACCCTACA
+CAATCCACTTCCTTCTCCTT
+ATTCCACCATCCACCCTTAT
+AAACACCCAACCCACCAATT
+ATTCACCCTTCACCTTTTCC
+CAAACCCACAACCACAATCT
+CTAACCTCTTCCTCTATCCT
+ATACCCACAACACCTATCCA
+ATTCCTCCTTCCTCAAACAC
+ATACACCCATCTCCATTCCA
+CAAACCCTCTTCTCCTACAT
+CCTAACCTCTTCACCACTAT
+TATCCTCCACTTTCCCATTC
+TTTCACCCACAATCACCCTA
+CCTAACTCTCATCCATACCA
+CCAAACTCCACTTCCTTCAT
+CCTTACACTCTTCCCTACTT
+CCATACTCTCTACCATCCTA
+CCATTCACACTACCTACCTT
+TAACCCACTCATCCCTTCTA
+TTTCCCTCTCAACCTCCAAA
+CCTTTCACTCTACTCCTTCA
+TTTCCCACCTCTTCACACTA
+CCTATCTCTCTCATCCCATT
+CCATACACACACATCTACCA
+ATTCCCTCACACAACTTCCA
+CCATTCTCACACTTCACCAT
+ATACCCTCACTCTTCTCACA
+CCAAACACTCTCACAACACA
+CCTTTCTCTCACACTCTAAC
+CTTCCCAAATCCATCCTACA
+CTACCCTTAACCCTTCACAT
+TACCCATACCCTTCTTCCTT
+ATCCCTAACTCCTACCAACA
+CCAACCAAACCACACAACTT
+AACCTACCTTCCCATCTATC
+TTCCTACCTACCCATCACAT
+TACCTACCATCTCATATCCC
+CTACATCCTACCTCTAACTC
+TACCCTACTTCCACAATCAC
+AACCCATCTACCTCAATCTC
+ATCCCATCTTCTCCTATCCT
+TTCCTTCCTACCACATTCTC
+ATCCAACCTTCCACTTACTC
+TTCCATCCATCACCCTTTCT
+TTCTTCCCAACTCCCATTCT
+AACAACCCAACACCAATCCT
+TTCTACCCTACACCTTTCCT
+ATCAACCCATCACAAACCAC
+CATCAACCAACCTCTACTAC
+TTCCCATCAACACCCAACTA
+TTCATCCCATCCTCTACCTT
+AACTACCCTTCTCCCTACAT
+ATCTTCCCTACTCCATCCAA
+CTTCTTCCCATCACCTCATT
+CTTCTACCCTTCACTCTTAC
+CATCCCAACTACACTCTCTA
+AACCTTCCAACCACTCACAA
+TACAACCCTCTTTCCCTTCA
+ATCATCCCTCTATCCAACCT
+CTACTACCTCATTCCCACAA
+AACCAACCACTTCCTTCCAA
+ATCCTACCACTACCAACCTA
+TACCTTCCTCATCCTTCACA
+AACCATCCTCAACCACCAAA
+ATCCTTCCACATCCACCATT
+TACATCCCACAACCTCTACA
+AACCCAACACCACAACCATT
+CCTTCATCTCACTTCCTTCA
+CTACCAACTCTCTACCTCAT
+CCTACTTCACACTCCTTCTT
+CCAACATCTCTCTCTACCAT
+CTACCATCACACACAACTAC
+TACCATCCACACTCTTCATC
+TACTACCCACTCACCTTCAT
+TACCCATCACTCTCTCAATC
+CTTCCTACACACACTCACTA
+TACCAACCTCACTCTCTCTA
+TTCACCCATAACCCTTACCT
+ATCTCCCAATTCCCATTCAC
+TTCTCCCTTACCACTATCTC
+TACACCCTATCCACTTCATC
+CTACTCTTCCCAAACTCCAA
+TACCTCATCCATCCTAACCT
+TTCACCATCTTCCCTTTCAC
+CTTCACTTCCATCCATCCTT
+TTCTCCTACCTTCCTACCTA
+TACTCCTTCCAACTACCCAA
+AACTCCATCCTTCTTCCTCT
+CATCACAACCAACCCACTAA
+TTCCACTTCCCTACACAATC
+ATCACCCAACATCCCTCAAA
+AACTCCCATCTTCTCTACCA
+CTTCTCATCCCATCTCACTT
+ATCCTCAACCTCATTCCCAT
+CAACACATCCACATACCACA
+CATCACATCACCATTCACCA
+TTCCTCTTCCTCAAACCACA
+TACCACTTCACCTTACTCCA
+TTCTCCTTCTCCTATCCTCA
+AACACCAACTCCATTCTCCA
+TTCCTCATCACCTTCACCTT
+TTCACCCTACTCTCAACATC
+AACACCCATCTCACACTTAC
+AACTCCTCCATCTTCCCTTT
+AACACCACATCACCTTCCTA
+CAACACCACACAACCAACTT
+ATCACACCTCTTCCACCTAA
+TTCTCTCACCAACCACTTAC
+AACACACCACACCAAACCTT
+TACACTCACCTCTTTCCCTT
+AACACTCCACTCCTCTTCAT
+ATCCTCACTCTCTCACATAC
+AACCACTCACTCACACATTC
+ATCACTCCTCTCACTCAATC
+TCCATAACCCTAACCAACCA
+TCCCTTTTCCCAATCACCTT
+TCCCAATTCCTTCCCAACAT
+ACCCTTTACCTACAACCCAA
+ACCCAAATCCTTCAACCCTA
+TCCATTACCCATCCCATCAT
+ACCCATAACCTTCCCTCATA
+ACCTTTTCCCTACCCACTTA
+TCCAAAACCCTACCTCCTAA
+ACCATATCCCTTCCTCCATA
+TCCTTATCCCAACTCCCTTT
+ACCAATACCCTTCACCTTAC
+ACCTATACCCAACCTCACTA
+ACCAATTCCCTCTATCCCAT
+ACCCTATACTCCAATCCACA
+TCCCATTACTCCTTTCCACT
+ACCCTAATCTCCTAACTCCA
+ACCTTTCTAACCCAACCAAC
+ACCAAACAATCCCAACCTCA
+TCCCTTTCAAACACCCTTCA
+TCCATTCTACCCTATCCCTT
+ACCATACTTCCCAATCACCA
+TCTTTCCTTCCCATACACCA
+TCCATTCATCCTACCCTTTC
+TCCTAACATCCCTACCTTCA
+TCCAAACTACCCATCCATCA
+TCCTAACTTCCTTCCCACTT
+ACCTATCTTCCTCCAAACCT
+TCCAATCTACTCCCAAACAC
+CTCTATCTCCCTTACTCTAC
+CACAATCTCCTAACCCTCAA
+CACATTCTCCCATACACACA
+CACATACACTTCCCAATCAC
+CACTTACTCAACCCATTCTC
+CACTTTCTCCATCTACCCTA
+CACAAACACCATCCTCCTTA
+CTCTTACACCTTCCACTAAC
+CTCAAACTCCAACACCATCA
+CTCATTCTCAACTCCACCTA
+CACTAACTCCTCTTACCACA
+CTCATACTCCACATTCCACA
+CTCTATCACCACTTACCTCT
+CACATTCACTCCAAACCTCA
+CTCTTACTCTCCATACCTCT
+CTCTAACACACCAAACTCCA
+CTCAAACACTCCTTACACCT
+CACTATCACACCTACCATCA
+CTCATTCACACATCCCTACA
+TCCTTTCTCACCAACCTTCA
+CACTTTCACCACAACTCCTA
+TCCAATCACCTCAACACAAC
+ACCTTTCACTCACATAACCC
+ACCTTACACACACCAACAAC
+TCCAAACACACTCTTCCCAA
+TCTTCCATTCTCCCTTACAC
+TCCAACCTTACCTCATCCAT
+TCCTACCTTTCTCCAACACA
+TCTTCCTACTACCCATACAC
+TCATCCATCATCCTTTCCCA
+TCAACCTTCTTCAATCCCAC
+CACTTCTACCTACCCTTCTT
+ACTACCTACCATCCACTCAA
+ACATCTTCACCCTTTACCCA
+ACCAACAACCACAATCCTCA
+TCCAACTTCCACTAACCTCT
+ACTACCATCCACTTTCACCT
+CACTACATCCTCATCCTTCA
+CACATCTTCCACATCTCCAT
+TCCTACTTCCCACTACTCTT
+TCCTACTACCTCTACCACAT
+TCCATCATCCTCTACACCAT
+TCCATCTTCTCCATCCACTT
+ACCAACATCTCCTTCACAAC
+TCCTACAACACCTTCTCATC
+ACAACCTACCTCCTTCTCAT
+ACTACTACCTCCTACTCATC
+ACCATCTACCACATCACACA
+TCTTCCAACACCAACACACA
+TCCTACATCTCTCTTTACCC
+ACATCAACACCCACTTCTCA
+TCATCCAACCTCTCTCTTCT
+ACCTTCAACCACTCACTCAA
+TCAACCCAACTCTCACTCTA
+TCTTCTCAACCCTTATCCCT
+TCAACACTTCCCTTCCACAT
+TCTTCACATCCCAACTCAAC
+TCTTCTCTACCCAACACTTC
+TCTACTCTTCCACCATTTCC
+TCATCTCAACACCCTATCAC
+TCAACTCAACTCCCATCAAC
+ACAACACTCCCTAACACTAC
+ACATCTCTCCTACCACCTTA
+ACAACCACACACCCAACATT
+TCAACTCTCTCTACCCTCTT
+ACTTCACTCCTCAACTCACA
+ACTTCTCTCCACACTAACCT
+ACTTCTCACTCCTCATTCTC
+TCTACACACCTCACATCTCA
+TCATCACACCACACTTCACT
+ACACCCAAAACCCACACATT
+ACTCTTTCCTTCCATACCAC
+TCACATACCTACCCTTCAAC
+TCTCTATCCCTACACCACAA
+ACACTAACCCATCTCCACAA
+TCCACTTTCACCTAACACCT
+TCACAAACTCCCTTTCTCCA
+TCTCTTACACCTTACCCACA
+ACTCTTACCCACTACCTATC
+CACACATTCACTACCATCCA
+ACCACAAACCACCAACATCT
+TCTCAATCTCCTACCTTCCT
+ACTCCTATCACATCCTCCAA
+ACACTTACCACCAACTCTAC
+ACACTTTCTCCCATCTCCTT
+ACTCCTTTCTCACAAATCCC
+CACACTTACACCTCTTACCT
+ACACCAATCCTCTCTTACTC
+TCTCTTTCACCACATTCACC
+CTCTCAATCTCCACTACATC
+ACCTCTTTCTCCTCAACCTT
+TCTCCAATCACACATCCCAA
+TCACCAAACTCCTCTTCACA
+ACTCCATACACCACATCACA
+CACACTTTCCACACACATAC
+TCCACATACCTCACTCTATC
+TCTCCTTACCACTCTCATTC
+ACACCTATCTCCTCTCAACT
+ACACCATTCTCCACACACTA
+TCACTACTTCACCTTTTCCC
+ACACTTCAACCTCCCTTACT
+TCACATCATCCTCCTTTCTC
+TCTCTACTTCCTCTATCCCA
+TCACTTCATCTCCAAACCCT
+ACACAACTACTCCTAACCAC
+TCACAACATCTCCTTACACC
+ACCTCTTCATCACCATCCAT
+ACTCTTCATCCCACATCCAT
+TCACTTCTTCCCACTACTTC
+ACTCTTCTTCACCCTACAAC
+ACACATCTTCTCCTTCCCTT
+ACTCTACAACCCTCTACACA
+TCTCAACATCCACCTACTCA
+TCCTCTACTACCACTCTTTC
+TCCACTACATCCTCACTACT
+TCTCATCTCACCTACACTAC
+TCACAACTCTCACTTACCCA
+ACTCAACACTCTCATTCCAC
+ACTCTACTCTCTCTACCTTC
+ACACATCACTCTCTTCTCCA
+TCACATCTCTCACACCAACA
+TCACTCAAACACCTTACCAC
+ACTCTCTACTCCATCTCTCT
+CCTTTCCTACCACCATCACA
+CCTTACCTTCCACAACTCCA
+CCTTTCCATCCCTCTCATCT
+CCATACCAACCTCACCTACA
+CCATTCCTCAACCAATCCAC
+CCTATCCTCATCCCTTCCTT
+CCATACCTCTACCCTACTAC
+CCAATCTCCAACCCTTCTAC
+CATACCACCATCCCATCTAC
+CCTAACCACTACCCTCAAAC
+CCTAACACCTACCTCCTTAC
+CTTTCCCACATCCCTCCTTT
+CTTTCCACCAACCACCATAC
+CTATCTCCCAACCCACCATA
+CCAATCACCCTACTCCACTA
+CTAACCCACCATCACCTCAA
+CCTATCACCACTATCCCACA
+CATACCCACTCATCCCATCA
+CCCAATCTCACAACCTCCTA
+CTTTCCCTCTCCTACACCTT
+CATTCCTCCCTCATCTCAAC
+CTAACACCCACTACCCACAA
+CCAAACCTCACCATCACTCA
+CTTACCCTCACTCCATACTC
+CCCATTCTCTCTCATCCCTA
+CATACCCTCTCTCCTACACA
+CTTACCCACACTCCAACTCT
+CAATCCCTCACACCTTCTCA
+CATTCCCACTCTCCACTACT
+CAATCCCACACACTCATCCA
+CTTCCCATTACCCTTCCAAC
+CAACCCAATTCCCTCCAAAC
+TTCCAACCATCCCAAACACC
+CCATCTACCATCCACTAACC
+CATCCCATCTACCCACAAAC
+CTACCCATCAACCCTCATTC
+CATCCAACCTACCACTTACC
+TTCCCAACCAACCTCATACC
+TTCAACCCTTCCCTCTTTCC
+CTACCCTACAACACCCATCA
+CCATCTTCCCTTCTCCTCAA
+CTTCAACCCATCCTCCTCTA
+CATCTTCCCTACACCACCAA
+CCTTCTACACCAAACCTCCA
+AACTTCCCACCTTCCCTATC
+CAACCTTCCACATCCACCAA
+CTTCCATCACCCTACTCCAT
+CAACAACCCTCTTCCCTCAA
+CTTCATCCCTCAACCCTCTA
+TACCCTTCCTCCATCACCAT
+CAACTTCCCTCTACCTCTCA
+AACCCTTCTCCCTTCTCTCT
+CTACCTTCTCTCCCTATCTC
+CTACCTACTCACCTATCCAC
+CTACTTCCCACTCTAACCTC
+TTCCCTACCTCACTTTCCCT
+CCAACAACCTCTCAACCTAC
+ATCCCTACTCCCTCATCATC
+CCTTCAACTCCACCTTCACT
+CATCTACCCACACCATCTCA
+CAACTACCCTCACCTACACT
+TACCCAACTCACAACCCACA
+CCTACAACCACTCCCACATA
+CATCCCTTCTCTCTCCATTC
+CCAACTACCACTCACCTTCA
+CCTTCTTCTCCTCTCCAACA
+CTTCCCTTCACACACATCCA
+CAACCATCCACTCCACTTCA
+CAACATCCCACACTCCTACA
+TACCACAACCCATCCCTCTA
+ATCCACTACCCAACCCACTT
+AACCCACAACCCACAATTCC
+TACTCCCTTCACCATACCTC
+ATCTCCCTACACCCTTCCAT
+TTCCCTCAACCACCAACTCA
+TTCCACCTTCCCTCAACACT
+TACCTCCTACCCTCTTCTCT
+TACTCCCAACACCAACCACA
+TACCCTCTACCTCCTCCAAT
+TACCCACTTCCACTCTAACC
+ATCCTCCTTCCTCACCAACT
+CTTCACTCCAATCTCCCATC
+TACCTCACAACCCTTAACCC
+ATCTCCACATCCCTTACCCT
+CAACACACCTTCCCTCTAAC
+TTCCCACTCTTCCCACCTTT
+TACCACTCTACCCTCCATAC
+TACCTCTCTTCCACCTTTCC
+ATCTCCTCATCCCACATACC
+TTCCACACTACCTCCCTACT
+TACTCACCAACCCTCAACCA
+CTACCTCACAACCTCTCCAA
+CTTCTCACCATCTCCACCAT
+TTCACCTCTCCAACCTACTC
+TTCTCTCCCACCTTCCATCT
+TTCTCACCTCCATCCCAACT
+CTTCTCTCCCACCTTCACTT
+AACCACACTCCTTCCTCCTA
+AACTCCACTCCTACTCCCAA
+CTACTCTCCTCTCTATCTCC
+ATCCTCTCACCTCATACCCT
+TTCCACTCTCTCCATTCCCT
+TACCACACACTCCATACACC
+ATCACCACTCTCCTTTCACC
+AACTCTCCACCTCTTACCTC
+TTCTCCTCCTCACCCATCTT
+CTTCTCCTCCACTCTACTCT
+TACTCTCCCTCACTACACCA
+ATCTCTCCTCCTCTACTCCA
+CTACTCCTCTCACCCTCAAT
+CTACTCCACTCACCTCTATC
+AACCTCACCTCTCCTCCTAT
+ATCACCTCACCCTCTCTATC
+TACTCCTCTCACCCTCTTAC
+ATCTCACCACTCTCCCTTAC
+CATCACACCTCACCACAACA
+CAACACTCCACACCTCATCT
+CATCTCTCCACTCTCCTTCT
+TTCCTCTCTCCCACTCATCT
+TTCTCCACCTCCACTCAACT
+TTCACCACACCACCACATCA
+CTTCCTCACACACACCACTA
+TTCCTCCTCACCTCACACAT
+TTCCTCACACCTCTCACCAA
+TACACCACCACCTCTCACTA
+AACACCTCCACCACACTCTT
+TTCACACCCTCTCACCTCTA
+ACCCTATTCCCAACCTCACA
+TCCCAAAACCCAACACCTCA
+ACCCAATACCCACTTCCCTA
+CACTATCCCTTCCACCAAAC
+ACCTATCCATCCCTCTATCC
+CACCATTCCAACACCACAAC
+CTCATTCCACCTACCACCTA
+ACCCATACACACCTTTCCAC
+ACAAACCCACCACCCAATCT
+TCTTTCCCTCACCATTCTCC
+TCTATCCCACTCCCTACCAT
+TCATTCCCTCTCCCAACTAC
+CCTCTATCACCTCCATCACT
+CACATACCTCTCCAACACCA
+TCTTACCCTCTCAACCACAC
+CCACTATCCTCTCCCTCTTT
+CACCAAACCACACCCACATT
+CTCCTTTCCTCACTCTTACC
+CACCATACCACACACTTTCC
+CTCTAACCTCCTCCCACTAT
+ACCAATCCTCACCCACATAC
+CCACATACTCCTCCTCATCA
+CCACTAACTCCTCACAACCA
+TCCAATCCACCACTCTTCCA
+ACCATACCACTCCACAACAC
+ACTTACCCACACCTCATCAC
+TCAAACCCTCACACCATCAC
+CCACAAACCTCACACACCAA
+CCACTTACACTCCCACACAA
+ACTATCCCTCCACACTCCAA
+ACTTTCCCACACACCCACTA
+TCCCATACCTCTCTCACTCA
+ACCATCAACCCTACCTCCAA
+TCCTTCTTCCCTTCACCCAA
+TCATCCTTCCCATCACACCT
+TCTACCTTCCACCCTAACTC
+TCATCCTACCACCTACCAAC
+TCAACCATCCTCCAACCATC
+TCCTTCATCCCTCATCTCCA
+TCTTCCCATCACCACTACCA
+TCATCCCTACCCACTCTCAT
+ACCAACCTACTCCACTCACA
+CACAACCACCCACAACACTT
+CTCTTCTCCACCTACTCTCT
+ACATCTCACCCTCTTCCTAC
+TCCATCTCTCCTCCACCAAT
+TCAACTCCTCCACCCTCTAT
+ACAACACCACCACACCATTC
+TCCTACTCTCACTCCAACTC
+TCTTCACCTCACCTCCAACT
+ACATCACCTCTCTCCTTCCA
+ACCTTCTCACCACCTCACAA
+ACCAACTCTCCACCACTCTA
+ACCTTCACTCCACTCCTCAT
+ACCTACTCACACCACTCCTA
+TCAACCACTCACCACACCTA
+TCAACACACCCACCTCTCAA
+ACTACTCACCCACTCTCCTA
+ACTTCACACCCTCACACCTT
+ACCACATTCCACAAACCCAC
+TCTCCAAACCTCTAACCCAC
+TCCTCTTACCCTCCAACCAT
+ACCTCTATCCTCCCTTCTTC
+TCCTCATTCCTCCATCCCTT
+TCCACTATCCACCATCCTAC
+TCACCTAACCTCTTCATCCC
+ACCTCAAACCCACATCCTCA
+ACACCTTTCCTCCTACACCT
+TCCACTAACCACCCACTACA
+TCACCATACCACCACTTCCA
+ACTCATACCCACACCAACAC
+CTCTCTTTCCCACACACTCA
+TCCACAACATCCACTCCCTA
+TCTCAACTCCCTTCTCCCAA
+TCTCTACACACCCTAACACC
+ACACTTCTCCCTCTACCCAT
+ACTCATCCTCTCCTCCTTTC
+ACACTACACCTCCCTCATAC
+ACACAACCACCCACACATCT
+TCTCTACCACCTCACTCCAT
+ACCACACTTTCCCTTATCCC
+CTATCCCTCCTTCCTTACCC
+CCCAAACTCTCCCTATCACC
+CTAACCCTCCTCATACCCAC
+CCCTATCACTCCCTTCCCAT
+CCCTATCTCTCCAACACCCA
+CCCTTACTCCTCCACCCTAT
+CCCATTCACCTCCTCTACCT
+CCCTAACACCACCTCTACAC
+CCCATACACCACTCCACTAC
+CATTCCCTCCACCTCACCTA
+CTTCCCTACTCCCATCCCAT
+CATCCCTACACCCTTCTACC
+CTTCCAACCCTCTACTACCC
+CATCCTTCCCACTTCCACCA
+TTCCCTTCCCTCCTCCCATT
+CAACCCTTCCTCTCCATCAC
+CAACCCATCTCCCACTTCAC
+CCATCATCCCACTCCCACTA
+CATCCATCCCTCACACCCTA
+CATCCTACCCTCACCACACA
+TTCCACCATCCCATCCCTCA
+AACCTCCAACCCTACCCTCA
+CAACCTCCCTTCTCCACAAC
+CATCACCTCCATCCCTACCA
+ATCCACTCCCAACCCTCCAA
+TTCCCTCTCACCCATACTCC
+CTACACACCACCCTACCTAC
+TTCACTCCCTCCCTACCATC
+CTTCCTCTCTCCCAACACAC
+CAACTCCACACCCATCCACA
+CATCACTCCTCCAACCCTCA
+AACTCACCCACCCAACTCAC
+CTTCTCCACCTCCACTATCC
+CTACCTCTCCTCCTCAACAC
+CATCCACACTCCACCTACAC
+CTACCACTCACCACCAACTC
+ATCCCACACACCTCCTTCAC
+CATCACCACCCTCCTCTCTA
+CAACTCCTCCCTCCACACTT
+CAACACCTCCTCTCACCTAC
+ATCCACCACCTCTCCTCTAC
+CAACCACTCTCCTCCACTCA
+ATCCACCTCTCCACCACTCA
+TACTCCACACCCTCCACACA
+TCCCTAACCTCCTTCCCATC
+CCACAATCCACCCACTACAC
+TCATACCCTCCCTCCTACCT
+ACATACCCACCTCCTACCCA
+CCACATTCACCCACCTCAAC
+CTCCCAAACACCCTCTCAAC
+CACCCATTCACCACTCCAAC
+CACCAATCCTCCCTCACTAC
+CTCAATCCCTCCTCCCTCAT
+ACCCTTTCCCACACTCCTAC
+ACAATCCCACCCTCACCAAC
+CACCCTTACTCCCTCTCTCA
+CACAACACCCACAACCTCCT
+CTCTTCCTCCCACTCAATCC
+ACCAACCACACCACCCATTC
+CTCTTCCACTCCCACCTACT
+CTCATCCTCCTCCCACTCAT
+CTCTTCACCTCCCACACTAC
+ACCCTTCTCCTCACCCTCAT
+TCCAACACTCCCACACCTAC
+TCTTCTCCACACCCTCCCTA
+CTCATCTCCTCCTCACCTCA
+ACCTCTAACCCACCCTTCCA
+TCCTCAATCCCACCCACCTA
+ACCACTTACCCACCACCTAC
+ACACCAACCCACCAATCTCC
+TCTCCCTTCCCTCAACCCAT
+CACTCTTCCACCCTCCTACT
+CTCCTCTACCCTCTCCTCTT
+ACACTACTCCCTCACCCACA
+CTACCCTCCTTCCCATCCCA
+CTACCACCCTTCCTCCCTAC
+CATCCACTCCACCCATCCAC
+CAACTCACCCACCTCCCAAC
+CCAACTCACCACCCTCACCA
+CTACACTCCCTCTCCCACCA
+CTACTCACCACCACCTCCCA
+CTCCTATCCACCATCCCACC
+CACATTCCCTCCACCCAACC
+TCCATACCCACCTCCACCCA
+CACCAACCCACTCCTCAACC
+TCTACACCTCCCACCCTACC
+TCCACCAACCCTCCCAACCA
+TCCTCCTTCACCCACCCAAC
+CTCTCTCTCCCTACCCATCC"
\ No newline at end of file
diff --git a/ClassicDSD/ClassicDSDDotNet/domain.fs b/ClassicDSD/ClassicDSDDotNet/domain.fs
new file mode 100644
index 0000000..2866db5
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/domain.fs
@@ -0,0 +1,551 @@
+[]
+module Microsoft.Research.DNA.Domain
+open Microsoft.Research.DNA
+
+module Lib = Microsoft.Research.CRNEngine.Lib
+module Prim = Microsoft.Research.CRNEngine.Expression
+module Stringmap = Microsoft.Research.CRNEngine.Stringmap
+module Hashtable = Microsoft.Research.CRNEngine.Hashtable
+
+type prim = Microsoft.Research.CRNEngine.Expression.t
+
+(* A domain is the basic building block of a DNA sequence *)
+type value = Value.t
+type value_env = Value.t_env
+type match_env = (string * bool) Stringmap.t
+type tag = string * float
+type tether = (tag list * int) option
+type t =
+ | Toe of value*value*bool*tether
+ | Normal of value*bool*tether
+
+(* Mapping list of domains to the domain they become when concatenated *)
+type sub_map = Microsoft.Research.CRNEngine.Hashtable.t
+
+(* Complement a domain. *)
+let complement = function Toe(v,r,cmp,teth) -> Toe(v,r,(not cmp),teth) | Normal(v,cmp,teth) -> Normal(v,(not cmp),teth)
+
+(* Put a "star" onto a domain. *)
+let star = function Toe(v,r,_,teth) -> Toe(v,r,true,teth) | Normal(v,_,teth) -> Normal(v,true,teth)
+
+(* Remove any "star" from a domain. *)
+let unstar = function Toe(v,r,_,teth) -> Toe(v,r,false,teth) | Normal(v,_,teth) -> Normal(v,false,teth)
+
+let get_value = function Toe(v,_,_,_) | Normal(v,_,_) -> v
+
+(* Is a given domain complemented? *)
+let is_complemented = function Toe(_,_,cmp,_) | Normal(_,cmp,_) -> cmp
+
+(* Is a given domain tethered to an origami?*)
+let is_tethered = function Toe(_,_,_,Some (_,i)) | Normal(_,_,Some (_,i)) -> true (*i > -2*) | _ -> false
+
+let get_tags = function
+ | Toe(_,_,_,Some (t, _))
+ | Normal(_,_,Some (t, _)) -> Some t
+ | _ -> None
+
+let get_tethered_tags = function
+ | Toe(_,_,_,Some(t,n))
+ | Normal(_,_,Some(t,n)) when n >= 0 -> Some t
+ | _ -> None
+
+let tags_intersect to1 to2 =
+ match to1, to2 with
+ | Some t1, Some t2 -> Some (Lib.intersection (=) t1 t2)
+ | _ -> None
+
+let rec tags_in_common_list = function
+ | [] -> None
+ | [d] -> get_tags d
+ | d::ds -> tags_intersect (get_tags d) (tags_in_common_list ds)
+
+let all_gotten_tags_list get l =
+ let combine a b =
+ match a, get b with
+ | Some la, Some lb -> Some (Lib.union (=) la lb)
+ | Some l, None | None, Some l -> Some l
+ | _ -> None in
+ Lib.fold_left combine None l
+
+let all_tags_list l = all_gotten_tags_list get_tags l
+
+let all_tethered_tags_list l = all_gotten_tags_list get_tethered_tags l
+
+let set_tags ts d =
+ match d, ts with
+ | Toe (v,r,c,Some (_,-2)), None -> Toe (v,r,c,None)
+ | Toe (v,r,c,Some (_,-2)), Some tags -> Toe (v,r,c, Some (tags,-2))
+ | Toe (v,r,c,None), Some tags -> Toe (v,r,c,Some (tags,-2))
+ | Normal (v,c,Some (_,-2)), None -> Normal (v,c,None)
+ | Normal (v,c,Some (_,-2)), Some tags -> Normal (v,c,Some (tags,-2))
+ | Normal (v,c,None), Some tags -> Normal (v,c,Some (tags,-2))
+ | _ -> d
+
+let set_tags_list ts l = List.map (set_tags ts) l
+
+let add_tags ts d =
+ match d, ts with
+ | _, None -> d
+ | Toe (v,r,c,None), Some tags -> Toe (v,r,c,Some (tags,-2))
+ | Normal (v,c,None), Some tags -> Normal (v,c,Some (tags,-2))
+ | Toe (v,r,c,Some (ts1,-2)), Some tags -> Toe (v,r,c,Some (Lib.union (=) ts1 tags,-2))
+ | Normal (v,c,Some (ts1,-2)), Some tags -> Normal (v,c,Some (Lib.union (=) ts1 tags,-2))
+ | _ -> d
+
+let add_tags_list ts l = List.map (add_tags ts) l
+
+(* Given two domains, are they the complements of each other? *)
+(*AP relaxed the constraint that degree of complementarity should be the same *)
+let are_complements (d1:t) (d2:t) =
+ match d1,d2 with
+ | Toe(v1,_,cmp1,_), Toe(v2,_,cmp2,_) -> (v1=v2) (*&& (r1=r2)*) && ((not cmp1)=cmp2)
+ | Normal(v1,cmp1,_), Normal(v2,cmp2,_) -> (v1=v2) && ((not cmp1)=cmp2)
+ | _,_ -> false
+
+(* Update the tether of a domain *)
+let update_tether (d:t) (teth:tether) =
+ match d with
+ | Toe(v,r,cmp,_) -> Toe(v,r,cmp,teth)
+ | Normal(v,cmp,_) -> Normal(v,cmp,teth)
+
+(* Given two domains, "stick" them together without losing the relevant anchor information *)
+(* AP: Assumes that domains are complementary, though this is not checked here *)
+let stick (d1:t) (d2:t) =
+ let bond_tethers (t1:tether) (t2:tether) =
+ match t1,t2 with
+ | Some(t1,i1),Some(_,i2) -> Some(t1,Operators.min i1 i2) (* RLP: This should probably not happen, if we use the convention of a special "tether" domain *)
+ | Some i1,None -> Some i1
+ | None,Some i1 -> Some i1
+ | _ -> None
+ in
+ match d1,d2 with (* Assumes d1 and d2 are identical apart from their tether and degree of complementarity *)
+ (* Retain degree of complementarity from complementary strand. Seems to require the first domain to be used. *)
+ | Toe(n1,_,c1,teth1),Toe(_,r2,c2,teth2) -> update_tether (if c2 then (Toe(n1,r2,c1,teth1)) else d1) (bond_tethers teth1 teth2)
+ (*| Toe(_,_,_,teth1),Toe(_,_,_,teth2)*)
+ | Normal(_,_,teth1),Normal(_,_,teth2) -> update_tether d1 (bond_tethers teth1 teth2)
+ | _ -> d1
+
+(*Given one 'bonded' domain, unstick into two with appropriate tethers and complements*)
+let unstick (d:t) =
+ match d with
+ | Toe(n,r,c,teth) -> (* AP: Keep the degree of complementarity only on the complementary toehold *)
+ if c then d,Toe(n,Value.Float (1.0, None),not c,teth) else Toe(n,Value.Float (1.0, None),c,teth),Toe(n,r,not c,teth)
+ (*| Toe(_,_,_,teth) *)
+ | Normal _ -> d, complement d
+let unstick_list (ds:t list) = List.unzip (List.map unstick ds)
+
+(* Same as unstick, but keeps the degree of complementarity; used for SVG rendering purposes *)
+let unstick_keep_doc (d:t) =
+ match d with
+ | Toe(n,r,c,teth) ->
+ if c then d,Toe(n,r,not c,teth) else Toe(n,r,c,teth),Toe(n,r,not c,teth)
+ | Normal _ -> d, complement d
+let unstick_keep_doc_list (ds:t list) = List.unzip (List.map unstick_keep_doc ds)
+
+(* Check two domains for equality, ignoring whether or not they're tethered *)
+let equal (d1:t) (d2:t) =
+ match d1,d2 with
+ | Toe(v1,r1,cmp1,_), Toe(v2,r2,cmp2,_) -> (v1 = v2) && (r1=r2) && (cmp1=cmp2)
+ | Normal(v1,cmp1,_), Normal(v2,cmp2,_) -> (v1 = v2) && (cmp1=cmp2)
+ | _ -> false
+
+(* Determine if d1 is less than d2 :
+ all Toeholds are less than all Normal domains
+ Note: may be better to lexicographically sort based on the nucleotides *)
+let compare (d1:t) (d2:t) =
+ match d1,d2 with
+ | Toe _,Normal _ -> -1
+ | Normal _, Toe _ -> 1
+ | Toe(v1,_,c1,_), Toe(v2,_,c2,_)
+ | Normal(v1,c1,_), Normal(v2,c2,_) ->
+ let lex = compare (Value.to_string v1) (Value.to_string v2)
+ if lex=0 then
+ if c1 && c2 then 0
+ else if c1 then 1 else -1
+ else
+ lex
+
+(*Compare two lists of domains *)
+let compare_domains l1 l2 =
+ let len1, len2 = List.length l1, List.length l2 in
+ if len1 < len2 then -1
+ else if (len1 = len2)
+ then Lib.fold_right (fun (d1,d2) eq -> if eq=0 then compare d1 d2 else eq) (Lib.zip l1 l2) 0
+ else 1
+
+let display_doc = function
+ | Value.Float (1.0,_) -> ""
+ | Value.Int (1,_) -> ""
+ | v -> "(" + Value.to_string v + ")"
+
+let display_doc_picture = function
+ | Value.Float (1.0,_) -> ""
+ | Value.Int (1,_) -> ""
+ | v -> Value.to_string v
+
+(* Display a domain, ignoring tethering *)
+let display_bare_domain (n:t) =
+ match n with
+ | Toe(v,r,cmp,_) -> Value.to_string v + "^" + (display_doc r) + (if cmp then "*" else "")
+ | Normal(v,cmp,_) -> Value.to_string v + (if cmp then "*" else "")
+
+let display_tag = function
+ | (s, 1.0) -> s
+ | (s,f) -> "(" + s + "," + Lib.display_float f + ")"
+
+let display_tether = function
+ | None -> ""
+ | Some (ts,_) -> "(" + String.concat ", " (List.map display_tag ts) + ")"
+
+(* Display a domain for a picture (no details), showing a tether only when 'teth' is on. *)
+let display_picture (n:t) (teth :bool) =
+ match n with
+ | Normal(Value.Domain ("tether",_,_,_,_),false,teth) -> (*"tether" +*) display_tether teth
+ | Toe(v,r,cmp,mt) -> (if teth && Option.isSome mt then "!" else "") + Value.to_string v + (if cmp then "*" + (display_doc_picture r) else "") (* N^c *)
+ | Normal(v,cmp,mt) -> (if teth && Option.isSome mt then "!" else "") + Value.to_string v + (if cmp then "*" else "") (* N *)
+
+(* Returns the length in characters of the domain, as if it was complemented. *)
+let display_length (n:t) =
+ match n with
+ | Normal(Value.Domain ("tether",_,_,_,_),false,teth) -> display_tether teth
+ | Toe(v,r,cmp,mt) -> (if Option.isSome mt then "!" else "") + Value.to_string v + (display_doc_picture r)
+ | Normal(v,cmp,mt) -> (if Option.isSome mt then "!" else "") + Value.to_string v
+ |> String.length
+
+let display_tether_debug = function
+ | None -> ""
+ | Some (ts,i) -> "!<" + string i + ">(" + Lib.string_of_list display_tag "," ts + ")"
+
+(* String representation of a domain (with details). *)
+let display (n:t) =
+ match n with
+ | Normal(Value.Variable ("tether",_),false,teth)
+ | Normal(Value.Domain ("tether",_,_,_,_),false,teth) -> "tether" + display_tether teth
+ | Toe(v,r,cmp,teth) -> display_tether teth + Value.to_string v + "^" + (display_doc r)(* N^c *) + (if cmp then "*" else "")
+ | Normal(v,cmp,teth) -> display_tether teth + Value.to_string v + (if cmp then "*" else "") (* N *)
+
+(* String representation of a sequence of domains. *)
+let rec display_sequence (ns:t list) =
+ match ns with
+ | [] -> "_"
+ | [n] -> display n
+ | n::ns -> display n + " " + display_sequence ns
+
+let eval_tag (env:value_env) (t:tag) =
+ let n, f = t
+ match Value.Variable (n, Types.emprange) |> Value.eval env with
+ | Value.Domain (tag,_,_,_,_) -> tag, f
+ | _ -> n, f
+
+let eval_tether (env:value_env) (t:tether) =
+ match t with
+ | None -> None
+ | Some (ts, i) -> (ts |> List.map (eval_tag env), i) |> Some
+
+(* evaluate the values in a domain*)
+let eval (env:value_env) (n:t) =
+ match n with
+ | Toe(v,r,cmp,teth) -> Toe ((Value.eval env v),(Value.eval env r),cmp,teth |> eval_tether env)
+ | Normal(v,cmp,teth) -> Normal((Value.eval env v),cmp,teth |> eval_tether env)
+
+(* evaluate the values in a sequence of domains *)
+let eval_sequence (env:value_env) (ns:t list) = List.map (eval env) ns
+
+(* Compute binding rate of a domain. *)
+let bind_rate (n:t) =
+ match n with
+ | Toe(v,deg,_,_) -> Value.bind_rate v deg
+ | Normal(v,_,_) -> Value.bind_rate v (Value.Float (1.0, None))
+
+let localize_bind_rate (n:t) lc =
+ match n with
+ | Toe(Value.Domain(s,i,r,v,a),deg,b,c) -> Toe(Value.Domain(s,i,Prim.mul lc r,v,a),deg,b,c)
+ | Toe(Value.DomainS(s,i,seq,r,v,a),deg,b,c) -> Toe(Value.DomainS(s,i,seq,Prim.mul lc r,v,a),deg,b,c)
+ | Normal(Value.Domain(s,i,r,v,a),b,c) -> Normal(Value.Domain(s,i,Prim.mul lc r,v,a),b,c)
+ | Normal(Value.DomainS(s,i,seq,r,v,a),b,c) -> Normal(Value.DomainS(s,i,seq,Prim.mul lc r,v,a),b,c)
+ | _ -> failwith "expected domain value"
+
+(* Compute unbinding rate of a domain. *)
+let unbind_rate (n:t) =
+ match n with
+ | Toe(v,_,_,_) -> Value.unbind_rate v
+ | Normal(v,_,_) -> Value.unbind_rate v
+
+(* Compute free names of a domain. *)
+let free_names (n:t) =
+ match n with
+ | Toe(v,r,_,_) -> (Value.free_names r) @ Value.free_names v
+ | Normal(v,_,_) -> Value.free_names v
+
+let inferType_doc env v =
+ let t = Value.inferType env v in
+ match !t with
+ | Types.FloatT _ -> ()
+ | Types.BottomT -> t:= Types.FloatT (Value.get_range v)
+ | t -> let descr = "degree of complementarity " + (Value.to_string v) in
+ Errors.type_error (Value.get_range v) (Errors.WrongType(t,[Types.FloatT(Types.emprange)],descr))
+
+(* Infer/check type of a domain, including checking toe usage
+ May modify ref cells in the enviornment
+*)
+let inferType in_origami (env:Types.type_env) (n:t) =
+ (match n with Toe(_,r,_,_) -> inferType_doc env r | _ -> ());
+ let v = match n with Toe(v,_,_,_) | Normal(v,_,_) -> v in
+ let not_in_origami = match in_origami with Some false -> true | _ -> false in
+ if ((not_in_origami) && is_tethered n)
+ then Errors.type_error (Value.get_range v) (Errors.TetheredOutside (display n))
+ else
+ let t = Value.inferType env v in
+ match (!t,n) with
+ | (Types.DomainT(Some(true),_),Normal _ ) | (Types.DomainT(Some(false),_),Toe _) -> () (*Checks pass*)
+ | (Types.DomainT(None,_), Normal _) | Types.BottomT,Normal _ -> t:= Types.DomainT(Some(true),Value.get_range(v))
+ | (Types.DomainT(None,_), Toe _) | Types.BottomT,Toe _ -> t:= Types.DomainT(Some(false),Value.get_range(v))
+ | (Types.DomainT(Some(false),r), Normal _) -> Errors.type_error (Value.get_range(v)) (Errors.ToeInconsistent(r,false))
+ | (Types.DomainT(Some(true),r), Toe _) -> Errors.type_error (Value.get_range(v)) (Errors.ToeInconsistent(r,true))
+ | (t, Normal _) ->
+ let descr = "domain " + (display n)
+ Errors.type_error (Value.get_range v) (Errors.WrongType(t,[Types.DomainT(Some(true),Types.emprange)],descr))
+ | (t, Toe _) ->
+ let descr = "domain " + (display n)
+ Errors.type_error (Value.get_range v) (Errors.WrongType(t,[Types.DomainT(Some(false),Types.emprange)],descr))
+
+(* Get the position of this domain, for error messages *)
+let getPosn = function | Toe(v,_,_,_) | Normal(v,_,_) -> Value.get_range v
+
+(* Reset all positions (needed so positions are irrelevant in simulator etc). *)
+let erasePosns = function
+ | Toe(v,r,cmp,teth) -> Toe(Value.erasePosns v, Value.erasePosns r, cmp,teth)
+ | Normal(v,cmp,teth) -> Normal(Value.erasePosns v, cmp,teth)
+
+(* This allows us to track position data through module instantiations etc. *)
+let replacePosns (mrs:Types.range Stringmap.t) = function
+ | Toe(v,r,cmp,teth) -> Toe(Value.replacePosns mrs v, Value.replacePosns mrs r, cmp,teth)
+ | Normal(v,cmp,teth) -> Normal(Value.replacePosns mrs v, cmp,teth)
+
+(* Find out the length of a domain (from the supplied defaults). *)
+let length (toehold_length:int) (specificity_length:int) = function
+ | Toe(Value.DomainS(_,_,s,_,_,_),_,_,_) | Normal(Value.DomainS(_,_,s,_,_,_),_,_) -> String.length s
+ | Toe _ -> toehold_length
+ | Normal _ -> specificity_length
+
+(* Does domain d' match the "pattern" d? *)
+let matches d d' =
+ match (d,d') with
+ | (Normal(Value.Variable("_",_),_,_), _) -> true (* Always match against an underscore wildcard. *)
+ | (Toe(Value.Variable(x,_),_,cmp,_), Toe(Value.Domain(x',_,_,_,_),_,cmp',_)) (* Ignore the counters on domains and require that complements match. *)
+ | (Toe(Value.Variable(x,_),_,cmp,_), Toe(Value.DomainS(x',_,_,_,_,_),_,cmp',_))
+ | (Normal(Value.Variable(x,_),cmp,_), Normal(Value.Domain(x',_,_,_,_),cmp',_))
+ | (Normal(Value.Variable(x,_),cmp,_), Normal(Value.DomainS(x',_,_,_,_,_),cmp',_)) -> x=x' && cmp=cmp'
+ | (Normal(Value.Domain(x,-1,_,_,_),cmp,_), Normal(Value.Domain(x',_,_,_,_),cmp',_)) | (* These cases occur when plotted species came from a module *)
+ (Normal(Value.DomainS(x,-1,_,_,_,_),cmp,_), Normal(Value.DomainS(x',_,_,_,_,_),cmp',_)) |
+ (Toe(Value.Domain(x,-1,_,_,_),_,cmp,_), Toe(Value.Domain(x',_,_,_,_),_,cmp',_)) |
+ (Toe(Value.DomainS(x,-1,_,_,_,_),_,cmp,_), Toe(Value.DomainS(x',_,_,_,_,_),_,cmp',_)) -> x=x' && cmp=cmp'
+ | (Normal(Value.Domain(x,i,_,_,_),cmp,_), Normal(Value.Domain(x',i',_,_,_),cmp',_)) | (* These cases occur when plotted species came from a module *)
+ (Normal(Value.DomainS(x,i,_,_,_,_),cmp,_), Normal(Value.DomainS(x',i',_,_,_,_),cmp',_)) |
+ (Toe(Value.Domain(x,i,_,_,_),_,cmp,_), Toe(Value.Domain(x',i',_,_,_),_,cmp',_)) |
+ (Toe(Value.DomainS(x,i,_,_,_,_),_,cmp,_), Toe(Value.DomainS(x',i',_,_,_,_),_,cmp',_)) -> x=x' && i=i' && cmp=cmp'
+ (* The "closing" code and int->variable conversion in the parser mean that all other possibilities shouldn't match. *)
+ | (_,_) -> false
+
+(* Does the list of domains ns' match the "pattern" ns? *)
+let matches_list ns ns' = Lib.forall2 matches ns ns'
+
+let matches_env env d d' =
+ match d, d' with
+ | (Toe(Value.Variable(x,_),_,cmp,_), Toe(Value.Domain(x',_,_,_,_),_,cmp',_))
+ | (Toe(Value.Variable(x,_),_,cmp,_), Toe(Value.DomainS(x',_,_,_,_,_),_,cmp',_))
+ | (Normal(Value.Variable(x,_),cmp,_), Normal(Value.Domain(x',_,_,_,_),cmp',_))
+ | (Normal(Value.Variable(x,_),cmp,_), Normal(Value.DomainS(x',_,_,_,_,_),cmp',_)) ->
+ (match Stringmap.tryFind x env with
+ | None -> Some (Stringmap.add x (x', cmp <> cmp') env)
+ | Some (y,c) -> if y=x' && ((cmp <> c) = cmp') then Some env else None
+ )
+ | (Toe(Value.Variable(x,_),_,cmp,_), Toe(Value.Variable(x',_),_,cmp',_)) ->
+ if x=x' && cmp=cmp' then Some env else None
+ | _ -> if matches d d' then Some env else None
+
+let rec matches_list_env env xs ys = Lib.option_and2 matches_env env xs ys
+
+let is_wildcard = function
+ | Normal(Value.Variable("_",_),_,_) -> true
+ | _ -> false
+
+(* Is a domain a toehold? *)
+let is_toehold = function Toe _ -> true | _ -> false
+
+(* Does a given domain list contain a toehold? *)
+let contains_toehold (ds:t list) = List.exists is_toehold ds
+
+(* Does a given domain list contain the given domain *)
+let contains_domain (d : t) (ds: t list) = List.exists (fun d' -> d = d') ds
+
+let tags_in_common m n = tags_in_common_list [m; n] <> Some []
+
+(*
+(* Find all complementary toehold matches between a pair of domain lists. Also return the surrounding contexts. *)
+(* The returned domains are annotated with the intersection of their tags *)
+let matching_toeholds (ns:t list) (ms:t list) : ((t list * (t * t list option) * t list) * (t list * (t * t list option) * t list)) list =
+ let rec loop acc nsl nsr = match nsr with
+ | [] -> acc
+ | ((Normal(_,_,_)) as n)::nsr -> loop acc (nsl@[n]) nsr
+ | ((Toe(_,_,_,_)) as n)::nsr ->
+ let rec find acc' msl msr = match msr with
+ | [] -> acc'
+ | ((Normal(_,_,_)) as m)::msr -> find acc' (msl@[m]) msr
+ | ((Toe(_,_,_,_)) as m)::msr ->
+ if (are_complements m n) && tags_in_common m n
+ then find (acc'@[msl, m, msr]) (msl@[m]) msr
+ else find acc' (msl@[m]) msr
+ in
+ let acc' =
+ List.map
+ (fun (msl,m,msr) ->
+ let tags = tags_in_common_list [m; n] in
+ (nsl,set_tags tags n,nsr),(msl,set_tags tags m,msr)
+ )
+ (find [] [] ms) in
+ loop (acc@acc') (nsl@[n]) nsr
+ in
+ loop [] [] ns
+*)
+
+let get_name d =
+ match get_value d with
+ | Value.Domain (s, _, _, _, _)
+ | Value.DomainS (s, _, _, _, _, _) -> s + (if is_complemented d then "*" else "")
+ | v -> Value.to_string v
+
+let to_string d =
+ (match get_value d with
+ | Value.Domain (s, _, _, _, _)
+ | Value.DomainS (s, _, _, _, _, _) -> s
+ | v -> (Value.to_string v))
+ + (if is_complemented d then "*" else "")
+
+let get_sequence d =
+ match get_value d with
+ | Value.Domain (_, _, _, _, _) -> ""
+ | Value.DomainS (_, _, s, _, _, _) -> s
+ | _ -> ""
+
+(*
+let sub_map = Hashtable.empty ()
+let _ = Hashtable.add sub_map ["x"; "y"] (Toe (Value.Domain ("sup", 0, BMEValue.Float 42.003, BMEValue.Float 3.0042, Types.emprange),
+ Value.Float (1.0, Types.emprange),
+ false,
+ None))
+*)
+
+let get_sublists_ctx l =
+ let a = Array.ofList l in
+ let n = Array.length a in
+ let subs ln =
+ let res = ref [] in
+ for i = 0 to n-ln do
+ res := (Array.sub a 0 i, Array.sub a i ln, Array.sub a (i+ln) (n-ln-i))::!res
+ done;
+ Lib.rev_map (fun (l,m,r) -> (Array.toList l, Array.toList m, Array.toList r)) !res in
+ let res = ref [] in
+ for ln = 1 to n do
+ res := subs ln :: !res
+ done;
+ !res
+
+let search_sublists_ctx f l =
+ let rec loop = function
+ | [] -> []
+ | n::ns ->
+ (match List.collect f n with
+ | [] -> loop ns
+ | r -> r) in
+ loop (get_sublists_ctx l)
+
+(* Find all complementary toehold matches between a pair of domain lists. Also return the surrounding contexts. *)
+(* ns should be part of an upper strand and ms should be part of a lower strand. *)
+let matching_toeholds sub_map (ns:t list) (ms:t list) : ((t list * (t * t list option) * t list) * (t list * (t * t list option) * t list)) list =
+ let get_comp_prefix ns ms =
+ let rec loop acc = function
+ | [], ms -> [List.rev acc, ms]
+ | _, [] -> []
+ | (n::ns), (m::ms) ->
+ if are_complements n m && tags_in_common m n
+ then loop (m::acc) (ns, ms)
+ else [] in
+ loop [] (ns, ms) in
+ let find (d: t) ns =
+ let rec loop acc msl msr = (* quadratic for now *)
+ match msr with
+ | [] -> acc
+ | ((Normal _) as m)::msr' -> loop acc (m::msl) msr'
+ | ((Toe _) as m)::msr' ->
+ let tls = get_comp_prefix ns msr in
+ let acc' =
+ List.map
+ (fun (found,tl) ->
+ let d_comp = match found with [m] -> m, None | _ -> complement d, Some found in
+ (List.rev msl, d_comp, tl))
+ tls in
+ loop (acc@acc') (m::msl) msr' in
+ loop [] [] ms in
+ let rec loop acc record nsl nsr =
+ let expand_finds pre post (d: t, dl: t list option) fs =
+ List.map
+ (fun (msl: t list,(m,ml): t*t list option,msr: t list) ->
+ let tags = tags_in_common_list [m; d]
+ (nsl@pre,(set_tags tags d, dl),post@nsr),(msl,(set_tags tags m, ml),msr))
+ fs in
+ let search_record = function
+ | (pre, [d], post) -> expand_finds pre post (d, None) (find d [d])
+ | (pre, r, post) ->
+ let r_names = List.map get_name r in
+ let r_rot_names = List.map get_name (Lib.rev_map complement r) in
+ (match Lib.option_or (List.map (Hashtable.tryFind sub_map) [r_names; r_rot_names]) with
+ | None -> []
+ | Some sup_d ->
+ (match find sup_d r with
+ | [] -> []
+ | cs -> expand_finds pre post (sup_d, Some r) cs
+ )
+ ) in
+ match nsr with
+ | [] -> search_sublists_ctx search_record (List.rev record) @ acc
+ | ((Toe _) as n)::nsr -> loop acc (n::record) nsl nsr
+ | ((Normal _) as n)::nsr ->
+ let toes = List.rev record in
+ let acc = search_sublists_ctx search_record toes @ acc in
+ loop acc [] (nsl@toes@[n]) nsr
+ in
+ loop [] [] [] ns
+
+(* Find a pair of neighbouring toeholds in a domain list. *)
+let neighbouring_toeholds (ns:t list) =
+ let rec loop ns =
+ match ns with
+ | [] -> None
+ | [_] -> None
+ | n1::n2::ns -> if (is_toehold n1) && (is_toehold n2) then Some(n1,n2) else loop (n2::ns)
+ in
+ loop ns
+
+(* Finds complemented toe holds on the same strand, and divides the strand into pre toe middle toe* post, for each pair *)
+let internal_complements (ns: t list) =
+ let rec matchings (pre :t list) t acc ns =
+ match ns with
+ | [] -> []
+ | (Toe _ as tc)::ns -> if (are_complements t tc)
+ then (List.rev pre,t,List.rev acc,tc,ns)::(matchings pre t (tc::acc) ns)
+ else matchings pre t (tc::acc) ns
+ | n::ns -> matchings pre t (n::acc) ns
+ in
+ let rec collect_toes ns pre_acc =
+ match ns with
+ | [] -> []
+ | (Toe _ as t)::ns -> (pre_acc,t,ns)::(collect_toes ns (t::pre_acc))
+ | n::ns -> collect_toes ns (n::pre_acc)
+ in Lib.fold_left (fun l a -> a@l) []
+ (List.map (fun (p,t,ns) -> matchings p t [] ns) (collect_toes ns []))
+
+(******************************************************************************)
+let universal_counters = function
+ | Toe(v,r,cmp,teth) -> Toe(Value.universal_counters v, Value.universal_counters r, cmp,teth)
+ | Normal(v,cmp,teth) -> Normal(Value.universal_counters v, cmp,teth)
diff --git a/ClassicDSD/ClassicDSDDotNet/domain.fsi b/ClassicDSD/ClassicDSDDotNet/domain.fsi
new file mode 100644
index 0000000..f411be1
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/domain.fsi
@@ -0,0 +1,70 @@
+module Microsoft.Research.DNA.Domain
+open Microsoft.Research.DNA
+
+module Stringmap = Microsoft.Research.CRNEngine.Stringmap
+type prim = Microsoft.Research.CRNEngine.Expression.t
+
+type value = Value.t
+type value_env = Value.t_env
+type match_env = (string * bool) Stringmap.t
+type tag = string * float
+type tether = (tag list * int) option
+type t =
+ | Toe of value*value*bool*tether
+ | Normal of value*bool*tether
+type sub_map = Microsoft.Research.CRNEngine.Hashtable.t
+
+val complement : t -> t
+val star : t -> t
+val unstar : t -> t
+val get_value : t -> value
+val is_complemented : t -> bool
+val are_complements : t -> t -> bool
+val is_tethered : t -> bool
+val tags_in_common_list : t list -> tag list option
+val all_tags_list : t list -> tag list option
+val all_tethered_tags_list : t list -> tag list option
+val get_tags : t -> tag list option
+val set_tags : tag list option -> t -> t
+val set_tags_list : tag list option -> t list -> t list
+val add_tags_list : tag list option -> t list -> t list
+val update_tether : t -> tether -> t
+val stick : t -> t -> t
+val unstick : t -> t*t
+val unstick_list : t list -> t list * t list
+val unstick_keep_doc : t -> t*t
+val unstick_keep_doc_list : t list -> t list * t list
+val display_bare_domain : t -> string
+val display_picture : t -> bool -> string
+val display_length : t -> int
+val display : t -> string
+val display_sequence : t list -> string
+val eval : value_env -> t -> t
+val eval_sequence : value_env -> t list -> t list
+val bind_rate : t -> prim
+val localize_bind_rate : t -> prim -> t
+val unbind_rate : t -> prim
+val free_names : t -> (Value.name * Value.range) list
+val inferType : bool option -> Types.type_env -> t -> unit
+val getPosn : t -> Types.range
+val erasePosns : t -> t
+val replacePosns : Types.range Stringmap.t -> t -> t
+val length : int -> int -> t -> int
+val equal : t -> t -> bool
+val compare : t -> t -> int
+val compare_domains : t list -> t list -> int
+val matches : t -> t -> bool
+val matches_list : t list -> t list -> bool
+val matches_list_env : match_env -> t list -> t list -> match_env option
+val is_wildcard : t -> bool
+val is_toehold : t -> bool
+val contains_toehold : t list -> bool
+val get_name : t -> string
+val get_sequence : t -> string
+val to_string : t -> string
+val matching_toeholds : sub_map -> t list -> t list -> ((t list * (t * t list option) * t list) * (t list * (t * t list option) * t list)) list
+val neighbouring_toeholds : t list -> (t * t) option
+val internal_complements : t list -> (t list * t * t list * t * t list) list
+
+(******************************************************************************)
+val universal_counters : t -> t
diff --git a/ClassicDSD/ClassicDSDDotNet/dsd.fs b/ClassicDSD/ClassicDSDDotNet/dsd.fs
new file mode 100644
index 0000000..8c32726
--- /dev/null
+++ b/ClassicDSD/ClassicDSDDotNet/dsd.fs
@@ -0,0 +1,1242 @@
+[]
+module Microsoft.Research.DNA.Dsd
+open Microsoft.Research.DNA
+open Microsoft.Research.CRNEngine
+open RulesDSD.Syntax
+open RulesDSD.ProcessEquality
+open Microsoft.Research.DNA.LogicDSD
+
+type value = Expression.t
+type expression = Expression.t>
+type syntax = Syntax.t
+
+type dom_colour =
+ { domain : string
+ ; colour : string }
+
+type metadata =
+ { meta : Sequence.mapping
+ ; info : Species.t_env
+ ; domain_colours : Hashtable.t
+ ; subdomains : Hashtable.t }
+
+let empty_meta =
+ let opts = Options.default_options in
+ { meta = Sequence.initialise_mapping opts
+ ; info = Species.empty_env 0
+ ; domain_colours = Hashtable.empty ()
+ ; subdomains = Hashtable.empty () }
+
+type term = Crn
+type populations = Populations
+type reaction = Reaction
+type pop_info = Population
+type event = Event
+
+let cle = Microsoft.Research.DNA.LogicDSD.engine
+let cle' = { cle with ComposeProcesses = Microsoft.Research.DNA.LogicDSD.logicDsdComposeProcesses true }
+
+let build_meta opts info env dom_env species =
+ let subdomains = Hashtable.empty () in
+ let dom_cols = Hashtable.empty () in
+ let find n toe =
+ List.pick
+ (function
+ | (Value.Sys(s, d)) ->
+ if s=n then
+ if toe then Some (Domain.Toe (d, Domain.value.Float (1.0, Types.emprange), false, None))
+ else Some (Domain.Normal (d, false, None))
+ else None
+ | _ -> None) env in
+ let collect (d: Syntax.dom_assignment) =
+ (match d.dom_colour with Some c -> Hashtable.add dom_cols d.domain c | None -> ());
+ (match d.subdomains with Some (ds,toe) -> Hashtable.add subdomains ds (find d.domain toe) | None -> ()) in
+ List.iter collect dom_env;
+ let domains = species |> List.collect Species.domains
+ { info = info
+ ; meta = Sequence.add_domains (Sequence.initialise_mapping opts) domains
+ ; domain_colours = dom_cols
+ ; subdomains = subdomains }
+
+let default_namer (opts:Options.t) (species_env:Species.t_env) : (Species.t -> string) =
+ let cache = new System.Collections.Generic.Dictionary()
+ let names = new System.Collections.Generic.HashSet()
+ let namer sp : string =
+ if cache.ContainsKey sp then
+ cache.Item sp
+ else
+ let sn = Species.try_find_name opts species_env true sp
+ let name =
+ match sn with
+ | Some species_name ->
+ species_name
+ | None ->
+ match sp with
+ | Species.UNKNOWN species_name -> species_name
+ | _ -> let mutable unique_name = ""
+ let mutable c = names.Count + 1
+ while unique_name = "" do
+ if not (names.Contains ("sp" + string c)) then
+ unique_name <- "sp" + string c
+ else c <- c + 1
+ unique_name
+
+ cache.Add(sp, name);
+ ignore(names.Add(name));
+ name
+ namer
+
+let apply_infinite_reactions sub_map opts senv pops =
+ let upd_pops_meta meta (pops:Populations) =
+ let fold (acc_pops, acc_meta) (pi: Population) =
+ let products =
+ match Species.initial_reactions sub_map opts pi.species with
+ | [] -> []
+ | [ps] -> if pi.initial then List.map (Species.standard_form opts) ps (* RLP: test, initial_reactions should normalize *)
+ else failwith ("Error: " + (Lib.quote "fast_reactions") + " function has missed an infinite reaction.")
+ | _ -> if pi.initial then Errors.conflicting_initial_error pi.species
+ else failwith ("Error: " + (Lib.quote "fast_reactions") + " function has missed some infinite reactions.") in
+ if products.IsEmpty then (* s stays in the mix *)
+ Populations.merge Expression.add acc_pops (Populations.create [pi]), acc_meta
+ else (* products are added instead of s *)
+ let product_pis = List.map (fun s -> { Population.species = s
+ ; Population.value = pi.value
+ ; Population.constant = pi.constant
+ ; Population.initial = pi.initial (* these should all be initial, but why not be generic *)
+ ; Population.input = false (* not input, we just built it *)
+ ; Population.spatial_initial = pi.spatial_initial
+ ; Population.max = pi.max
+ }) products in
+ let new_pops = Populations.merge Expression.add acc_pops (Populations.create product_pis) in
+ (new_pops, Dsdreaction.new_species_env opts products acc_meta) in
+ let pis = pops.get_pop_info_list in
+ List.fold fold (Populations.empty (), meta) pis in
+ let rec apply_irs meta (pops:Populations) =
+ let ss = pops.get_calculus_species_list in
+ let new_pops, new_meta = upd_pops_meta meta pops in
+ let new_ss = new_pops.get_calculus_species_list in
+ let _(*seen_ss*), unseen_ss = List.partition (fun s -> List.contains s ss) new_ss in
+ if unseen_ss.IsEmpty then new_pops (* fix point reached *)
+ else apply_irs new_meta new_pops in
+ apply_irs senv pops
+
+let resolvePlotMissing (env:Syntax.proc_env) (p:Syntax.t_plot_base) : Species.t option =
+ match p with
+ | Syntax.t_plot_base.String x -> failwith ("Unexpected plot " + x)
+ | Syntax.t_plot_base.Molecule m -> Some m
+ | Syntax.t_plot_base.Module (n, _) ->
+ // type t_bind = Def of string * parameter list * (value list -> bool) * t
+ let matches ((Process.t_bind.Def (moduleName, _, _, p) : Process.t_bind)) =
+ if moduleName = n
+ then match p with
+ | Process.Strand (s, _) -> Some (Species.STRAND s)
+ | Process.Gate (g, _) -> Some (Species.GATE g)
+ | Process.Origami _ -> failwith <| "Cannot plot uninstantiated origami module " + n
+ | Process.LogicDsdProcess (pr, _) -> Some (Species.LogicDsdProcess pr)
+ | Process.Repeat _
+ | Process.Instance _
+ | Process.Parallel _
+ | Process.New _
+ | Process.Chemical _ -> None
+ else None
+ List.tryPick matches env
+
+let resolvePlot (env:Process.species_env) (p:Syntax.t_plot_base) : Species.t option =
+ match p with
+ | Syntax.t_plot_base.String x -> failwith ("Unexpected plot " + x)
+ | Syntax.t_plot_base.Molecule m -> Some m
+ | Syntax.t_plot_base.Module (n, _) ->
+ let speciesAndInfo = Stringmap.tryFind n (fst env)
+ match speciesAndInfo with
+ | Some moduleInstances -> let zz =
+ moduleInstances
+ |> List.map (fun (sp, _,_,_,_,_) -> sp )
+ |> Seq.distinct
+ |> Seq.filter (fun sp -> let e = match snd env with | Species.t_disp.Names (e, x) -> e
+ let r = Stringmap.find (sp |> Species.display) e
+ r = n)
+ |> Seq.toList
+ match zz with
+ | [sp] -> Some sp
+ | [] -> None
+ | _ -> failwith ("Module \"" + n + "\" produces two or more species, but only one species can be plotted")
+ | None -> None
+
+
+type ClassicBundle =
+ { settings : Crn_settings>>
+ ; meta : metadata
+ ; sreactions : Process.sreaction list
+ ; initials : Initial list
+ ; dsdOptions : Options.t}
+
+type RulesBundle =
+ { settings : Crn_settings>>>
+ ; initials : Initial, Expression.t> list
+ ; reactions : Reaction
+ , Expression.t
+ , Expression.t>>> list
+ ; plotsCache : System.Collections.Generic.Dictionary,string>
+ ; dsdOptions : Options.t
+ ; rules : RulesProgram }
+
+type LogicBundle =
+ { settings : Crn_settings>>>
+ ; initials : Initial, Expression.t> list
+ ; reactions : Reaction
+ , Expression.t
+ , Expression.t>>> list
+ ; plotsCache : System.Collections.Generic.Dictionary,string>
+ ; dsdOptions : Options.t
+ ; rules : RulesProgram }
+
+type bundle =
+ | ClassicDSD of ClassicBundle
+ | Rules of RulesBundle
+
+let get_options b = match b with ClassicDSD b -> b.dsdOptions | Rules b -> b.dsdOptions
+let set_options b o = match b with ClassicDSD b -> ClassicDSD {b with dsdOptions = o} | Rules b -> Rules {b with dsdOptions = o}
+
+let toLogicDomain (d:Domain.t) : Microsoft.Research.DNA.LogicDSD.Domain =
+ let makeName n i = if i <= 0 then n else sprintf "_%s_%i"n i
+ match d with
+ | Domain.t.Normal(Value.DomainS(n,i,_,_,_,_), b, _) // we ignore information associated with the domain other name and complement
+ | Domain.t.Normal(Value.Domain (n,i,_,_,_), b, _) -> {name = makeName n i
+ isToehold = false
+ isComplementary = b
+ tag = NoTag }
+ | Domain.t.Normal(Value.Variable(n,_) , b, _) -> {name = n
+ isToehold = false
+ isComplementary = b
+ tag = NoTag }
+ | Domain.t.Toe(Value.Variable(n,_), c, b, _) -> {name = n
+ isToehold = true
+ isComplementary = b
+ tag = match c with
+ | Domain.value.Float (x,_) -> if x <> 1.0 then Term.Func ("complementarity", [Term.Float x]) |> Tag else NoTag
+ | Domain.value.Variable (x,_) -> Term.Func ("complementarity", [Term.Const x]) |> Tag
+ | _ -> NoTag }
+ | Domain.t.Toe(Value.DomainS(n,i,_,_,_,_), c, b, _)
+ | Domain.t.Toe(Value.Domain(n,i,_,_,_), c, b, _) -> {name = makeName n i
+ isToehold = true
+ isComplementary = b
+ tag = match c with
+ | Domain.value.Float (x,_) -> if x <> 1.0 then Term.Func ("complementarity", [Term.Float x]) |> Tag else NoTag
+ | Domain.value.Variable (x,_) -> Term.Func ("complementarity", [Term.Const x]) |> Tag
+ | _ -> NoTag }
+ | _ -> failwith "Conversion failed."
+
+let toUnboundSite (d:Domain.t) : Microsoft.Research.DNA.LogicDSD.SiteT = d |> toLogicDomain |> Dom |> Unbound |> Site
+let logicComplement (d: Microsoft.Research.DNA.LogicDSD.Domain) = { d with isComplementary = not d.isComplementary }
+
+type FlatGate = SJoinTop of Segment.t * FlatGate
+ | SJoinBottom of Segment.t * FlatGate
+ | SEndWith of Segment.t
+
+
+let flattenGate (g:Gate.t) (*st: FlatGate option*) : FlatGate =
+ let rec flGate gate =
+ match gate with
+ | []
+ | []::_ -> failwith "Unexpected empty strand in Classic to Logic DSD translation."
+ | [[s]] -> SEndWith s
+ | [s::rest] -> let restGate = flGate [rest]
+ SJoinBottom (s, restGate)
+ | [s]::rest -> let restGate = flGate rest
+ SJoinTop (s, restGate)
+ | (s::rest1)::rest2 -> let restGate = flGate (rest1::rest2)
+ SJoinBottom (s, restGate)
+
+ // reverse the gate, and start flattening from the end
+ let g' = g// |> List.map List.rev // |> List.rev
+ flGate g'
+
+
+
+type IntermediateStrand = Single of RulesDSD.Syntax.Strand
+ | Double of RulesDSD.Syntax.Strand * RulesDSD.Syntax.Strand
+let toLogicProcess (g:FlatGate) : RulesDSD.Syntax.Process =
+ let counter = ref 0
+ let toStrand : Domain.t list -> Strand =
+ List.map (toLogicDomain >> Dom >> Unbound >> Site)
+
+ let toDoubleStrand (s:Domain.t list) : Strand * Strand =
+ s
+ |> List.fold (fun (top, bot) d ->
+ let d' = toLogicDomain d
+ let d'' = logicComplement d'
+ let newBond = Bond !counter
+ counter := !counter + 1
+ let sTop = SiteT.Site (Site.Bound (Dom d', newBond))
+ let sBottom = SiteT.Site (Site.Bound (Dom d'', newBond))
+ sTop::top, sBottom :: bot
+ ) ([], [])
+ |> fun (top, bottom) -> (top |> List.rev, bottom)
+
+ let segmentToStrands (s:Segment.t) =
+ match s with
+ (* {LB}[S]