├── appveyor.yml ├── .vscode ├── extensions.json └── tasks.json ├── src ├── Hekate │ ├── Hekate.fsproj │ └── Hekate.fs └── Directory.Build.props ├── .editorconfig ├── README.md ├── .travis.yml ├── tests └── Hekate.Tests │ ├── Hekate.Tests.fsproj │ └── Hekate.Tests.fs ├── LICENSE.md ├── Hekate.sln └── .gitignore /appveyor.yml: -------------------------------------------------------------------------------- 1 | image: Visual Studio 2017 2 | build_script: 3 | - ps: | 4 | .\build.ps1 5 | if ($lastexitcode -ne 0){ exit $lastexitcode } 6 | artifacts: 7 | - path: bin\*.nupkg 8 | -------------------------------------------------------------------------------- /.vscode/extensions.json: -------------------------------------------------------------------------------- 1 | { 2 | // See http://go.microsoft.com/fwlink/?LinkId=827846 3 | // for the documentation about the extensions.json format 4 | "recommendations": [ 5 | // Extension identifier format: ${publisher}.${name}. Example: vscode.csharp 6 | "Ionide.Ionide-fsharp", 7 | "EditorConfig.EditorConfig" 8 | ] 9 | } 10 | -------------------------------------------------------------------------------- /src/Hekate/Hekate.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | netstandard2.0;net45 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig is awesome: 2 | http://EditorConfig.org 3 | 4 | # top-most EditorConfig file 5 | root = true 6 | 7 | # Default settings: 8 | # A newline ending every file 9 | # Use 4 spaces as indentation 10 | [*] 11 | insert_final_newline = true 12 | indent_style = space 13 | indent_size = 4 14 | 15 | [*.{fs,fsi,fsx,config}] 16 | charset = utf-8 17 | trim_trailing_whitespace = true 18 | 19 | [paket.*] 20 | trim_trailing_whitespace = true 21 | indent_size = 2 22 | 23 | [*.paket.references] 24 | trim_trailing_whitespace = true 25 | indent_size = 2 26 | -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | // See https://go.microsoft.com/fwlink/?LinkId=733558 3 | // for the documentation about the tasks.json format 4 | "version": "0.1.0", 5 | "command": "dotnet", 6 | "isShellCommand": true, 7 | "args": [], 8 | "tasks": [ 9 | { 10 | "taskName": "build", 11 | "args": [ ], 12 | "isBuildCommand": true, 13 | "showOutput": "silent", 14 | "problemMatcher": "$msCompile" 15 | }, 16 | { 17 | "taskName": "test", 18 | "args": [ "tests/Hekate.Tests/Hekate.Tests.fsproj" ], 19 | "isTestCommand": true, 20 | "showOutput": "silent", 21 | "problemMatcher": "$msCompile" 22 | } 23 | ] 24 | } 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Hekate 2 | 3 | [![Chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/xyncro/hekate?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) 4 | [![Build](https://ci.appveyor.com/api/projects/status/4pypj5i49q2hhcul?svg=true)](https://ci.appveyor.com/project/xyncro/hekate) 5 | 6 | ## What is Hekate? 7 | 8 | [Hekate][hekate] is a Graph library for F#, similar to the Haskell FGL package. See the dedicated [Hekate Site][hekate] for more information. 9 | 10 | ## Installation 11 | 12 | Hekate can be installed from [NuGet](https://www.nuget.org/packages/hekate "Hekate on NuGet"). Using the Package Manager Console: 13 | 14 | ```batch 15 | PM> Install-Package Hekate 16 | ``` 17 | 18 | ## License 19 | 20 | Hekate is under the MIT license. 21 | 22 | [hekate]: https://xyncro.tech/hekate 23 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: csharp 2 | 3 | dotnet: 2.1.402 4 | 5 | mono: 6 | - 5.2.0 7 | 8 | install: 9 | - mozroots --import --sync 10 | # workaround for missing .net 4.5 targing pack 11 | - export FrameworkPathOverride=$(dirname $(which mono))/../lib/mono/4.5/ 12 | 13 | matrix: 14 | include: 15 | - os: linux # Ubuntu 14.04 16 | dist: trusty 17 | sudo: required 18 | dotnet: 2.1.402 19 | - os: osx # OSX 10.12 20 | osx_image: xcode9.1 21 | dotnet: 2.1.402 22 | dist: trusty 23 | sudo: required 24 | 25 | script: 26 | - dotnet --info 27 | - dotnet restore 28 | - dotnet build -c Release 29 | - dotnet test --no-build -c Release tests/Hekate.Tests/Hekate.Tests.fsproj 30 | - dotnet pack --no-build -c Release --include-symbols 31 | 32 | branches: 33 | except: 34 | - gh-pages 35 | -------------------------------------------------------------------------------- /tests/Hekate.Tests/Hekate.Tests.fsproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Exe 5 | netcoreapp2.0 6 | false 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | ===================== 3 | 4 | Copyright (c) 2015 Andrew Cherry 5 | 6 | Permission is hereby granted, free of charge, to any person obtaining a copy 7 | of this software and associated documentation files (the "Software"), to deal 8 | in the Software without restriction, including without limitation the rights 9 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10 | copies of the Software, and to permit persons to whom the Software is 11 | furnished to do so, subject to the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be included in all 14 | copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 17 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 18 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 19 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 20 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 21 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 22 | SOFTWARE. 23 | 24 | -------------------------------------------------------------------------------- /src/Directory.Build.props: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 3.3.0 5 | Andrew Cherry 6 | Graphs for F# 7 | Copyright © Xyncro Ltd 8 | https://github.com/xyncro/hekate/blob/master/LICENSE.md 9 | https://xyncro.tech/hekate/ 10 | git 11 | https://github.com/xyncro/hekate 12 | $(PackageTags);functional;graphs;inductive;f#;fsharp 13 | true 14 | 15 | 16 | true 17 | true 18 | $(AllowedOutputExtensionsInPackageBuildOutputFolder);.pdb 19 | 20 | 21 | 22 | 23 | 24 | -------------------------------------------------------------------------------- /Hekate.sln: -------------------------------------------------------------------------------- 1 | 2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio 15 4 | VisualStudioVersion = 15.0.26124.0 5 | MinimumVisualStudioVersion = 15.0.26124.0 6 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "src", "src", "{686A1D42-3DAA-4C8F-8223-0F8551F147A2}" 7 | EndProject 8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Hekate", "src\Hekate\Hekate.fsproj", "{0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}" 9 | EndProject 10 | Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{9F6FC567-A14D-4043-B398-0CC6E4CC808F}" 11 | EndProject 12 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Hekate.Tests", "tests\Hekate.Tests\Hekate.Tests.fsproj", "{5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}" 13 | EndProject 14 | Global 15 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 16 | Debug|Any CPU = Debug|Any CPU 17 | Debug|x64 = Debug|x64 18 | Debug|x86 = Debug|x86 19 | Release|Any CPU = Release|Any CPU 20 | Release|x64 = Release|x64 21 | Release|x86 = Release|x86 22 | EndGlobalSection 23 | GlobalSection(SolutionProperties) = preSolution 24 | HideSolutionNode = FALSE 25 | EndGlobalSection 26 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 27 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 28 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Debug|Any CPU.Build.0 = Debug|Any CPU 29 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Debug|x64.ActiveCfg = Debug|x64 30 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Debug|x64.Build.0 = Debug|x64 31 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Debug|x86.ActiveCfg = Debug|x86 32 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Debug|x86.Build.0 = Debug|x86 33 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Release|Any CPU.ActiveCfg = Release|Any CPU 34 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Release|Any CPU.Build.0 = Release|Any CPU 35 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Release|x64.ActiveCfg = Release|x64 36 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Release|x64.Build.0 = Release|x64 37 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Release|x86.ActiveCfg = Release|x86 38 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7}.Release|x86.Build.0 = Release|x86 39 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 40 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Debug|Any CPU.Build.0 = Debug|Any CPU 41 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Debug|x64.ActiveCfg = Debug|x64 42 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Debug|x64.Build.0 = Debug|x64 43 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Debug|x86.ActiveCfg = Debug|x86 44 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Debug|x86.Build.0 = Debug|x86 45 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Release|Any CPU.ActiveCfg = Release|Any CPU 46 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Release|Any CPU.Build.0 = Release|Any CPU 47 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Release|x64.ActiveCfg = Release|x64 48 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Release|x64.Build.0 = Release|x64 49 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Release|x86.ActiveCfg = Release|x86 50 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541}.Release|x86.Build.0 = Release|x86 51 | EndGlobalSection 52 | GlobalSection(NestedProjects) = preSolution 53 | {0B0F73CB-98AD-442B-BB42-599D5BC0FFF7} = {686A1D42-3DAA-4C8F-8223-0F8551F147A2} 54 | {5CE3D0AD-2347-4171-BA85-E9FEB3DB1541} = {9F6FC567-A14D-4043-B398-0CC6E4CC808F} 55 | EndGlobalSection 56 | EndGlobal 57 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | 4 | # Temp 5 | temp 6 | 7 | # Paket 8 | .paket/paket.exe 9 | paket-files 10 | 11 | # User-specific files 12 | *.suo 13 | *.user 14 | *.sln.docstates 15 | 16 | # Build results 17 | .fake/ 18 | [Dd]ebug/ 19 | [Dd]ebugPublic/ 20 | [Rr]elease/ 21 | x64/ 22 | bld/ 23 | [Bb]in/ 24 | [Oo]bj/ 25 | 26 | # MSTest test Results 27 | [Tt]est[Rr]esult*/ 28 | [Bb]uild[Ll]og.* 29 | 30 | #NUNIT 31 | *.VisualState.xml 32 | TestResult.xml 33 | 34 | # Build Results of an ATL Project 35 | [Dd]ebugPS/ 36 | [Rr]eleasePS/ 37 | dlldata.c 38 | 39 | *_i.c 40 | *_p.c 41 | *_i.h 42 | *.ilk 43 | *.meta 44 | *.obj 45 | *.pch 46 | *.pdb 47 | *.pgc 48 | *.pgd 49 | *.rsp 50 | *.sbr 51 | *.tlb 52 | *.tli 53 | *.tlh 54 | *.tmp 55 | *.tmp_proj 56 | *.log 57 | *.vspscc 58 | *.vssscc 59 | .builds 60 | *.pidb 61 | *.svclog 62 | *.scc 63 | 64 | # Chutzpah Test files 65 | _Chutzpah* 66 | 67 | # Visual C++ cache files 68 | ipch/ 69 | *.aps 70 | *.ncb 71 | *.opensdf 72 | *.sdf 73 | *.cachefile 74 | 75 | # Visual Studio profiler 76 | *.psess 77 | *.vsp 78 | *.vspx 79 | 80 | # TFS 2012 Local Workspace 81 | $tf/ 82 | 83 | # Guidance Automation Toolkit 84 | *.gpState 85 | 86 | # ReSharper is a .NET coding add-in 87 | _ReSharper*/ 88 | *.[Rr]e[Ss]harper 89 | *.DotSettings.user 90 | .idea/ 91 | 92 | # JustCode is a .NET coding addin-in 93 | .JustCode 94 | 95 | # TeamCity is a build add-in 96 | _TeamCity* 97 | 98 | # DotCover is a Code Coverage Tool 99 | *.dotCover 100 | 101 | # NCrunch 102 | *.ncrunch* 103 | _NCrunch_* 104 | .*crunch*.local.xml 105 | *nCrunch* 106 | 107 | # MightyMoose 108 | *.mm.* 109 | AutoTest.Net/ 110 | 111 | # Web workbench (sass) 112 | .sass-cache/ 113 | 114 | # Installshield output folder 115 | [Ee]xpress/ 116 | 117 | # DocProject is a documentation generator add-in 118 | DocProject/buildhelp/ 119 | DocProject/Help/*.HxT 120 | DocProject/Help/*.HxC 121 | DocProject/Help/*.hhc 122 | DocProject/Help/*.hhk 123 | DocProject/Help/*.hhp 124 | DocProject/Help/Html2 125 | DocProject/Help/html 126 | 127 | # Click-Once directory 128 | publish/ 129 | 130 | # Publish Web Output 131 | *.[Pp]ublish.xml 132 | *.azurePubxml 133 | 134 | # NuGet Packages Directory 135 | packages/ 136 | ## TODO: If the tool you use requires repositories.config uncomment the next line 137 | #!packages/repositories.config 138 | 139 | # Enable "build/" folder in the NuGet Packages folder since NuGet packages use it for MSBuild targets 140 | # This line needs to be after the ignore of the build folder (and the packages folder if the line above has been uncommented) 141 | !packages/build/ 142 | 143 | # Windows Azure Build Output 144 | csx/ 145 | *.build.csdef 146 | 147 | # Windows Store app package directory 148 | AppPackages/ 149 | 150 | # Others 151 | sql/ 152 | *.Cache 153 | ClientBin/ 154 | [Ss]tyle[Cc]op.* 155 | ~$* 156 | *~ 157 | *.dbmdl 158 | *.dbproj.schemaview 159 | *.pfx 160 | *.publishsettings 161 | node_modules/ 162 | 163 | # RIA/Silverlight projects 164 | Generated_Code/ 165 | 166 | # Backup & report files from converting an old project file to a newer 167 | # Visual Studio version. Backup files are not needed, because we have git ;-) 168 | _UpgradeReport_Files/ 169 | Backup*/ 170 | UpgradeLog*.XML 171 | UpgradeLog*.htm 172 | 173 | # SQL Server files 174 | *.mdf 175 | *.ldf 176 | 177 | # Business Intelligence projects 178 | *.rdl.data 179 | *.bim.layout 180 | *.bim_*.settings 181 | 182 | # Microsoft Fakes 183 | FakesAssemblies/ 184 | 185 | # FSharp Lint 186 | *.FSharpLint 187 | 188 | *.userprefs 189 | -------------------------------------------------------------------------------- /tests/Hekate.Tests/Hekate.Tests.fs: -------------------------------------------------------------------------------- 1 | module Hekate.Tests 2 | 3 | open Hekate 4 | open Swensen.Unquote 5 | open Xunit 6 | 7 | (* Fixtures *) 8 | 9 | let private g1 = 10 | Graph.empty 11 | 12 | let private g2 = 13 | Graph.create 14 | [ 1, "one" 15 | 2, "two" 16 | 3, "three" ] 17 | [ 2, 1, "left" 18 | 3, 1, "up" 19 | 1, 2, "right" 20 | 2, 3, "down" ] 21 | 22 | (* Construction *) 23 | 24 | [] 25 | let ``Nodes.add behaves correctly`` () = 26 | let g3 = Graph.Nodes.add (4, "four") g2 27 | 28 | Graph.Nodes.count g3 =! 4 29 | Graph.Nodes.count g3 =! 4 30 | 31 | [] 32 | let ``Nodes.remove behaves correctly`` () = 33 | let g3 = Graph.Nodes.remove 1 g2 34 | 35 | Graph.Nodes.count g3 =! 2 36 | Graph.Edges.count g3 =! 1 37 | 38 | [] 39 | let ``Edges.add behaves correctly`` () = 40 | let g3 = Graph.Edges.add (1, 3, "down") g2 41 | 42 | Graph.Nodes.count g3 =! 3 43 | Graph.Edges.count g3 =! 5 44 | 45 | [] 46 | let ``Edges.remove behaves correctly`` () = 47 | let g3 = Graph.Edges.remove (2, 1) g2 48 | 49 | Graph.Nodes.count g3 =! 3 50 | Graph.Edges.count g3 =! 3 51 | 52 | (* Queries *) 53 | 54 | [] 55 | let ``Edges.contains behaves correctly`` () = 56 | Graph.Edges.contains 1 2 g2 =! true 57 | Graph.Edges.contains 1 3 g2 =! false 58 | 59 | [] 60 | let ``Nodes.contains behaves correctly`` () = 61 | Graph.Nodes.contains 1 g2 =! true 62 | Graph.Nodes.contains 4 g2 =! false 63 | 64 | [] 65 | let ``isEmpty behaves correctly`` () = 66 | Graph.isEmpty g1 =! true 67 | Graph.isEmpty g2 =! false 68 | 69 | (* Mapping *) 70 | 71 | [] 72 | let ``Edges.map behaves correctly`` () = 73 | let g3 = Graph.Edges.map (fun v1 v2 (e: string) -> sprintf "%i.%i.%s" v1 v2 e) g2 74 | 75 | Graph.Edges.find 1 2 g3 =! (1, 2, "1.2.right") 76 | 77 | [] 78 | let ``Nodes.map behaves correctly`` () = 79 | let g3 = Graph.Nodes.map (fun _ (n: string) -> n.ToUpper ()) g2 80 | 81 | snd (Graph.Nodes.find 1 g2) =! "one" 82 | snd (Graph.Nodes.find 1 g3) =! "ONE" 83 | 84 | [] 85 | let ``Nodes.mapFold behaves correctly`` () = 86 | let s, g3 = Graph.Nodes.mapFold (fun s _ (n: string) -> n.ToUpper (), s + 1) 0 g2 87 | 88 | snd (Graph.Nodes.find 1 g2) =! "one" 89 | snd (Graph.Nodes.find 1 g3) =! "ONE" 90 | s =! 3 91 | 92 | (* Projection *) 93 | 94 | [] 95 | let ``Nodes.toList behaves correctly`` () = 96 | List.length (Graph.Nodes.toList g2) =! 3 97 | 98 | [] 99 | let ``Edges.toList behaves correctly`` () = 100 | List.length (Graph.Edges.toList g2) =! 4 101 | 102 | (* Inspection *) 103 | 104 | [] 105 | let ``Nodes.tryFind behaves correctly`` () = 106 | Graph.Nodes.tryFind 1 g2 =! Some (1, "one") 107 | Graph.Nodes.tryFind 4 g2 =! None 108 | 109 | [] 110 | let ``Nodes.find behaves correctly`` () = 111 | Graph.Nodes.find 1 g2 =! (1, "one") 112 | raises <@ Graph.Nodes.find 4 g2 @> 113 | 114 | [] 115 | let ``rev behaves correctly`` () = 116 | let g3 = Graph.rev g2 117 | let g4 = Graph.Edges.remove (1, 3) g3 118 | 119 | Graph.Edges.count g3 =! 4 120 | Graph.Edges.count g4 =! 3 121 | 122 | (* Adjacency/Degree *) 123 | 124 | [] 125 | let ``Nodes.neighbours behaves correctly`` () = 126 | Graph.Nodes.neighbours 1 g2 127 | =! Some [ 2, "left" 128 | 3, "up" 129 | 2, "right" ] 130 | 131 | [] 132 | let ``Nodes.successors behaves correctly`` () = 133 | Graph.Nodes.successors 1 g2 134 | =! Some [ 2, "right" ] 135 | 136 | [] 137 | let ``Nodes.predecessors behaves correctly`` () = 138 | Graph.Nodes.predecessors 1 g2 139 | =! Some [ 2, "left" 140 | 3, "up" ] 141 | 142 | [] 143 | let ``Nodes.outward behaves correctly`` () = 144 | Graph.Nodes.outward 1 g2 145 | =! Some [ 1, 2, "right" ] 146 | 147 | [] 148 | let ``Nodes.inward behaves correctly`` () = 149 | Graph.Nodes.inward 1 g2 150 | =! Some [ 2, 1, "left" 151 | 3, 1, "up" ] 152 | 153 | [] 154 | let ``Nodes.degree behaves correctly`` () = 155 | Graph.Nodes.degree 1 g2 156 | =! Some 3 157 | 158 | [] 159 | let ``Nodes.outwardDegree behaves correctly`` () = 160 | Graph.Nodes.outwardDegree 1 g2 161 | =! Some 1 162 | 163 | [] 164 | let ``Nodes.inwardDegree behaves correctly`` () = 165 | Graph.Nodes.inwardDegree 1 g2 166 | =! Some 2 -------------------------------------------------------------------------------- /src/Hekate/Hekate.fs: -------------------------------------------------------------------------------- 1 | module Hekate 2 | 3 | (* Introduction 4 | 5 | A library for working with graphs in a purely functional way, based 6 | on ideas from papers on inductive graphs and functional algorithms, 7 | principally by Martin Erwig. Those papers are particularly relevant to 8 | understanding the internals of this library. 9 | 10 | The following papers are referenced in commentary throughout the code: 11 | 12 | [Erwig:2001ho]: Inductive Graphs and Functional Graph Algorithms 13 | http://dl.acm.org/citation.cfm?id=968434.968437 14 | 15 | The library is spiritually similar to the Haskell FGL library, which 16 | is unsurprising given that it was originally written by Erwig et al, 17 | based on [Erwig:2001ho]. However, we simplify some aspects and change 18 | others due to our own needs and type system. 19 | 20 | [FGL]: http://hackage.haskell.org/package/fgl 21 | 22 | There are some significant differences between Hekate and FGL: 23 | 24 | - Hekate does not have a concept of 25 | an unlabelled graph, either in terms of nodes or edges, and thus does 26 | not draw the FGL distinction between types Node, LNode, etc. 27 | 28 | - Hekate implements the underlying representation using a M type which 29 | is parameterized by key and value types, we allow node IDs to be of any 30 | type supporting comparison. Our graph type is this parameterized by the 31 | types of the node IDs, node labels, and edge labels. 32 | 33 | - Hekate does not draw a distinction between static and dynamic graphs. 34 | The Graph<_,_,_> type is always dynamic. 35 | 36 | NOTE: [Erwig:2001ho] defines various functions and algorithms implemented using 37 | the Basic Graph Operations. These are interesting, and usually the best way 38 | to understand the principle of the implementation, but they are not always the 39 | most efficient way to implement the function, depending on the underlying data 40 | structure representation. *) 41 | 42 | open System 43 | open Aether 44 | open Aether.Operators 45 | 46 | (* Prelude 47 | 48 | Useful utility functions used throughout Hekate. *) 49 | 50 | let private flip f a b = 51 | f b a 52 | 53 | let private swap (a, b) = 54 | (b, a) 55 | 56 | (* Definitional Types and Lenses 57 | 58 | Types defining data structures which form the logical programming model 59 | defined by the inductive definition of graphs, along with a set of lenses 60 | for access to nested data structures. *) 61 | 62 | type Node<'v> = 63 | 'v 64 | 65 | type Edge<'v> = 66 | 'v * 'v 67 | 68 | type LNode<'v,'a> = 69 | 'v * 'a 70 | 71 | type LEdge<'v,'b> = 72 | 'v * 'v * 'b 73 | 74 | type Adj<'v,'b> = 75 | ('b * 'v) list 76 | 77 | type Context<'v,'a,'b> = 78 | Adj<'v,'b> * 'v * 'a * Adj<'v,'b> 79 | 80 | let private pred_ : Lens, Adj<'v,'b>> = 81 | (fun (p, _, _, _) -> p), (fun p (_, v, l, s) -> (p, v, l, s)) 82 | 83 | let private val_ : Lens, 'v> = 84 | (fun (_, v, _, _) -> v), (fun v (p, _, l, s) -> (p, v, l, s)) 85 | 86 | let private succ_ : Lens, Adj<'v,'b>> = 87 | (fun (_, _, _, s) -> s), (fun s (p, v, l, _) -> (p, v, l, s)) 88 | 89 | (* Representational Types and Lenses 90 | 91 | Types used for the underlying implementation of the graph, modelling the 92 | logically defined inductive definition as an optimized map, with sub-maps 93 | defining node adjacencies. *) 94 | 95 | type MAdj<'v,'b> when 'v: comparison = 96 | Map<'v,'b> 97 | 98 | type MContext<'v,'a,'b> when 'v: comparison = 99 | MAdj<'v,'b> * 'a * MAdj<'v,'b> 100 | 101 | type MGraph<'v,'a,'b> when 'v: comparison = 102 | Map<'v, MContext<'v,'a,'b>> 103 | 104 | type Graph<'v,'a,'b> when 'v: comparison = 105 | MGraph<'v,'a,'b> 106 | 107 | let private mpred_ : Lens, MAdj<'v,'b>> = 108 | (fun (p, _, _) -> p), (fun p (_, l, s) -> (p, l, s)) 109 | 110 | let private msucc_ : Lens, MAdj<'v,'b>> = 111 | (fun (_, _, s) -> s), (fun s (p, l, _) -> (p, l, s)) 112 | 113 | (* Mappings 114 | 115 | Mapping functions between the two definitional and representational data 116 | structure families, used when translating between algorithmic operations applied 117 | to the definitional model, and modifications to the underlying data structure of 118 | the optmized representational model. *) 119 | 120 | let private fromAdj<'v,'b when 'v: comparison> : Adj<'v,'b> -> MAdj<'v,'b> = 121 | List.map swap >> Map.ofList 122 | 123 | let private toAdj<'v,'b when 'v: comparison> : MAdj<'v,'b> -> Adj<'v,'b> = 124 | Map.toList >> List.map swap 125 | 126 | let private fromContext<'v,'a,'b when 'v: comparison> : Context<'v,'a,'b> -> MContext<'v,'a,'b> = 127 | fun (p, _, l, s) -> fromAdj p, l, fromAdj s 128 | 129 | let private toContext<'v,'a,'b when 'v: comparison> v : MContext<'v,'a,'b> -> Context<'v,'a,'b> = 130 | fun (p, l, s) -> toAdj p, v, l, toAdj s 131 | 132 | (* Construction 133 | 134 | The functions "Empty" and "&", forming the two basic construction 135 | functions for the inductive definition of a graph, as defined in the 136 | table of Basic Graph Operations in [Erwig:2001ho]. 137 | 138 | "Empty" is defined as "empty", and "&" is defined as the function 139 | "compose". *) 140 | 141 | type Id<'v> = 142 | 'v -> 'v 143 | 144 | let private empty : Graph<'v,'a,'b> = 145 | Map.empty 146 | 147 | let private composeGraph c v p s = 148 | Optic.set (Map.value_ v) (Some (fromContext c)) 149 | >> flip (List.fold (fun g (b, v') -> (Map.add v b ^% (Map.key_ v' >?> msucc_)) g)) p 150 | >> flip (List.fold (fun g (b, v') -> (Map.add v b ^% (Map.key_ v' >?> mpred_)) g)) s 151 | 152 | let private compose (c: Context<'v,'a,'b>) : Id> = 153 | composeGraph c (c ^. val_) (c ^. pred_) (c ^. succ_) 154 | 155 | (* Decomposition 156 | 157 | Functions for decomposing an existent graph through a process 158 | of matching, as defined in the table of Basic Graph Operations 159 | in [Erqig:2001ho]. 160 | 161 | The Empty-match function is named "isEmpty" and forms part of the public 162 | API for Hekate and is thus defined later in the Graph module. The "&-match" 163 | function becomes "decompose", and the "&v" function becomes "decomposeSpecific", to 164 | better align with F# expectations. *) 165 | 166 | let private decomposeContext v = 167 | Map.remove v ^% mpred_ 168 | >> Map.remove v ^% msucc_ 169 | >> toContext v 170 | 171 | let private decomposeGraph v p s = 172 | Map.remove v 173 | >> flip (List.fold (fun g (_, a) -> (Map.remove v ^% (Map.key_ a >?> msucc_)) g)) p 174 | >> flip (List.fold (fun g (_, a) -> (Map.remove v ^% (Map.key_ a >?> mpred_)) g)) s 175 | 176 | let private decomposeSpecific v (g: Graph<'v,'a,'b>) = 177 | match Map.tryFind v g with 178 | | Some mc -> 179 | let c = decomposeContext v mc 180 | let g = decomposeGraph v (c ^. pred_) (c ^. succ_) g 181 | 182 | Some c, g 183 | | _ -> 184 | None, g 185 | 186 | let private decompose (g: Graph<'v,'a,'b>) : Context<'v,'a,'b> option * Graph<'v,'a,'b> = 187 | match Map.tryFindKey (fun _ _ -> true) g with 188 | | Some v -> decomposeSpecific v g 189 | | _ -> None, g 190 | 191 | let private isEmpty<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> bool = 192 | Map.isEmpty 193 | 194 | (* Functions 195 | 196 | Useful functions defined in terms of the Basic Graph Operations, though 197 | not expected to be used directly. *) 198 | 199 | let rec private ufold f u = 200 | decompose 201 | >> function | Some c, g -> f c (ufold f u g) 202 | | _ -> u 203 | 204 | let private fold f xs : Graph<'v,'a,'b> -> Graph<'v,'a,'b> = 205 | flip (List.fold (flip f)) xs 206 | 207 | (* Graph 208 | 209 | The "public" API to Hekate is exposed as the Graph[.[Edges|Nodes]] modules, 210 | providing an API stylistically similar to common F# modules like List, Map, etc. 211 | 212 | F# naming conventions have been applied where relevant, in contrast to 213 | either FGL or [Erwig:2001ho]. *) 214 | 215 | [] 216 | module Graph = 217 | 218 | [] 219 | module Edges = 220 | 221 | (* Operations *) 222 | 223 | let add ((v1, v2, e): LEdge<'v,'b>) = 224 | Map.add v2 e ^% (Map.key_ v1 >?> msucc_) 225 | >> Map.add v1 e ^% (Map.key_ v2 >?> mpred_) 226 | 227 | let addMany es = 228 | fold add es 229 | 230 | let remove ((v1, v2): Edge<'v>) = 231 | decomposeSpecific v1 232 | >> function | Some (p, v, l, s), g -> compose (p, v, l, List.filter (fun (_, v') -> v' <> v2) s) g 233 | | _, g -> g 234 | 235 | let removeMany es = 236 | fold remove es 237 | 238 | (* Properties *) 239 | 240 | let count<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> int = 241 | Map.toArray 242 | >> Array.map (fun (_, (_, _, s)) -> (Map.toList >> List.length) s) 243 | >> Array.sum 244 | 245 | (* Map *) 246 | 247 | let map mapping : Graph<'v,'a,'b> -> Graph<'v,'a,'c> = 248 | Map.map (fun v (p, l, s) -> 249 | Map.map (fun v' x -> mapping v' v x) p, 250 | l, 251 | Map.map (fun v' x -> mapping v v' x) s) 252 | 253 | (* Projection *) 254 | 255 | let toList<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> LEdge<'v,'b> list = 256 | Map.toList 257 | >> List.map (fun (v, (_, _, s)) -> (Map.toList >> List.map (fun (v', b) -> v, v', b)) s) 258 | >> List.concat 259 | 260 | (* Query*) 261 | 262 | let contains v1 v2 : Graph<'v,'a,'b> -> bool = 263 | Map.tryFind v1 264 | >> Option.bind (fun (_, _, s) -> Map.tryFind v2 s) 265 | >> Option.isSome 266 | 267 | 268 | let tryFind v1 v2 : Graph<'v,'a,'b> -> LEdge<'v,'b> option = 269 | Map.tryFind v1 270 | >> Option.bind (fun (_, _, s) -> Map.tryFind v2 s) 271 | >> Option.map (fun b -> (v1, v2, b)) 272 | 273 | let find v1 v2 = 274 | tryFind v1 v2 275 | >> function | Some e -> e 276 | | _ -> failwith (sprintf "Edge %A %A Not Found" v1 v2) 277 | 278 | [] 279 | module Nodes = 280 | 281 | (* Operations*) 282 | 283 | let add ((v, l): LNode<'v,'a>) = 284 | Map.add v (Map.empty, l, Map.empty) 285 | 286 | let addMany ns = 287 | fold add ns 288 | 289 | let remove v = 290 | decomposeSpecific v 291 | >> snd 292 | 293 | let removeMany vs = 294 | fold remove vs 295 | 296 | (* Properties *) 297 | 298 | let count<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> int = 299 | Map.toArray 300 | >> Array.length 301 | 302 | (* Map *) 303 | 304 | let map mapping : Graph<'v,'a,'b> -> Graph<'v,'c,'b> = 305 | Map.map (fun v (p, l, s) -> 306 | p, mapping v l, s) 307 | 308 | let mapFold mapping state : Graph<'v,'a,'b> -> 's * Graph<'v,'c,'b> = 309 | Map.toList 310 | >> List.mapFold (fun state (v, (p, l, s)) -> mapping state v l |> fun (c, state) -> (v, (p, c, s)), state) state 311 | >> fun (graph, state) -> state, Map.ofList graph 312 | 313 | (* Projection *) 314 | 315 | let toList<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> LNode<'v,'a> list = 316 | Map.toList 317 | >> List.map (fun (v, (_, l, _)) -> v, l) 318 | 319 | (* Query*) 320 | 321 | let contains v : Graph<'v,'a,'b> -> bool = 322 | Map.containsKey v 323 | 324 | let tryFind v : Graph<'v,'a,'b> -> LNode<'v,'a> option = 325 | Map.tryFind v 326 | >> Option.map (fun (_, l, _) -> v, l) 327 | 328 | let find v = 329 | tryFind v 330 | >> function | Some n -> n 331 | | _ -> failwith (sprintf "Node %A Not Found" v) 332 | 333 | (* Adjacency and Degree *) 334 | 335 | let neighbours v = 336 | Map.tryFind v 337 | >> Option.map (fun (p, _, s) -> Map.toList p @ Map.toList s) 338 | 339 | let successors v = 340 | Map.tryFind v 341 | >> Option.map (fun (_, _, s) -> Map.toList s) 342 | 343 | let predecessors v = 344 | Map.tryFind v 345 | >> Option.map (fun (p, _, _) -> Map.toList p) 346 | 347 | let outward v = 348 | Map.tryFind v 349 | >> Option.map (fun (_, _, s) -> (Map.toList >> List.map (fun (v', b) -> v, v', b)) s) 350 | 351 | let inward v = 352 | Map.tryFind v 353 | >> Option.map (fun (p, _, _) -> (Map.toList >> List.map (fun (v', b) -> v', v, b)) p) 354 | 355 | let degree v = 356 | Map.tryFind v 357 | >> Option.map (fun (p, _, s) -> (Map.toList >> List.length) p + (Map.toList >> List.length) s) 358 | 359 | let outwardDegree v = 360 | Map.tryFind v 361 | >> Option.map (fun (_, _, s) -> (Map.toList >> List.length) s) 362 | 363 | let inwardDegree v = 364 | Map.tryFind v 365 | >> Option.map (fun (p, _, _) -> (Map.toList >> List.length) p) 366 | 367 | (* Operations *) 368 | 369 | let create ns es : Graph<'v,'a,'b> = 370 | (Nodes.addMany ns >> Edges.addMany es) empty 371 | 372 | let empty = 373 | empty 374 | 375 | (* Properties *) 376 | 377 | let isEmpty<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> bool = 378 | isEmpty 379 | 380 | (* Mapping *) 381 | 382 | let map f : Graph<'v,'a,'b> -> Graph<'v,'c,'d> = 383 | Map.map (fun v mc -> (toContext v >> f >> fromContext) mc) 384 | 385 | let rev<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> Graph<'v,'a,'b> = 386 | Map.map (fun _ (p, l, s) -> (s, l, p)) 387 | 388 | (* Obsolete (Deprecated) Functions 389 | 390 | To be removed in the 4.0 release of Hekate after adequate 391 | transition time. *) 392 | 393 | (* Operations *) 394 | 395 | [] 396 | let addEdge = 397 | Edges.add 398 | 399 | [] 400 | let addEdges = 401 | Edges.addMany 402 | 403 | [] 404 | let addNode = 405 | Nodes.add 406 | 407 | [] 408 | let addNodes = 409 | Nodes.addMany 410 | 411 | [] 412 | let removeEdge = 413 | Edges.remove 414 | 415 | [] 416 | let removeEdges = 417 | Edges.removeMany 418 | 419 | [] 420 | let removeNode = 421 | Nodes.remove 422 | 423 | [] 424 | let removeNodes = 425 | Nodes.removeMany 426 | 427 | (* Properties *) 428 | 429 | [] 430 | let countEdges<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> int = 431 | Edges.count 432 | 433 | [] 434 | let countNodes<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> int = 435 | Nodes.count 436 | 437 | (* Map *) 438 | 439 | [] 440 | let mapEdges = 441 | Edges.map 442 | 443 | [] 444 | let mapNodes = 445 | Nodes.map 446 | 447 | (* Projection *) 448 | 449 | [] 450 | let edges<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> LEdge<'v,'b> list = 451 | Edges.toList 452 | 453 | [] 454 | let nodes<'v,'a,'b when 'v: comparison> : Graph<'v,'a,'b> -> LNode<'v,'a> list = 455 | Nodes.toList 456 | 457 | (* Query *) 458 | 459 | [] 460 | let containsEdge = 461 | Edges.contains 462 | 463 | [] 464 | let containsNode = 465 | Nodes.contains 466 | 467 | [] 468 | let findEdge = 469 | Edges.find 470 | 471 | [] 472 | let findNode = 473 | Nodes.find 474 | 475 | [] 476 | let tryFindEdge = 477 | Edges.tryFind 478 | 479 | [] 480 | let tryFindNode = 481 | Nodes.tryFind 482 | 483 | (* Adjacency and Degree *) 484 | 485 | [] 486 | let neighbours = 487 | Nodes.neighbours 488 | 489 | [] 490 | let successors = 491 | Nodes.successors 492 | 493 | [] 494 | let predecessors = 495 | Nodes.predecessors 496 | 497 | [] 498 | let outward = 499 | Nodes.outward 500 | 501 | [] 502 | let inward = 503 | Nodes.inward 504 | 505 | [] 506 | let degree = 507 | Nodes.degree 508 | 509 | [] 510 | let outwardDegree = 511 | Nodes.outwardDegree 512 | 513 | [] 514 | let inwardDegree = 515 | Nodes.inwardDegree 516 | --------------------------------------------------------------------------------