├── .gitignore ├── .travis.yml ├── Alga.FSharp.sln ├── Alga.FSharp ├── AdjacencyMap.fs ├── AdjacencyMap │ └── Internal.fs ├── Alga.FSharp.fsproj ├── Graph.fs ├── Internal.fs ├── Map.fs ├── Option.fs ├── Tree.fs ├── Typed.fs └── Untyped.fs ├── LICENSE └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | ## 4 | ## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore 5 | 6 | # User-specific files 7 | *.suo 8 | *.user 9 | *.userosscache 10 | *.sln.docstates 11 | 12 | # User-specific files (MonoDevelop/Xamarin Studio) 13 | *.userprefs 14 | 15 | # Build results 16 | [Dd]ebug/ 17 | [Dd]ebugPublic/ 18 | [Rr]elease/ 19 | [Rr]eleases/ 20 | x64/ 21 | x86/ 22 | bld/ 23 | [Bb]in/ 24 | [Oo]bj/ 25 | [Ll]og/ 26 | 27 | # Visual Studio 2015/2017 cache/options directory 28 | .vs/ 29 | # Uncomment if you have tasks that create the project's static files in wwwroot 30 | #wwwroot/ 31 | 32 | # Visual Studio 2017 auto generated files 33 | Generated\ Files/ 34 | 35 | # MSTest test Results 36 | [Tt]est[Rr]esult*/ 37 | [Bb]uild[Ll]og.* 38 | 39 | # NUNIT 40 | *.VisualState.xml 41 | TestResult.xml 42 | 43 | # Build Results of an ATL Project 44 | [Dd]ebugPS/ 45 | [Rr]eleasePS/ 46 | dlldata.c 47 | 48 | # Benchmark Results 49 | BenchmarkDotNet.Artifacts/ 50 | 51 | # .NET Core 52 | project.lock.json 53 | project.fragment.lock.json 54 | artifacts/ 55 | **/Properties/launchSettings.json 56 | 57 | # StyleCop 58 | StyleCopReport.xml 59 | 60 | # Files built by Visual Studio 61 | *_i.c 62 | *_p.c 63 | *_i.h 64 | *.ilk 65 | *.meta 66 | *.obj 67 | *.iobj 68 | *.pch 69 | *.pdb 70 | *.ipdb 71 | *.pgc 72 | *.pgd 73 | *.rsp 74 | *.sbr 75 | *.tlb 76 | *.tli 77 | *.tlh 78 | *.tmp 79 | *.tmp_proj 80 | *.log 81 | *.vspscc 82 | *.vssscc 83 | .builds 84 | *.pidb 85 | *.svclog 86 | *.scc 87 | 88 | # Chutzpah Test files 89 | _Chutzpah* 90 | 91 | # Visual C++ cache files 92 | ipch/ 93 | *.aps 94 | *.ncb 95 | *.opendb 96 | *.opensdf 97 | *.sdf 98 | *.cachefile 99 | *.VC.db 100 | *.VC.VC.opendb 101 | 102 | # Visual Studio profiler 103 | *.psess 104 | *.vsp 105 | *.vspx 106 | *.sap 107 | 108 | # Visual Studio Trace Files 109 | *.e2e 110 | 111 | # TFS 2012 Local Workspace 112 | $tf/ 113 | 114 | # Guidance Automation Toolkit 115 | *.gpState 116 | 117 | # ReSharper is a .NET coding add-in 118 | _ReSharper*/ 119 | *.[Rr]e[Ss]harper 120 | *.DotSettings.user 121 | 122 | # JustCode is a .NET coding add-in 123 | .JustCode 124 | 125 | # TeamCity is a build add-in 126 | _TeamCity* 127 | 128 | # DotCover is a Code Coverage Tool 129 | *.dotCover 130 | 131 | # AxoCover is a Code Coverage Tool 132 | .axoCover/* 133 | !.axoCover/settings.json 134 | 135 | # Visual Studio code coverage results 136 | *.coverage 137 | *.coveragexml 138 | 139 | # NCrunch 140 | _NCrunch_* 141 | .*crunch*.local.xml 142 | nCrunchTemp_* 143 | 144 | # MightyMoose 145 | *.mm.* 146 | AutoTest.Net/ 147 | 148 | # Web workbench (sass) 149 | .sass-cache/ 150 | 151 | # Installshield output folder 152 | [Ee]xpress/ 153 | 154 | # DocProject is a documentation generator add-in 155 | DocProject/buildhelp/ 156 | DocProject/Help/*.HxT 157 | DocProject/Help/*.HxC 158 | DocProject/Help/*.hhc 159 | DocProject/Help/*.hhk 160 | DocProject/Help/*.hhp 161 | DocProject/Help/Html2 162 | DocProject/Help/html 163 | 164 | # Click-Once directory 165 | publish/ 166 | 167 | # Publish Web Output 168 | *.[Pp]ublish.xml 169 | *.azurePubxml 170 | # Note: Comment the next line if you want to checkin your web deploy settings, 171 | # but database connection strings (with potential passwords) will be unencrypted 172 | *.pubxml 173 | *.publishproj 174 | 175 | # Microsoft Azure Web App publish settings. Comment the next line if you want to 176 | # checkin your Azure Web App publish settings, but sensitive information contained 177 | # in these scripts will be unencrypted 178 | PublishScripts/ 179 | 180 | # NuGet Packages 181 | *.nupkg 182 | # The packages folder can be ignored because of Package Restore 183 | **/[Pp]ackages/* 184 | # except build/, which is used as an MSBuild target. 185 | !**/[Pp]ackages/build/ 186 | # Uncomment if necessary however generally it will be regenerated when needed 187 | #!**/[Pp]ackages/repositories.config 188 | # NuGet v3's project.json files produces more ignorable files 189 | *.nuget.props 190 | *.nuget.targets 191 | 192 | # Microsoft Azure Build Output 193 | csx/ 194 | *.build.csdef 195 | 196 | # Microsoft Azure Emulator 197 | ecf/ 198 | rcf/ 199 | 200 | # Windows Store app package directories and files 201 | AppPackages/ 202 | BundleArtifacts/ 203 | Package.StoreAssociation.xml 204 | _pkginfo.txt 205 | *.appx 206 | 207 | # Visual Studio cache files 208 | # files ending in .cache can be ignored 209 | *.[Cc]ache 210 | # but keep track of directories ending in .cache 211 | !*.[Cc]ache/ 212 | 213 | # Others 214 | ClientBin/ 215 | ~$* 216 | *~ 217 | *.dbmdl 218 | *.dbproj.schemaview 219 | *.jfm 220 | *.pfx 221 | *.publishsettings 222 | orleans.codegen.cs 223 | 224 | # Including strong name files can present a security risk 225 | # (https://github.com/github/gitignore/pull/2483#issue-259490424) 226 | #*.snk 227 | 228 | # Since there are multiple workflows, uncomment next line to ignore bower_components 229 | # (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) 230 | #bower_components/ 231 | 232 | # RIA/Silverlight projects 233 | Generated_Code/ 234 | 235 | # Backup & report files from converting an old project file 236 | # to a newer Visual Studio version. Backup files are not needed, 237 | # because we have git ;-) 238 | _UpgradeReport_Files/ 239 | Backup*/ 240 | UpgradeLog*.XML 241 | UpgradeLog*.htm 242 | ServiceFabricBackup/ 243 | *.rptproj.bak 244 | 245 | # SQL Server files 246 | *.mdf 247 | *.ldf 248 | *.ndf 249 | 250 | # Business Intelligence projects 251 | *.rdl.data 252 | *.bim.layout 253 | *.bim_*.settings 254 | *.rptproj.rsuser 255 | 256 | # Microsoft Fakes 257 | FakesAssemblies/ 258 | 259 | # GhostDoc plugin setting file 260 | *.GhostDoc.xml 261 | 262 | # Node.js Tools for Visual Studio 263 | .ntvs_analysis.dat 264 | node_modules/ 265 | 266 | # Visual Studio 6 build log 267 | *.plg 268 | 269 | # Visual Studio 6 workspace options file 270 | *.opt 271 | 272 | # Visual Studio 6 auto-generated workspace file (contains which files were open etc.) 273 | *.vbw 274 | 275 | # Visual Studio LightSwitch build output 276 | **/*.HTMLClient/GeneratedArtifacts 277 | **/*.DesktopClient/GeneratedArtifacts 278 | **/*.DesktopClient/ModelManifest.xml 279 | **/*.Server/GeneratedArtifacts 280 | **/*.Server/ModelManifest.xml 281 | _Pvt_Extensions 282 | 283 | # Paket dependency manager 284 | .paket/paket.exe 285 | paket-files/ 286 | 287 | # FAKE - F# Make 288 | .fake/ 289 | 290 | # JetBrains Rider 291 | .idea/ 292 | *.sln.iml 293 | 294 | # CodeRush 295 | .cr/ 296 | 297 | # Python Tools for Visual Studio (PTVS) 298 | __pycache__/ 299 | *.pyc 300 | 301 | # Cake - Uncomment if you are using it 302 | # tools/** 303 | # !tools/packages.config 304 | 305 | # Tabs Studio 306 | *.tss 307 | 308 | # Telerik's JustMock configuration file 309 | *.jmconfig 310 | 311 | # BizTalk build output 312 | *.btp.cs 313 | *.btm.cs 314 | *.odx.cs 315 | *.xsd.cs 316 | 317 | # OpenCover UI analysis results 318 | OpenCover/ 319 | 320 | # Azure Stream Analytics local run output 321 | ASALocalRun/ 322 | 323 | # MSBuild Binary and Structured Log 324 | *.binlog 325 | 326 | # NVidia Nsight GPU debugger configuration file 327 | *.nvuser 328 | 329 | # MFractors (Xamarin productivity tool) working folder 330 | .mfractor/ 331 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: csharp 2 | mono: none 3 | dotnet: 2.1.402 4 | script: 5 | - dotnet build 6 | -------------------------------------------------------------------------------- /Alga.FSharp.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("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Alga.FSharp", "Alga.FSharp\Alga.FSharp.fsproj", "{12B62776-D946-46B6-BCDC-FF62F00B1819}" 7 | EndProject 8 | Global 9 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 10 | Debug|Any CPU = Debug|Any CPU 11 | Debug|x64 = Debug|x64 12 | Debug|x86 = Debug|x86 13 | Release|Any CPU = Release|Any CPU 14 | Release|x64 = Release|x64 15 | Release|x86 = Release|x86 16 | EndGlobalSection 17 | GlobalSection(SolutionProperties) = preSolution 18 | HideSolutionNode = FALSE 19 | EndGlobalSection 20 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 21 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 22 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Debug|Any CPU.Build.0 = Debug|Any CPU 23 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Debug|x64.ActiveCfg = Debug|Any CPU 24 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Debug|x64.Build.0 = Debug|Any CPU 25 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Debug|x86.ActiveCfg = Debug|Any CPU 26 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Debug|x86.Build.0 = Debug|Any CPU 27 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Release|Any CPU.ActiveCfg = Release|Any CPU 28 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Release|Any CPU.Build.0 = Release|Any CPU 29 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Release|x64.ActiveCfg = Release|Any CPU 30 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Release|x64.Build.0 = Release|Any CPU 31 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Release|x86.ActiveCfg = Release|Any CPU 32 | {12B62776-D946-46B6-BCDC-FF62F00B1819}.Release|x86.Build.0 = Release|Any CPU 33 | EndGlobalSection 34 | EndGlobal 35 | -------------------------------------------------------------------------------- /Alga.FSharp/AdjacencyMap.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp.Internal 2 | 3 | open Alga.FSharp 4 | open Alga.FSharp.AdjacencyMap.Internal 5 | 6 | (* 7 | Module : Algebra.Graph.AdjacencyMap 8 | Copyright : (c) Andrey Mokhov 2016-2018 9 | License : MIT (see the file LICENSE) 10 | Maintainer : andrey.mokhov@gmail.com 11 | Stability : experimental 12 | 13 | __Alga__ is a library for algebraic construction and manipulation of graphs 14 | in Haskell. See for the 15 | motivation behind the library, the underlying theory, and implementation details. 16 | 17 | This module defines the 'AdjacencyMap' data type, as well as associated 18 | operations and algorithms. 'AdjacencyMap' is an instance of the 'C.Graph' type 19 | class, which can be used for polymorphic graph construction and manipulation. 20 | "Algebra.Graph.AdjacencyIntMap" defines adjacency maps specialised to graphs 21 | with @Int@ vertices. 22 | *) 23 | 24 | [] 25 | module AdjacencyMap = 26 | 27 | /// Construct the graph comprising /a single edge/. 28 | /// Complexity: /O(1)/ time, memory. 29 | /// 30 | /// @ 31 | /// edge x y == 'connect' ('vertex' x) ('vertex' y) 32 | /// 'hasEdge' x y (edge x y) == True 33 | /// 'edgeCount' (edge x y) == 1 34 | /// 'vertexCount' (edge 1 1) == 1 35 | /// 'vertexCount' (edge 1 2) == 2 36 | /// @ 37 | let edge (x : 'a) (y : 'a) : 'a AdjacencyMap = 38 | if x = y then 39 | Map.singleton x (y |> Set.singleton) |> AdjacencyMap 40 | else 41 | [(x, Set.singleton y) ; (y, Set.empty)] |> Map.ofSeq |> AdjacencyMap 42 | 43 | /// Construct the graph comprising a given list of isolated vertices. 44 | /// Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length 45 | /// of the given list. 46 | /// 47 | /// @ 48 | /// vertices [] == 'empty' 49 | /// vertices [x] == 'vertex' x 50 | /// 'hasVertex' x . vertices == 'elem' x 51 | /// 'vertexCount' . vertices == 'length' . 'Data.List.nub' 52 | /// 'vertexSet' . vertices == Set.'Set.fromList' 53 | /// @ 54 | let vertices (vs : 'a seq) : 'a AdjacencyMap = 55 | vs |> Seq.map (fun v -> v, Set.empty) |> Map.ofSeq |> AdjacencyMap 56 | 57 | /// Construct the graph from a list of edges. 58 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 59 | /// 60 | /// @ 61 | /// edges [] == 'empty' 62 | /// edges [(x,y)] == 'edge' x y 63 | /// 'edgeCount' . edges == 'length' . 'Data.List.nub' 64 | /// 'edgeList' . edges == 'Data.List.nub' . 'Data.List.sort' 65 | /// @ 66 | let edges (es : ('a * 'a) seq) : 'a AdjacencyMap = 67 | es |> Seq.map (fun (v1, v2) -> v1, Set.singleton v2) |> AdjacencyMap.fromAdjacencySets 68 | 69 | /// Overlay a given list of graphs. 70 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 71 | /// 72 | /// @ 73 | /// overlays [] == 'empty' 74 | /// overlays [x] == x 75 | /// overlays [x,y] == 'overlay' x y 76 | /// overlays == 'foldr' 'overlay' 'empty' 77 | /// 'isEmpty' . overlays == 'all' 'isEmpty' 78 | /// @ 79 | let overlays (ams : 'a AdjacencyMap seq) : 'a AdjacencyMap = 80 | ams |> Seq.map (fun (AdjacencyMap m) -> m) |> Map.unionsWith Set.union |> AdjacencyMap 81 | 82 | /// Connect a given list of graphs. 83 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 84 | /// 85 | /// @ 86 | /// connects [] == 'empty' 87 | /// connects [x] == x 88 | /// connects [x,y] == 'connect' x y 89 | /// connects == 'foldr' 'connect' 'empty' 90 | /// 'isEmpty' . connects == 'all' 'isEmpty' 91 | /// @ 92 | let connects (ams : 'a AdjacencyMap seq) : 'a AdjacencyMap = 93 | Seq.fold AdjacencyMap.connect AdjacencyMap.empty ams 94 | 95 | /// The 'isSubgraphOf' function takes two graphs and returns 'True' if the 96 | /// first graph is a /subgraph/ of the second. 97 | /// Complexity: /O((n + m) * log(n))/ time. 98 | /// 99 | /// @ 100 | /// isSubgraphOf 'empty' x == True 101 | /// isSubgraphOf ('vertex' x) 'empty' == False 102 | /// isSubgraphOf x ('overlay' x y) == True 103 | /// isSubgraphOf ('overlay' x y) ('connect' x y) == True 104 | /// isSubgraphOf ('path' xs) ('circuit' xs) == True 105 | /// @ 106 | let isSubgraphOf (AdjacencyMap x) (AdjacencyMap y) : bool = 107 | Map.isSubmapOfBy Set.isSubset x y 108 | 109 | /// Check if a graph is empty. 110 | /// Complexity: /O(1)/ time. 111 | /// 112 | /// @ 113 | /// isEmpty 'empty' == True 114 | /// isEmpty ('overlay' 'empty' 'empty') == True 115 | /// isEmpty ('vertex' x) == False 116 | /// isEmpty ('removeVertex' x $ 'vertex' x) == True 117 | /// isEmpty ('removeEdge' x y $ 'edge' x y) == False 118 | /// @ 119 | let isEmpty (AdjacencyMap m) : bool = 120 | m |> Map.isEmpty 121 | 122 | /// Check if a graph contains a given vertex. 123 | /// Complexity: /O(log(n))/ time. 124 | /// 125 | /// @ 126 | /// hasVertex x 'empty' == False 127 | /// hasVertex x ('vertex' x) == True 128 | /// hasVertex 1 ('vertex' 2) == False 129 | /// hasVertex x . 'removeVertex' x == const False 130 | /// @ 131 | let hasVertex (v : 'a) (AdjacencyMap m) : bool = 132 | Map.containsKey v m 133 | 134 | /// Check if a graph contains a given edge. 135 | /// Complexity: /O(log(n))/ time. 136 | /// 137 | /// @ 138 | /// hasEdge x y 'empty' == False 139 | /// hasEdge x y ('vertex' z) == False 140 | /// hasEdge x y ('edge' x y) == True 141 | /// hasEdge x y . 'removeEdge' x y == const False 142 | /// hasEdge x y == 'elem' (x,y) . 'edgeList' 143 | /// @ 144 | let hasEdge (u : 'a) (v : 'a) (AdjacencyMap m) : bool = 145 | match Map.tryFind u m with 146 | | None -> false 147 | | Some vs -> Set.contains v vs 148 | 149 | /// The number of vertices in a graph. 150 | /// Complexity: /O(1)/ time. 151 | /// 152 | /// @ 153 | /// vertexCount 'empty' == 0 154 | /// vertexCount ('vertex' x) == 1 155 | /// vertexCount == 'length' . 'vertexList' 156 | /// @ 157 | let vertexCount (AdjacencyMap m) : int = 158 | Map.count m 159 | 160 | /// The number of edges in a graph. 161 | /// Complexity: /O(n)/ time. 162 | /// 163 | /// @ 164 | /// edgeCount 'empty' == 0 165 | /// edgeCount ('vertex' x) == 0 166 | /// edgeCount ('edge' x y) == 1 167 | /// edgeCount == 'length' . 'edgeList' 168 | /// @ 169 | //edgeCount :: AdjacencyMap a -> Int 170 | //edgeCount = getSum . foldMap (Sum . Set.size) . adjacencyMap 171 | let edgeCount (AdjacencyMap m) : int = 172 | m |> Map.fold (fun s k v -> s + (v |> Set.count)) 0 173 | 174 | /// The sorted list of vertices of a given graph. 175 | /// Complexity: /O(n)/ time and memory. 176 | /// 177 | /// @ 178 | /// vertexList 'empty' == [] 179 | /// vertexList ('vertex' x) == [x] 180 | /// vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' 181 | /// @ 182 | //vertexList :: AdjacencyMap a -> [a] 183 | //vertexList = Map.keys . adjacencyMap 184 | let vertexList (AdjacencyMap m) : 'a seq = 185 | m |> Map.keys 186 | 187 | /// The sorted list of edges of a graph. 188 | /// Complexity: /O(n + m)/ time and /O(m)/ memory. 189 | /// 190 | /// @ 191 | /// edgeList 'empty' == [] 192 | /// edgeList ('vertex' x) == [] 193 | /// edgeList ('edge' x y) == [(x,y)] 194 | /// edgeList ('star' 2 [3,1]) == [(2,1), (2,3)] 195 | /// edgeList . 'edges' == 'Data.List.nub' . 'Data.List.sort' 196 | /// edgeList . 'transpose' == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList 197 | /// @ 198 | let edgeList (AdjacencyMap m) : ('a * 'a) seq = 199 | seq { 200 | for (x, ys) in m |> Map.toSeq do 201 | for y in ys do 202 | yield x, y 203 | } 204 | 205 | /// The set of vertices of a given graph. 206 | /// Complexity: /O(n)/ time and memory. 207 | /// 208 | /// @ 209 | /// vertexSet 'empty' == Set.'Set.empty' 210 | /// vertexSet . 'vertex' == Set.'Set.singleton' 211 | /// vertexSet . 'vertices' == Set.'Set.fromList' 212 | /// vertexSet . 'clique' == Set.'Set.fromList' 213 | /// @ 214 | //vertexSet :: AdjacencyMap a -> Set a 215 | //vertexSet = Map.keysSet . adjacencyMap 216 | let vertexSet (AdjacencyMap m) : 'a Set = 217 | m |> Map.keysSet 218 | 219 | /// The set of edges of a given graph. 220 | /// Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory. 221 | /// 222 | /// @ 223 | /// edgeSet 'empty' == Set.'Set.empty' 224 | /// edgeSet ('vertex' x) == Set.'Set.empty' 225 | /// edgeSet ('edge' x y) == Set.'Set.singleton' (x,y) 226 | /// edgeSet . 'edges' == Set.'Set.fromList' 227 | /// @ 228 | let edgeSet (am : 'a AdjacencyMap) : ('a * 'a) Set = 229 | am |> edgeList |> Set.ofSeq 230 | 231 | /// The sorted /adjacency list/ of a graph. 232 | /// Complexity: /O(n + m)/ time and /O(m)/ memory. 233 | /// 234 | /// @ 235 | /// adjacencyList 'empty' == [] 236 | /// adjacencyList ('vertex' x) == [(x, [])] 237 | /// adjacencyList ('edge' 1 2) == [(1, [2]), (2, [])] 238 | /// adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])] 239 | /// 'stars' . adjacencyList == id 240 | /// @ 241 | let adjacencyList (AdjacencyMap m) : ('a * 'a seq) seq = 242 | m |> Map.toSeq |> Seq.map (fun (k, v) -> k, v |> Set.toSeq) 243 | 244 | /// The /preset/ of an element @x@ is the set of its /direct predecessors/. 245 | /// Complexity: /O(n * log(n))/ time and /O(n)/ memory. 246 | /// 247 | /// @ 248 | /// preSet x 'empty' == Set.'Set.empty' 249 | /// preSet x ('vertex' x) == Set.'Set.empty' 250 | /// preSet 1 ('edge' 1 2) == Set.'Set.empty' 251 | /// preSet y ('edge' x y) == Set.'Set.fromList' [x] 252 | /// @ 253 | let preSet (v : 'a) (AdjacencyMap m) : 'a Set = 254 | let p (_, set) = set |> Set.contains v 255 | m |> Map.toSeq |> Seq.filter p |> Seq.map fst |> Set.ofSeq 256 | 257 | /// The /postset/ of a vertex is the set of its /direct successors/. 258 | /// Complexity: /O(log(n))/ time and /O(1)/ memory. 259 | /// 260 | /// @ 261 | /// postSet x 'empty' == Set.'Set.empty' 262 | /// postSet x ('vertex' x) == Set.'Set.empty' 263 | /// postSet x ('edge' x y) == Set.'Set.fromList' [y] 264 | /// postSet 2 ('edge' 1 2) == Set.'Set.empty' 265 | /// @ 266 | let postSet (v : 'a) (AdjacencyMap m) : 'a Set = 267 | defaultArg (Map.tryFind v m) Set.empty 268 | 269 | /// The /path/ on a list of vertices. 270 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 271 | /// 272 | /// @ 273 | /// path [] == 'empty' 274 | /// path [x] == 'vertex' x 275 | /// path [x,y] == 'edge' x y 276 | /// path . 'reverse' == 'transpose' . path 277 | /// @ 278 | let path (xs : 'a list) : 'a AdjacencyMap = 279 | match xs with 280 | | [] -> AdjacencyMap.empty 281 | | [x] -> AdjacencyMap.vertex x 282 | | (_::ys) -> edges (List.zip xs ys) 283 | 284 | /// The /circuit/ on a list of vertices. 285 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 286 | /// 287 | /// @ 288 | /// circuit [] == 'empty' 289 | /// circuit [x] == 'edge' x x 290 | /// circuit [x,y] == 'edges' [(x,y), (y,x)] 291 | /// circuit . 'reverse' == 'transpose' . circuit 292 | /// @ 293 | let circuit (vs : 'a list) : 'a AdjacencyMap = 294 | match vs with 295 | | [] -> AdjacencyMap.empty 296 | | x::_ -> vs @ [x] |> path 297 | 298 | /// The /clique/ on a list of vertices. 299 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 300 | /// 301 | /// @ 302 | /// clique [] == 'empty' 303 | /// clique [x] == 'vertex' x 304 | /// clique [x,y] == 'edge' x y 305 | /// clique [x,y,z] == 'edges' [(x,y), (x,z), (y,z)] 306 | /// clique (xs ++ ys) == 'connect' (clique xs) (clique ys) 307 | /// clique . 'reverse' == 'transpose' . clique 308 | /// @ 309 | let clique (vs : 'a list) : 'a AdjacencyMap = 310 | let rec go = 311 | function 312 | | [] -> ([], Set.empty) 313 | | x::xs -> let (res, set) = go xs in (x, set) :: res, Set.add x set 314 | vs |> go |> fst |> AdjacencyMap.fromAdjacencySets 315 | 316 | /// The /biclique/ on two lists of vertices. 317 | /// Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory. 318 | /// 319 | /// @ 320 | /// biclique [] [] == 'empty' 321 | /// biclique [x] [] == 'vertex' x 322 | /// biclique [] [y] == 'vertex' y 323 | /// biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] 324 | /// biclique xs ys == 'connect' ('vertices' xs) ('vertices' ys) 325 | /// @ 326 | let biclique (xs : 'a seq) (ys : 'a seq) : 'a AdjacencyMap = 327 | let x = xs |> Set.ofSeq 328 | let y = ys |> Set.ofSeq 329 | let adjacent v = if Set.contains v x then y else Set.empty 330 | (Set.union x y) |> Map.fromSet adjacent |> AdjacencyMap 331 | 332 | /// TODO: Optimise. 333 | /// The /star/ formed by a centre vertex connected to a list of leaves. 334 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 335 | /// 336 | /// @ 337 | /// star x [] == 'vertex' x 338 | /// star x [y] == 'edge' x y 339 | /// star x [y,z] == 'edges' [(x,y), (x,z)] 340 | /// star x ys == 'connect' ('vertex' x) ('vertices' ys) 341 | /// @ 342 | let star (x : 'a) (ys : 'a list) : 'a AdjacencyMap = 343 | match ys with 344 | | [] -> AdjacencyMap.vertex x 345 | | _ -> AdjacencyMap.connect (AdjacencyMap.vertex x) (vertices ys) 346 | 347 | /// The /stars/ formed by overlaying a list of 'star's. An inverse of 348 | /// 'adjacencyList'. 349 | /// Complexity: /O(L * log(n))/ time, memory and size, where /L/ is the total 350 | /// size of the input. 351 | /// 352 | /// @ 353 | /// stars [] == 'empty' 354 | /// stars [(x, [])] == 'vertex' x 355 | /// stars [(x, [y])] == 'edge' x y 356 | /// stars [(x, ys)] == 'star' x ys 357 | /// stars == 'overlays' . map (uncurry 'star') 358 | /// stars . 'adjacencyList' == id 359 | /// 'overlay' (stars xs) (stars ys) == stars (xs ++ ys) 360 | /// @ 361 | let stars (stars : ('a * 'a list) seq) : 'a AdjacencyMap = 362 | stars |> Seq.map (fun (v, vs) -> v, vs |> Set.ofList) |> AdjacencyMap.fromAdjacencySets 363 | 364 | /// The /tree graph/ constructed from a given 'Tree' data structure. 365 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 366 | /// 367 | /// @ 368 | /// tree (Node x []) == 'vertex' x 369 | /// tree (Node x [Node y [Node z []]]) == 'path' [x,y,z] 370 | /// tree (Node x [Node y [], Node z []]) == 'star' x [y,z] 371 | /// tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] 372 | /// @ 373 | let rec tree (tree : 'a Tree) : 'a AdjacencyMap = 374 | match tree.SubForest with 375 | | [] -> AdjacencyMap.vertex tree.RootLabel 376 | | f -> 377 | AdjacencyMap.overlay 378 | (f |> List.map (fun t -> t.RootLabel) |> star tree.RootLabel) 379 | (f |> List.filter (fun t -> t.SubForest |> List.isEmpty |> not) |> forest) 380 | 381 | // The /forest graph/ constructed from a given 'Forest' data structure. 382 | // Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 383 | // 384 | // @ 385 | // forest [] == 'empty' 386 | // forest [x] == 'tree' x 387 | // forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)] 388 | // forest == 'overlays' . map 'tree' 389 | // @ 390 | and forest (f : 'a Forest) : 'a AdjacencyMap = 391 | f |> List.map tree |> overlays 392 | 393 | /// Remove a vertex from a given graph. 394 | /// Complexity: /O(n*log(n))/ time. 395 | /// 396 | /// @ 397 | /// removeVertex x ('vertex' x) == 'empty' 398 | /// removeVertex 1 ('vertex' 2) == 'vertex' 2 399 | /// removeVertex x ('edge' x x) == 'empty' 400 | /// removeVertex 1 ('edge' 1 2) == 'vertex' 2 401 | /// removeVertex x . removeVertex x == removeVertex x 402 | /// @ 403 | let removeVertex (v : 'a) (AdjacencyMap m) : 'a AdjacencyMap = 404 | m |> Map.remove v |> Map.map (fun _ s -> s |> Set.remove v) |> AdjacencyMap 405 | 406 | /// Remove an edge from a given graph. 407 | /// Complexity: /O(log(n))/ time. 408 | /// 409 | /// @ 410 | /// removeEdge x y ('edge' x y) == 'vertices' [x,y] 411 | /// removeEdge x y . removeEdge x y == removeEdge x y 412 | /// removeEdge x y . 'removeVertex' x == 'removeVertex' x 413 | /// removeEdge 1 1 (1 * 1 * 2 * 2) == 1 * 2 * 2 414 | /// removeEdge 1 2 (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2 415 | /// @ 416 | let removeEdge (x : 'a) (y : 'a) (AdjacencyMap m) : 'a AdjacencyMap = 417 | m |> Map.adjust (Set.remove y) x |> AdjacencyMap 418 | 419 | /// Transform a graph by applying a function to each of its vertices. This is 420 | /// similar to @Functor@'s 'fmap' but can be used with non-fully-parametric 421 | /// 'AdjacencyMap'. 422 | /// Complexity: /O((n + m) * log(n))/ time. 423 | /// 424 | /// @ 425 | /// gmap f 'empty' == 'empty' 426 | /// gmap f ('vertex' x) == 'vertex' (f x) 427 | /// gmap f ('edge' x y) == 'edge' (f x) (f y) 428 | /// gmap id == id 429 | /// gmap f . gmap g == gmap (f . g) 430 | /// @ 431 | let gmap (f : 'a -> 'b) (AdjacencyMap m) : 'b AdjacencyMap = 432 | m |> Map.mapKeysWith Set.union f |> Map.map (fun _ v -> Set.map f v) |> AdjacencyMap 433 | 434 | /// The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a 435 | /// given 'AdjacencyMap'. If @y@ already exists, @x@ and @y@ will be merged. 436 | /// Complexity: /O((n + m) * log(n))/ time. 437 | /// 438 | /// @ 439 | /// replaceVertex x x == id 440 | /// replaceVertex x y ('vertex' x) == 'vertex' y 441 | /// replaceVertex x y == 'mergeVertices' (== x) y 442 | /// @ 443 | let replaceVertex (u : 'a) (v : 'a) (am : 'a AdjacencyMap) : 'a AdjacencyMap = 444 | gmap (fun w -> if w = u then v else w) am 445 | 446 | /// Merge vertices satisfying a given predicate into a given vertex. 447 | /// Complexity: /O((n + m) * log(n))/ time, assuming that the predicate takes 448 | /// /O(1)/ to be evaluated. 449 | /// 450 | /// @ 451 | /// mergeVertices (const False) x == id 452 | /// mergeVertices (== x) y == 'replaceVertex' x y 453 | /// mergeVertices even 1 (0 * 2) == 1 * 1 454 | /// mergeVertices odd 1 (3 + 4 * 5) == 4 * 1 455 | /// @ 456 | let mergeVertices (p : 'a -> bool) (v : 'a) (am : 'a AdjacencyMap) : 'a AdjacencyMap = 457 | gmap (fun u -> if p u then v else u) am 458 | 459 | /// Transpose a given graph. 460 | /// Complexity: /O(m * log(n))/ time, /O(n + m)/ memory. 461 | /// 462 | /// @ 463 | /// transpose 'empty' == 'empty' 464 | /// transpose ('vertex' x) == 'vertex' x 465 | /// transpose ('edge' x y) == 'edge' y x 466 | /// transpose . transpose == id 467 | /// 'edgeList' . transpose == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' 468 | /// @ 469 | let transpose (AdjacencyMap m) : 'a AdjacencyMap = 470 | let combine s v es = Map.unionWith Set.union (Map.fromSet (fun _ -> Set.singleton v) es) s 471 | let vs = Map.fromSet (fun _ -> Set.empty) (Map.keysSet m) 472 | m |> Map.fold combine vs |> AdjacencyMap 473 | 474 | //{-# RULES 475 | //"transpose/empty" transpose empty = empty 476 | //"transpose/vertex" forall x. transpose (vertex x) = vertex x 477 | //"transpose/overlay" forall g1 g2. transpose (overlay g1 g2) = overlay (transpose g1) (transpose g2) 478 | //"transpose/connect" forall g1 g2. transpose (connect g1 g2) = connect (transpose g2) (transpose g1) 479 | 480 | //"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs) 481 | //"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs)) 482 | 483 | //"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs 484 | //"transpose/clique" forall xs. transpose (clique xs) = clique (reverse xs) 485 | // #-} 486 | 487 | /// Construct the /induced subgraph/ of a given graph by removing the 488 | /// vertices that do not satisfy a given predicate. 489 | /// Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to 490 | /// be evaluated. 491 | /// 492 | /// @ 493 | /// induce (const True ) x == x 494 | /// induce (const False) x == 'empty' 495 | /// induce (/= x) == 'removeVertex' x 496 | /// induce p . induce q == induce (\\x -> p x && q x) 497 | /// 'isSubgraphOf' (induce p x) x == True 498 | /// @ 499 | let induce (p : 'a -> bool) (AdjacencyMap m) : 'a AdjacencyMap = 500 | m |> Map.filter (fun k _ -> p k) |> Map.map (fun k v -> v |> Set.filter p) |> AdjacencyMap 501 | 502 | /// Build 'GraphKL' from an 'AdjacencyMap'. 503 | /// If @fromAdjacencyMap g == h@ then the following holds: 504 | /// 505 | /// @ 506 | /// map ('fromVertexKL' h) ('Data.Graph.vertices' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyMap.vertexList' g 507 | /// map (\\(x, y) -> ('fromVertexKL' h x, 'fromVertexKL' h y)) ('Data.Graph.edges' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyMap.edgeList' g 508 | /// 'toGraphKL' (fromAdjacencyMap (1 * 2 + 3 * 1)) == 'array' (0,2) [(0,[1]), (1,[]), (2,[0])] 509 | /// 'toGraphKL' (fromAdjacencyMap (1 * 2 + 2 * 1)) == 'array' (0,1) [(0,[1]), (1,[0])] 510 | /// @ 511 | let toTyped (AdjacencyMap m) : 'a GraphKL = 512 | let g, r, t = m |> Map.toSeq |> Seq.sort |> Seq.map (fun (v, us) -> (), v, us |> Set.toSeq) |> Untyped.graphFromEdges 513 | { 514 | ToGraphKL = g 515 | FromVertexKL = fun u -> let (_, v, _) = r u in v 516 | ToVertexKL = t 517 | } 518 | 519 | /// Compute the /depth-first search/ forest of a graph that corresponds to 520 | /// searching from each of the graph vertices in the 'Ord' @a@ order. 521 | /// 522 | /// @ 523 | /// dfsForest 'empty' == [] 524 | /// 'forest' (dfsForest $ 'edge' 1 1) == 'vertex' 1 525 | /// 'forest' (dfsForest $ 'edge' 1 2) == 'edge' 1 2 526 | /// 'forest' (dfsForest $ 'edge' 2 1) == 'vertices' [1,2] 527 | /// 'isSubgraphOf' ('forest' $ dfsForest x) x == True 528 | /// 'isDfsForestOf' (dfsForest x) x == True 529 | /// dfsForest . 'forest' . dfsForest == dfsForest 530 | /// dfsForest ('vertices' vs) == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs) 531 | /// 'dfsForestFrom' ('vertexList' x) x == dfsForest x 532 | /// dfsForest $ 3 * (1 + 4) * (1 + 5) == [ Node { rootLabel = 1 533 | /// , subForest = [ Node { rootLabel = 5 534 | /// , subForest = [] }]} 535 | /// , Node { rootLabel = 3 536 | /// , subForest = [ Node { rootLabel = 4 537 | /// , subForest = [] }]}] 538 | /// @ 539 | let rec dfsForest (g : 'a AdjacencyMap) : 'a Forest = 540 | g |> dfsForestFrom (vertexList g) 541 | 542 | /// Compute the /depth-first search/ forest of a graph, searching from each of 543 | /// the given vertices in order. Note that the resulting forest does not 544 | /// necessarily span the whole graph, as some vertices may be unreachable. 545 | /// 546 | /// @ 547 | /// dfsForestFrom vs 'empty' == [] 548 | /// 'forest' (dfsForestFrom [1] $ 'edge' 1 1) == 'vertex' 1 549 | /// 'forest' (dfsForestFrom [1] $ 'edge' 1 2) == 'edge' 1 2 550 | /// 'forest' (dfsForestFrom [2] $ 'edge' 1 2) == 'vertex' 2 551 | /// 'forest' (dfsForestFrom [3] $ 'edge' 1 2) == 'empty' 552 | /// 'forest' (dfsForestFrom [2,1] $ 'edge' 1 2) == 'vertices' [1,2] 553 | /// 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x == True 554 | /// 'isDfsForestOf' (dfsForestFrom ('vertexList' x) x) x == True 555 | /// dfsForestFrom ('vertexList' x) x == 'dfsForest' x 556 | /// dfsForestFrom vs ('vertices' vs) == map (\\v -> Node v []) ('Data.List.nub' vs) 557 | /// dfsForestFrom [] x == [] 558 | /// dfsForestFrom [1,4] $ 3 * (1 + 4) * (1 + 5) == [ Node { rootLabel = 1 559 | /// , subForest = [ Node { rootLabel = 5 560 | /// , subForest = [] } 561 | /// , Node { rootLabel = 4 562 | /// , subForest = [] }] 563 | /// @ 564 | and dfsForestFrom (vs : 'a seq) (g : 'a AdjacencyMap) : 'a Forest = 565 | g |> toTyped |> Typed.dfsForestFrom vs 566 | 567 | /// Compute the list of vertices visited by the /depth-first search/ in a 568 | /// graph, when searching from each of the given vertices in order. 569 | /// 570 | /// @ 571 | /// dfs vs $ 'empty' == [] 572 | /// dfs [1] $ 'edge' 1 1 == [1] 573 | /// dfs [1] $ 'edge' 1 2 == [1,2] 574 | /// dfs [2] $ 'edge' 1 2 == [2] 575 | /// dfs [3] $ 'edge' 1 2 == [] 576 | /// dfs [1,2] $ 'edge' 1 2 == [1,2] 577 | /// dfs [2,1] $ 'edge' 1 2 == [2,1] 578 | /// dfs [] $ x == [] 579 | /// dfs [1,4] $ 3 * (1 + 4) * (1 + 5) == [1,5,4] 580 | /// 'isSubgraphOf' ('vertices' $ dfs vs x) x == True 581 | /// @ 582 | let dfs (vs : 'a seq) (am : 'a AdjacencyMap) : 'a seq = 583 | am |> dfsForestFrom vs |> Seq.collect Tree.flatten 584 | 585 | // Compute the list of vertices that are /reachable/ from a given source 586 | // vertex in a graph. The vertices in the resulting list appear in the 587 | // /depth-first order/. 588 | // 589 | // @ 590 | // reachable x $ 'empty' == [] 591 | // reachable 1 $ 'vertex' 1 == [1] 592 | // reachable 1 $ 'vertex' 2 == [] 593 | // reachable 1 $ 'edge' 1 1 == [1] 594 | // reachable 1 $ 'edge' 1 2 == [1,2] 595 | // reachable 4 $ 'path' [1..8] == [4..8] 596 | // reachable 4 $ 'circuit' [1..8] == [4..8] ++ [1..3] 597 | // reachable 8 $ 'clique' [8,7..1] == [8] ++ [1..7] 598 | // 'isSubgraphOf' ('vertices' $ reachable x y) y == True 599 | // @ 600 | let reachable (x : 'a) (am : 'a AdjacencyMap) : 'a seq = 601 | dfs (Seq.singleton x) am 602 | 603 | /// Check if a given list of vertices is a correct /topological sort/ of a graph. 604 | /// 605 | /// @ 606 | /// isTopSortOf [3,1,2] (1 * 2 + 3 * 1) == True 607 | /// isTopSortOf [1,2,3] (1 * 2 + 3 * 1) == False 608 | /// isTopSortOf [] (1 * 2 + 3 * 1) == False 609 | /// isTopSortOf [] 'empty' == True 610 | /// isTopSortOf [x] ('vertex' x) == True 611 | /// isTopSortOf [x] ('edge' x x) == False 612 | /// @ 613 | let isTopSortOf (xs : 'a seq) ((AdjacencyMap m) as am) : bool = 614 | let rec go seen = 615 | function 616 | | [] -> seen = Map.keysSet m 617 | | v::vs -> 618 | let newSeen = Set.add v seen 619 | Set.intersect (postSet v am) newSeen = Set.empty && go newSeen vs 620 | xs |> Seq.toList |> go Set.empty 621 | 622 | /// Compute the /topological sort/ of a graph or return @Nothing@ if the graph 623 | /// is cyclic. 624 | /// 625 | /// @ 626 | /// topSort (1 * 2 + 3 * 1) == Just [3,1,2] 627 | /// topSort (1 * 2 + 2 * 1) == Nothing 628 | /// fmap (flip 'isTopSortOf' x) (topSort x) /= Just False 629 | /// 'isJust' . topSort == 'isAcyclic' 630 | /// @ 631 | let topSort (m : 'a AdjacencyMap) : 'a seq option = 632 | let result = Typed.topSort (toTyped m) 633 | if isTopSortOf result m then Some result else None 634 | 635 | /// Check if a given graph is /acyclic/. 636 | /// 637 | /// @ 638 | /// isAcyclic (1 * 2 + 3 * 1) == True 639 | /// isAcyclic (1 * 2 + 2 * 1) == False 640 | /// isAcyclic . 'circuit' == 'null' 641 | /// isAcyclic == 'isJust' . 'topSort' 642 | /// @ 643 | let isAcyclic (am : 'a AdjacencyMap) : bool = 644 | am |> topSort |> Option.isSome 645 | 646 | /// Compute the /condensation/ of a graph, where each vertex corresponds to a 647 | /// /strongly-connected component/ of the original graph. 648 | /// 649 | /// @ 650 | /// scc 'empty' == 'empty' 651 | /// scc ('vertex' x) == 'vertex' (Set.'Set.singleton' x) 652 | /// scc ('edge' x y) == 'edge' (Set.'Set.singleton' x) (Set.'Set.singleton' y) 653 | /// scc ('circuit' (1:xs)) == 'edge' (Set.'Set.fromList' (1:xs)) (Set.'Set.fromList' (1:xs)) 654 | /// scc (3 * 1 * 4 * 1 * 5) == 'edges' [ (Set.'Set.fromList' [1,4], Set.'Set.fromList' [1,4]) 655 | /// , (Set.'Set.fromList' [1,4], Set.'Set.fromList' [5] ) 656 | /// , (Set.'Set.fromList' [3] , Set.'Set.fromList' [1,4]) 657 | /// , (Set.'Set.fromList' [3] , Set.'Set.fromList' [5] )] 658 | /// @ 659 | let scc (m : 'a AdjacencyMap) : 'a Set AdjacencyMap = 660 | let g = toTyped m 661 | let expand xs = let s = Set.ofList xs in xs |> Seq.map (fun x -> x, s) 662 | let components = g.ToGraphKL |> Untyped.scc |> Seq.collect (Tree.toList >> List.map g.FromVertexKL >> expand) |> Map.ofSeq 663 | gmap (fun v -> defaultArg (Map.tryFind v components) Set.empty) m 664 | 665 | /// Check if a given forest is a correct /depth-first search/ forest of a graph. 666 | /// The implementation is based on the paper "Depth-First Search and Strong 667 | /// Connectivity in Coq" by François Pottier. 668 | /// 669 | /// @ 670 | /// isDfsForestOf [] 'empty' == True 671 | /// isDfsForestOf [] ('vertex' 1) == False 672 | /// isDfsForestOf [Node 1 []] ('vertex' 1) == True 673 | /// isDfsForestOf [Node 1 []] ('vertex' 2) == False 674 | /// isDfsForestOf [Node 1 [], Node 1 []] ('vertex' 1) == False 675 | /// isDfsForestOf [Node 1 []] ('edge' 1 1) == True 676 | /// isDfsForestOf [Node 1 []] ('edge' 1 2) == False 677 | /// isDfsForestOf [Node 1 [], Node 2 []] ('edge' 1 2) == False 678 | /// isDfsForestOf [Node 2 [], Node 1 []] ('edge' 1 2) == True 679 | /// isDfsForestOf [Node 1 [Node 2 []]] ('edge' 1 2) == True 680 | /// isDfsForestOf [Node 1 [], Node 2 []] ('vertices' [1,2]) == True 681 | /// isDfsForestOf [Node 2 [], Node 1 []] ('vertices' [1,2]) == True 682 | /// isDfsForestOf [Node 1 [Node 2 []]] ('vertices' [1,2]) == False 683 | /// isDfsForestOf [Node 1 [Node 2 [Node 3 []]]] ('path' [1,2,3]) == True 684 | /// isDfsForestOf [Node 1 [Node 3 [Node 2 []]]] ('path' [1,2,3]) == False 685 | /// isDfsForestOf [Node 3 [], Node 1 [Node 2 []]] ('path' [1,2,3]) == True 686 | /// isDfsForestOf [Node 2 [Node 3 []], Node 1 []] ('path' [1,2,3]) == True 687 | /// isDfsForestOf [Node 1 [], Node 2 [Node 3 []]] ('path' [1,2,3]) == False 688 | /// @ 689 | let isDfsForestOf (f : 'a Forest) (am : 'a AdjacencyMap) : bool = 690 | 691 | let rec go seen = 692 | function 693 | | [] -> Some seen 694 | | t::ts -> 695 | option { 696 | let root = t.RootLabel 697 | do! Option.guard (not <| Set.contains root seen) 698 | do! Option.guard (t.SubForest |> List.forall (fun subTree -> hasEdge root subTree.RootLabel am)) 699 | let! newSeen = go (Set.add root seen) t.SubForest 700 | do! Option.guard (Set.isSubset (postSet root am) newSeen) 701 | return! go newSeen ts 702 | } 703 | 704 | match go Set.empty f with 705 | | Some seen -> seen = vertexSet am 706 | | None -> false 707 | -------------------------------------------------------------------------------- /Alga.FSharp/AdjacencyMap/Internal.fs: -------------------------------------------------------------------------------- 1 | namespace rec Alga.FSharp.AdjacencyMap.Internal 2 | 3 | open Alga.FSharp 4 | 5 | (* 6 | -- Module : Algebra.Graph.AdjacencyMap.Internal 7 | -- Copyright : (c) Andrey Mokhov 2016-2018 8 | -- License : MIT (see the file LICENSE) 9 | -- Maintainer : andrey.mokhov@gmail.com 10 | -- Stability : unstable 11 | -- 12 | -- This module exposes the implementation of adjacency maps. The API is unstable 13 | -- and unsafe, and is exposed only for documentation. You should use the 14 | -- non-internal module "Algebra.Graph.AdjacencyMap" instead. 15 | 16 | The 'AdjacencyMap' data type represents a graph by a map of vertices to 17 | their adjacency sets. We define a 'Num' instance as a convenient notation for 18 | working with graphs: 19 | 20 | > 0 == vertex 0 21 | > 1 + 2 == overlay (vertex 1) (vertex 2) 22 | > 1 * 2 == connect (vertex 1) (vertex 2) 23 | > 1 + 2 * 3 == overlay (vertex 1) (connect (vertex 2) (vertex 3)) 24 | > 1 * (2 + 3) == connect (vertex 1) (overlay (vertex 2) (vertex 3)) 25 | 26 | The 'Show' instance is defined using basic graph construction primitives: 27 | 28 | @show (empty :: AdjacencyMap Int) == "empty" 29 | show (1 :: AdjacencyMap Int) == "vertex 1" 30 | show (1 + 2 :: AdjacencyMap Int) == "vertices [1,2]" 31 | show (1 * 2 :: AdjacencyMap Int) == "edge 1 2" 32 | show (1 * 2 * 3 :: AdjacencyMap Int) == "edges [(1,2),(1,3),(2,3)]" 33 | show (1 * 2 + 3 :: AdjacencyMap Int) == "overlay (vertex 3) (edge 1 2)"@ 34 | 35 | The 'Eq' instance satisfies all axioms of algebraic graphs: 36 | 37 | * 'Algebra.Graph.AdjacencyMap.overlay' is commutative and associative: 38 | 39 | > x + y == y + x 40 | > x + (y + z) == (x + y) + z 41 | 42 | * 'Algebra.Graph.AdjacencyMap.connect' is associative and has 43 | 'Algebra.Graph.AdjacencyMap.empty' as the identity: 44 | 45 | > x * empty == x 46 | > empty * x == x 47 | > x * (y * z) == (x * y) * z 48 | 49 | * 'Algebra.Graph.AdjacencyMap.connect' distributes over 50 | 'Algebra.Graph.AdjacencyMap.overlay': 51 | 52 | > x * (y + z) == x * y + x * z 53 | > (x + y) * z == x * z + y * z 54 | 55 | * 'Algebra.Graph.AdjacencyMap.connect' can be decomposed: 56 | 57 | > x * y * z == x * y + x * z + y * z 58 | 59 | The following useful theorems can be proved from the above set of axioms. 60 | 61 | * 'Algebra.Graph.AdjacencyMap.overlay' has 'Algebra.Graph.AdjacencyMap.empty' 62 | as the identity and is idempotent: 63 | 64 | > x + empty == x 65 | > empty + x == x 66 | > x + x == x 67 | 68 | * Absorption and saturation of 'Algebra.Graph.AdjacencyMap.connect': 69 | 70 | > x * y + x + y == x * y 71 | > x * x * x == x * x 72 | 73 | When specifying the time and memory complexity of graph algorithms, /n/ and /m/ 74 | will denote the number of vertices and edges in the graph, respectively. 75 | *) 76 | 77 | /// The /adjacency map/ of the graph: each vertex is associated with a set 78 | /// of its direct successors. Complexity: /O(1)/ time and memory. 79 | /// 80 | /// @ 81 | /// adjacencyMap 'empty' == Map.'Map.empty' 82 | /// adjacencyMap ('vertex' x) == Map.'Map.singleton' x Set.'Set.empty' 83 | /// adjacencyMap ('Algebra.Graph.AdjacencyMap.edge' 1 1) == Map.'Map.singleton' 1 (Set.'Set.singleton' 1) 84 | /// adjacencyMap ('Algebra.Graph.AdjacencyMap.edge' 1 2) == Map.'Map.fromList' [(1,Set.'Set.singleton' 2), (2,Set.'Set.empty')] 85 | /// @ 86 | type AdjacencyMap<'a when 'a : comparison> = AdjacencyMap of Map<'a, 'a Set> 87 | with 88 | 89 | static member (+) (x : 'a AdjacencyMap, y : 'a AdjacencyMap) = AdjacencyMap.overlay x y 90 | static member (*) (x : 'a AdjacencyMap, y : 'a AdjacencyMap) = AdjacencyMap.connect x y 91 | 92 | override this.ToString () = 93 | 94 | let (AdjacencyMap m) = this 95 | let vs = m |> Map.toSeq |> Seq.map fst |> Seq.sort |> List.ofSeq 96 | let es = m |> AdjacencyMap.internalEdgeList |> List.ofSeq 97 | 98 | let vshow = 99 | function 100 | | [x] -> sprintf "vertex %A" x 101 | | xs -> sprintf "vertices %A" xs 102 | 103 | let eshow = 104 | function 105 | | [x, y] -> sprintf "edge %A %A" x y 106 | | xs -> sprintf "edges %A" xs 107 | 108 | let used = m |> AdjacencyMap.referredToVertexSet |> Set.toSeq |> Seq.sort |> List.ofSeq 109 | 110 | if vs |> Seq.isEmpty then 111 | "empty" 112 | else if es |> Seq.isEmpty then 113 | vshow vs 114 | else if vs = used then 115 | eshow es 116 | else 117 | sprintf "overlay (%s) (%s)" 118 | (vshow (Set.difference (vs |> Set.ofSeq) (used |> Set.ofSeq) |> Set.toList)) 119 | (eshow es) 120 | 121 | [] 122 | module AdjacencyMap = 123 | 124 | //-- | Construct the /empty graph/. 125 | //-- Complexity: /O(1)/ time and memory. 126 | //-- 127 | //-- @ 128 | //-- 'Algebra.Graph.AdjacencyMap.isEmpty' empty == True 129 | //-- 'Algebra.Graph.AdjacencyMap.hasVertex' x empty == False 130 | //-- 'Algebra.Graph.AdjacencyMap.vertexCount' empty == 0 131 | //-- 'Algebra.Graph.AdjacencyMap.edgeCount' empty == 0 132 | //-- @ 133 | let empty : 'a AdjacencyMap = 134 | AdjacencyMap Map.empty 135 | 136 | /// Construct the graph comprising /a single isolated vertex/. 137 | /// Complexity: /O(1)/ time and memory. 138 | /// 139 | /// @ 140 | /// 'Algebra.Graph.AdjacencyMap.isEmpty' (vertex x) == False 141 | /// 'Algebra.Graph.AdjacencyMap.hasVertex' x (vertex x) == True 142 | /// 'Algebra.Graph.AdjacencyMap.vertexCount' (vertex x) == 1 143 | /// 'Algebra.Graph.AdjacencyMap.edgeCount' (vertex x) == 0 144 | /// @ 145 | let vertex (x : 'a) : 'a AdjacencyMap = 146 | Map.empty |> Map.add x Set.empty |> AdjacencyMap 147 | 148 | /// /Overlay/ two graphs. This is a commutative, associative and idempotent 149 | /// operation with the identity 'empty'. 150 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 151 | /// 152 | /// @ 153 | /// 'Algebra.Graph.AdjacencyMap.isEmpty' (overlay x y) == 'Algebra.Graph.AdjacencyMap.isEmpty' x && 'Algebra.Graph.AdjacencyMap.isEmpty' y 154 | /// 'Algebra.Graph.AdjacencyMap.hasVertex' z (overlay x y) == 'Algebra.Graph.AdjacencyMap.hasVertex' z x || 'Algebra.Graph.AdjacencyMap.hasVertex' z y 155 | /// 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay x y) >= 'Algebra.Graph.AdjacencyMap.vertexCount' x 156 | /// 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay x y) <= 'Algebra.Graph.AdjacencyMap.vertexCount' x + 'Algebra.Graph.AdjacencyMap.vertexCount' y 157 | /// 'Algebra.Graph.AdjacencyMap.edgeCount' (overlay x y) >= 'Algebra.Graph.AdjacencyMap.edgeCount' x 158 | /// 'Algebra.Graph.AdjacencyMap.edgeCount' (overlay x y) <= 'Algebra.Graph.AdjacencyMap.edgeCount' x + 'Algebra.Graph.AdjacencyMap.edgeCount' y 159 | /// 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay 1 2) == 2 160 | /// 'Algebra.Graph.AdjacencyMap.edgeCount' (overlay 1 2) == 0 161 | /// @ 162 | let overlay (AdjacencyMap x) (AdjacencyMap y) : 'a AdjacencyMap = 163 | 164 | Map.unionWith Set.union x y |> AdjacencyMap 165 | 166 | /// /Connect/ two graphs. This is an associative operation with the identity 167 | /// 'empty', which distributes over 'overlay' and obeys the decomposition axiom. 168 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the 169 | /// number of edges in the resulting graph is quadratic with respect to the number 170 | /// of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/. 171 | /// 172 | /// @ 173 | /// 'isEmpty' (connect x y) == 'isEmpty' x && 'Algebra.Graph.AdjacencyMap.isEmpty' y 174 | /// 'hasVertex' z (connect x y) == 'hasVertex' z x || 'Algebra.Graph.AdjacencyMap.hasVertex' z y 175 | /// 'vertexCount' (connect x y) >= 'vertexCount' x 176 | /// 'vertexCount' (connect x y) <= 'vertexCount' x + 'Algebra.Graph.AdjacencyMap.vertexCount' y 177 | /// 'edgeCount' (connect x y) >= 'edgeCount' x 178 | /// 'edgeCount' (connect x y) >= 'edgeCount' y 179 | /// 'edgeCount' (connect x y) >= 'vertexCount' x * 'Algebra.Graph.AdjacencyMap.vertexCount' y 180 | /// 'edgeCount' (connect x y) <= 'vertexCount' x * 'Algebra.Graph.AdjacencyMap.vertexCount' y + 'Algebra.Graph.AdjacencyMap.edgeCount' x + 'Algebra.Graph.AdjacencyMap.edgeCount' y 181 | /// 'vertexCount' (connect 1 2) == 2 182 | /// 'edgeCount' (connect 1 2) == 1 183 | /// @ 184 | let connect (AdjacencyMap x) (AdjacencyMap y) : 'a AdjacencyMap = 185 | let fromSet f s = s |> Seq.map (fun k -> k, f k) |> Map.ofSeq 186 | Map.unionsWith Set.union [ x ; y ; fromSet (fun _ -> Map.keysSet y) (Map.keysSet x) ] |> AdjacencyMap 187 | 188 | /// Construct a graph from a list of adjacency sets. 189 | /// Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. 190 | /// 191 | /// @ 192 | /// fromAdjacencySets [] == 'Algebra.Graph.AdjacencyMap.empty' 193 | /// fromAdjacencySets [(x, Set.'Set.empty')] == 'Algebra.Graph.AdjacencyMap.vertex' x 194 | /// fromAdjacencySets [(x, Set.'Set.singleton' y)] == 'Algebra.Graph.AdjacencyMap.edge' x y 195 | /// fromAdjacencySets . map (fmap Set.'Set.fromList') . 'Algebra.Graph.AdjacencyMap.adjacencyList' == id 196 | /// 'Algebra.Graph.AdjacencyMap.overlay' (fromAdjacencySets xs) (fromAdjacencySets ys) == fromAdjacencySets (xs ++ ys) 197 | /// @ 198 | //fromAdjacencySets :: Ord a => [(a, Set a)] -> AdjacencyMap a 199 | let fromAdjacencySets (ss : ('a * 'a Set) seq) : 'a AdjacencyMap = 200 | let vs = ss |> Seq.map snd |> Set.unionMany |> Seq.map (fun k -> k, Set.empty) |> Map.ofSeq 201 | let es = ss |> Map.ofSeq 202 | Map.unionWith Set.union vs es |> AdjacencyMap 203 | 204 | /// Check if the internal graph representation is consistent, i.e. that all 205 | /// edges refer to existing vertices. It should be impossible to create an 206 | /// inconsistent adjacency map, and we use this function in testing. 207 | /// /Note: this function is for internal use only/. 208 | /// 209 | /// @ 210 | /// consistent 'Algebra.Graph.AdjacencyMap.empty' == True 211 | /// consistent ('Algebra.Graph.AdjacencyMap.vertex' x) == True 212 | /// consistent ('Algebra.Graph.AdjacencyMap.overlay' x y) == True 213 | /// consistent ('Algebra.Graph.AdjacencyMap.connect' x y) == True 214 | /// consistent ('Algebra.Graph.AdjacencyMap.edge' x y) == True 215 | /// consistent ('Algebra.Graph.AdjacencyMap.edges' xs) == True 216 | /// consistent ('Algebra.Graph.AdjacencyMap.stars' xs) == True 217 | /// @ 218 | let consistent (AdjacencyMap m) : bool = 219 | Set.isSubset (referredToVertexSet m) (Map.keysSet m) 220 | 221 | /// The set of vertices that are referred to by the edges 222 | //referredToVertexSet :: Ord a => Map a (Set a) -> Set a 223 | let referredToVertexSet (m : Map<'a, 'a Set>) : 'a Set = 224 | let s = m |> internalEdgeList 225 | Seq.append (s |> Seq.map fst) (s |> Seq.map snd) |> Set.ofSeq 226 | 227 | /// The list of edges in adjacency map 228 | let internalEdgeList (m : Map<'a, 'a Set>) : ('a * 'a) seq = 229 | seq { 230 | for (x, ys) in m |> Map.toSeq |> Seq.sort do 231 | for y in ys |> Set.toSeq |> Seq.sort do 232 | yield x, y 233 | } 234 | -------------------------------------------------------------------------------- /Alga.FSharp/Alga.FSharp.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | netstandard2.0 5 | true 6 | 7 | 4 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /Alga.FSharp/Graph.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp 2 | 3 | open Alga.FSharp.Internal 4 | open Alga.FSharp.AdjacencyMap.Internal 5 | 6 | (* 7 | Module : Algebra.Graph 8 | Copyright : (c) Andrey Mokhov 2016-2018 9 | License : MIT (see the file LICENSE) 10 | Maintainer : andrey.mokhov@gmail.com 11 | Stability : experimental 12 | 13 | __Alga__ is a library for algebraic construction and manipulation of graphs 14 | in Haskell. See for the 15 | motivation behind the library, the underlying theory, and implementation details. 16 | 17 | This module defines the core data type 'Graph' and associated algorithms. 18 | For graphs that are known to be /non-empty/ at compile time, see 19 | "Algebra.Graph.NonEmpty". 'Graph' is an instance of type classes defined in 20 | modules "Algebra.Graph.Class" and "Algebra.Graph.HigherKinded.Class", which 21 | can be used for polymorphic graph construction and manipulation. 22 | 23 | The 'Graph' data type is a deep embedding of the core graph construction 24 | primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num' 25 | instance as a convenient notation for working with graphs: 26 | 27 | > 0 == Vertex 0 28 | > 1 + 2 == Overlay (Vertex 1) (Vertex 2) 29 | > 1 * 2 == Connect (Vertex 1) (Vertex 2) 30 | > 1 + 2 * 3 == Overlay (Vertex 1) (Connect (Vertex 2) (Vertex 3)) 31 | > 1 * (2 + 3) == Connect (Vertex 1) (Overlay (Vertex 2) (Vertex 3)) 32 | 33 | The 'Eq' instance is currently implemented using the 'AM.AdjacencyMap' as the 34 | /canonical graph representation/ and satisfies all axioms of algebraic graphs: 35 | 36 | * 'overlay' is commutative and associative: 37 | 38 | > x + y == y + x 39 | > x + (y + z) == (x + y) + z 40 | 41 | * 'connect' is associative and has 'empty' as the identity: 42 | 43 | > x * empty == x 44 | > empty * x == x 45 | > x * (y * z) == (x * y) * z 46 | 47 | * 'connect' distributes over 'overlay': 48 | 49 | > x * (y + z) == x * y + x * z 50 | > (x + y) * z == x * z + y * z 51 | 52 | * 'connect' can be decomposed: 53 | 54 | > x * y * z == x * y + x * z + y * z 55 | 56 | The following useful theorems can be proved from the above set of axioms. 57 | 58 | * 'overlay' has 'empty' as the identity and is idempotent: 59 | 60 | > x + empty == x 61 | > empty + x == x 62 | > x + x == x 63 | 64 | * Absorption and saturation of 'connect': 65 | 66 | > x * y + x + y == x * y 67 | > x * x * x == x * x 68 | 69 | When specifying the time and memory complexity of graph algorithms, /n/ will 70 | denote the number of vertices in the graph, /m/ will denote the number of 71 | edges in the graph, and /s/ will denote the /size/ of the corresponding 72 | 'Graph' expression. For example, if @g@ is a 'Graph' then /n/, /m/ and /s/ can 73 | be computed as follows: 74 | 75 | @n == 'vertexCount' g 76 | m == 'edgeCount' g 77 | s == 'size' g@ 78 | 79 | Note that 'size' is slightly different from the 'length' method of the 80 | 'Foldable' type class, as the latter does not count 'empty' leaves of the 81 | expression: 82 | 83 | @'length' 'empty' == 0 84 | 'size' 'empty' == 1 85 | 'length' ('vertex' x) == 1 86 | 'size' ('vertex' x) == 1 87 | 'length' ('empty' + 'empty') == 0 88 | 'size' ('empty' + 'empty') == 2@ 89 | 90 | The 'size' of any graph is positive, and the difference @('size' g - 'length' g)@ 91 | corresponds to the number of occurrences of 'empty' in an expression @g@. 92 | 93 | Converting a 'Graph' to the corresponding 'AM.AdjacencyMap' takes /O(s + m * log(m))/ 94 | time and /O(s + m)/ memory. This is also the complexity of the graph equality test, 95 | because it is currently implemented by converting graph expressions to canonical 96 | representations based on adjacency maps. 97 | *) 98 | 99 | type 'a Graph = 100 | | Empty 101 | | Vertex of 'a 102 | | Overlay of 'a Graph * 'a Graph 103 | | Connect of 'a Graph * 'a Graph 104 | with 105 | static member Zero : 'a Graph = Empty 106 | static member (+) (x : 'a Graph, y : 'a Graph) = Overlay (x, y) 107 | static member (*) (x : 'a Graph, y : 'a Graph) = Connect (x, y) 108 | 109 | [] 110 | module Graph = 111 | 112 | /// Construct the /empty graph/. An alias for the constructor 'Empty'. 113 | /// Complexity: /O(1)/ time, memory and size. 114 | /// 115 | /// @ 116 | /// 'isEmpty' empty == True 117 | /// 'hasVertex' x empty == False 118 | /// 'vertexCount' empty == 0 119 | /// 'edgeCount' empty == 0 120 | /// 'size' empty == 1 121 | /// @ 122 | let empty : 'a Graph = 123 | Empty 124 | 125 | /// Construct the graph comprising /a single isolated vertex/. An alias for the 126 | /// constructor 'Vertex'. 127 | /// Complexity: /O(1)/ time, memory and size. 128 | /// 129 | /// @ 130 | /// 'isEmpty' (vertex x) == False 131 | /// 'hasVertex' x (vertex x) == True 132 | /// 'vertexCount' (vertex x) == 1 133 | /// 'edgeCount' (vertex x) == 0 134 | /// 'size' (vertex x) == 1 135 | /// @ 136 | let vertex (a : 'a) : 'a Graph = 137 | Vertex a 138 | 139 | /// /Overlay/ two graphs. An alias for the constructor 'Overlay'. This is a 140 | /// commutative, associative and idempotent operation with the identity 'empty'. 141 | /// Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. 142 | /// 143 | /// @ 144 | /// 'isEmpty' (overlay x y) == 'isEmpty' x && 'isEmpty' y 145 | /// 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y 146 | /// 'vertexCount' (overlay x y) >= 'vertexCount' x 147 | /// 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y 148 | /// 'edgeCount' (overlay x y) >= 'edgeCount' x 149 | /// 'edgeCount' (overlay x y) <= 'edgeCount' x + 'edgeCount' y 150 | /// 'size' (overlay x y) == 'size' x + 'size' y 151 | /// 'vertexCount' (overlay 1 2) == 2 152 | /// 'edgeCount' (overlay 1 2) == 0 153 | /// @ 154 | let overlay (x : 'a Graph) (y : 'a Graph) : 'a Graph = 155 | Overlay (x, y) 156 | 157 | /// /Connect/ two graphs. An alias for the constructor 'Connect'. This is an 158 | /// associative operation with the identity 'empty', which distributes over 159 | /// 'overlay' and obeys the decomposition axiom. 160 | /// Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. Note that the number 161 | /// of edges in the resulting graph is quadratic with respect to the number of 162 | /// vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/. 163 | /// 164 | /// @ 165 | /// 'isEmpty' (connect x y) == 'isEmpty' x && 'isEmpty' y 166 | /// 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y 167 | /// 'vertexCount' (connect x y) >= 'vertexCount' x 168 | /// 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y 169 | /// 'edgeCount' (connect x y) >= 'edgeCount' x 170 | /// 'edgeCount' (connect x y) >= 'edgeCount' y 171 | /// 'edgeCount' (connect x y) >= 'vertexCount' x * 'vertexCount' y 172 | /// 'edgeCount' (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y 173 | /// 'size' (connect x y) == 'size' x + 'size' y 174 | /// 'vertexCount' (connect 1 2) == 2 175 | /// 'edgeCount' (connect 1 2) == 1 176 | /// @ 177 | let connect (x : 'a Graph) (y : 'a Graph) : 'a Graph = 178 | Connect (x, y) 179 | 180 | /// Construct the graph comprising /a single edge/. 181 | /// Complexity: /O(1)/ time, memory and size. 182 | /// 183 | /// @ 184 | /// edge x y == 'connect' ('vertex' x) ('vertex' y) 185 | /// 'hasEdge' x y (edge x y) == True 186 | /// 'edgeCount' (edge x y) == 1 187 | /// 'vertexCount' (edge 1 1) == 1 188 | /// 'vertexCount' (edge 1 2) == 2 189 | /// @ 190 | let edge (x : 'a) (y : 'a) : 'a Graph = 191 | connect (vertex x) (vertex y) 192 | 193 | /// Auxiliary function, similar to 'mconcat'. 194 | let concatg (f : 'a Graph -> 'a Graph -> 'a Graph) (gs : 'a Graph seq) : 'a Graph = 195 | gs |> Seq.fold f empty 196 | 197 | /// Overlay a given list of graphs. 198 | /// Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length 199 | /// of the given list, and /S/ is the sum of sizes of the graphs in the list. 200 | /// 201 | /// @ 202 | /// overlays [] == 'empty' 203 | /// overlays [x] == x 204 | /// overlays [x,y] == 'overlay' x y 205 | /// overlays == 'foldr' 'overlay' 'empty' 206 | /// 'isEmpty' . overlays == 'all' 'isEmpty' 207 | /// @ 208 | let overlays (gs : 'a Graph seq) : 'a Graph = 209 | gs |> concatg overlay 210 | 211 | /// Construct the graph comprising a given list of isolated vertices. 212 | /// Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 213 | /// given list. 214 | /// 215 | /// @ 216 | /// vertices [] == 'empty' 217 | /// vertices [x] == 'vertex' x 218 | /// 'hasVertex' x . vertices == 'elem' x 219 | /// 'vertexCount' . vertices == 'length' . 'Data.List.nub' 220 | /// 'vertexSet' . vertices == Set.'Set.fromList' 221 | /// @ 222 | let vertices (vs : 'a seq) : 'a Graph = 223 | vs |> Seq.map vertex |> overlays 224 | 225 | /// Construct the graph from a list of edges. 226 | /// Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 227 | /// given list. 228 | /// 229 | /// @ 230 | /// edges [] == 'empty' 231 | /// edges [(x,y)] == 'edge' x y 232 | /// 'edgeCount' . edges == 'length' . 'Data.List.nub' 233 | /// @ 234 | let edges (es : ('a * 'a) seq) : 'a Graph = 235 | es |> Seq.map ((<||) edge) |> overlays 236 | 237 | /// Connect a given list of graphs. 238 | /// Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length 239 | /// of the given list, and /S/ is the sum of sizes of the graphs in the list. 240 | /// 241 | /// @ 242 | /// connects [] == 'empty' 243 | /// connects [x] == x 244 | /// connects [x,y] == 'connect' x y 245 | /// connects == 'foldr' 'connect' 'empty' 246 | /// 'isEmpty' . connects == 'all' 'isEmpty' 247 | /// @ 248 | let connects (gs : 'a Graph seq) : 'a Graph = 249 | gs |> concatg connect 250 | 251 | /// Generalised 'Graph' folding: recursively collapse a 'Graph' by applying 252 | /// the provided functions to the leaves and internal nodes of the expression. 253 | /// The order of arguments is: empty, vertex, overlay and connect. 254 | /// Complexity: /O(s)/ applications of given functions. As an example, the 255 | /// complexity of 'size' is /O(s)/, since all functions have cost /O(1)/. 256 | /// 257 | /// @ 258 | /// foldg 'empty' 'vertex' 'overlay' 'connect' == id 259 | /// foldg 'empty' 'vertex' 'overlay' (flip 'connect') == 'transpose' 260 | /// foldg [] return (++) (++) == 'Data.Foldable.toList' 261 | /// foldg 0 (const 1) (+) (+) == 'Data.Foldable.length' 262 | /// foldg 1 (const 1) (+) (+) == 'size' 263 | /// foldg True (const False) (&&) (&&) == 'isEmpty' 264 | /// @ 265 | let rec foldg (e : 'b) (v : 'a -> 'b) (o : 'b -> 'b -> 'b) (c : 'b -> 'b -> 'b) (g : 'a Graph) : 'b = 266 | let go = foldg e v o c 267 | match g with 268 | | Empty -> e 269 | | Vertex x -> v x 270 | | Overlay (x, y) -> o (go x) (go y) 271 | | Connect (x, y) -> c (go x) (go y) 272 | 273 | let rec map (f : 'a -> 'b) (g : 'a Graph) : 'b Graph = 274 | match g with 275 | | Empty -> Empty 276 | | Vertex a -> Vertex (f a) 277 | | Overlay (g1, g2) -> Overlay (map f g1, map f g2) 278 | | Connect (g1, g2) -> Connect (map f g1, map f g2) 279 | 280 | let bind (g : 'a Graph) (f : 'a -> 'b Graph) : 'b Graph = 281 | foldg Empty f overlay connect g 282 | 283 | let rec toList (g : 'a Graph) : 'a list = 284 | match g with 285 | | Empty -> [] 286 | | Vertex a -> [a] 287 | | Overlay (g1, g2) -> toList g1 @ toList g2 288 | | Connect (g1, g2) -> toList g1 @ toList g2 289 | 290 | /// | Check if a graph is empty. A convenient alias for 'null'. 291 | /// Complexity: /O(s)/ time. 292 | /// 293 | /// @ 294 | /// isEmpty 'empty' == True 295 | /// isEmpty ('overlay' 'empty' 'empty') == True 296 | /// isEmpty ('vertex' x) == False 297 | /// isEmpty ('removeVertex' x $ 'vertex' x) == True 298 | /// isEmpty ('removeEdge' x y $ 'edge' x y) == False 299 | /// @ 300 | let isEmpty (x : 'a Graph) : bool = 301 | foldg true (fun _ -> false) (&&) (&&) x 302 | 303 | /// The /size/ of a graph, i.e. the number of leaves of the expression 304 | /// including 'empty' leaves. 305 | /// Complexity: /O(s)/ time. 306 | /// 307 | /// @ 308 | /// size 'empty' == 1 309 | /// size ('vertex' x) == 1 310 | /// size ('overlay' x y) == size x + size y 311 | /// size ('connect' x y) == size x + size y 312 | /// size x >= 1 313 | /// size x >= 'vertexCount' x 314 | /// @ 315 | let size (x : 'a Graph) : int = 316 | foldg 1 (fun _ -> 1) (+) (+) x 317 | 318 | /// Check if a graph contains a given vertex. A convenient alias for `elem`. 319 | /// Complexity: /O(s)/ time. 320 | /// 321 | /// @ 322 | /// hasVertex x 'empty' == False 323 | /// hasVertex x ('vertex' x) == True 324 | /// hasVertex 1 ('vertex' 2) == False 325 | /// hasVertex x . 'removeVertex' x == const False 326 | /// @ 327 | let hasVertex (v : 'a) (g : 'a Graph) : bool = 328 | foldg false ((=) v) (||) (||) g 329 | 330 | /// Check if a graph contains a given edge. 331 | /// Complexity: /O(s)/ time. 332 | /// 333 | /// @ 334 | /// hasEdge x y 'empty' == False 335 | /// hasEdge x y ('vertex' z) == False 336 | /// hasEdge x y ('edge' x y) == True 337 | /// hasEdge x y . 'removeEdge' x y == const False 338 | /// hasEdge x y == 'elem' (x,y) . 'edgeList' 339 | /// @ 340 | let hasEdge (s : 'a) (t : 'a) (g : 'a Graph) : bool = 341 | 342 | let rec hit = 343 | function 344 | | Empty -> Miss 345 | | Vertex x -> if x = s then Tail else Miss 346 | | Overlay (x, y) -> 347 | match hit x with 348 | | Miss -> hit y 349 | | Tail -> max Tail (hit y) 350 | | Edge -> Edge 351 | | Connect (x, y) -> 352 | match hit x with 353 | | Miss -> hit y 354 | | Tail -> if hasVertex t y then Edge else Tail 355 | | Edge -> Edge 356 | 357 | hit g = Edge 358 | 359 | /// The set of vertices of a given graph. 360 | /// Complexity: /O(s * log(n))/ time and /O(n)/ memory. 361 | /// 362 | /// @ 363 | /// vertexSet 'empty' == Set.'Set.empty' 364 | /// vertexSet . 'vertex' == Set.'Set.singleton' 365 | /// vertexSet . 'vertices' == Set.'Set.fromList' 366 | /// vertexSet . 'clique' == Set.'Set.fromList' 367 | /// @ 368 | let vertexSet (g : 'a Graph) : 'a Set = 369 | foldg Set.empty Set.singleton Set.union Set.union g 370 | 371 | /// The number of vertices in a graph. 372 | /// Complexity: /O(s * log(n))/ time. 373 | /// 374 | /// @ 375 | /// vertexCount 'empty' == 0 376 | /// vertexCount ('vertex' x) == 1 377 | /// vertexCount == 'length' . 'vertexList' 378 | /// @ 379 | let vertexCount (g : 'a Graph) : int = 380 | g |> vertexSet |> Set.count 381 | 382 | // TODO: This is a very inefficient implementation. Find a way to construct an 383 | // adjacency map directly, without building intermediate representations for all 384 | // subgraphs. 385 | /// Convert a graph to 'AM.AdjacencyMap'. 386 | let toAdjacencyMap (g : 'a Graph) : 'a AdjacencyMap = 387 | foldg AdjacencyMap.empty AdjacencyMap.vertex AdjacencyMap.overlay AdjacencyMap.connect g 388 | 389 | /// The number of edges in a graph. 390 | /// Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a 391 | /// graph can be quadratic with respect to the expression size /s/. 392 | /// 393 | /// @ 394 | /// edgeCount 'empty' == 0 395 | /// edgeCount ('vertex' x) == 0 396 | /// edgeCount ('edge' x y) == 1 397 | /// edgeCount == 'length' . 'edgeList' 398 | /// @ 399 | let edgeCount (g : 'a Graph) : int = 400 | g |> toAdjacencyMap |> AdjacencyMap.edgeCount 401 | 402 | /// The sorted list of vertices of a given graph. 403 | /// Complexity: /O(s * log(n))/ time and /O(n)/ memory. 404 | /// 405 | /// @ 406 | /// vertexList 'empty' == [] 407 | /// vertexList ('vertex' x) == [x] 408 | /// vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' 409 | /// @ 410 | let vertexList (g : 'a Graph) : 'a seq = 411 | g |> vertexSet |> Set.toSeq |> Seq.sort 412 | 413 | /// The sorted list of edges of a graph. 414 | /// Complexity: /O(s + m * log(m))/ time and /O(m)/ memory. Note that the number of 415 | /// edges /m/ of a graph can be quadratic with respect to the expression size /s/. 416 | /// 417 | /// @ 418 | /// edgeList 'empty' == [] 419 | /// edgeList ('vertex' x) == [] 420 | /// edgeList ('edge' x y) == [(x,y)] 421 | /// edgeList ('star' 2 [3,1]) == [(2,1), (2,3)] 422 | /// edgeList . 'edges' == 'Data.List.nub' . 'Data.List.sort' 423 | /// edgeList . 'transpose' == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList 424 | /// @ 425 | let edgeList (g : 'a Graph) : ('a * 'a) seq = 426 | g |> toAdjacencyMap |> AdjacencyMap.edgeList 427 | 428 | /// The set of edges of a given graph. 429 | /// Complexity: /O(s * log(m))/ time and /O(m)/ memory. 430 | /// 431 | /// @ 432 | /// edgeSet 'empty' == Set.'Set.empty' 433 | /// edgeSet ('vertex' x) == Set.'Set.empty' 434 | /// edgeSet ('edge' x y) == Set.'Set.singleton' (x,y) 435 | /// edgeSet . 'edges' == Set.'Set.fromList' 436 | /// @ 437 | let edgeSet (g : 'a Graph) : ('a * 'a) Set = 438 | g |> toAdjacencyMap |> AdjacencyMap.edgeSet 439 | 440 | /// The sorted /adjacency list/ of a graph. 441 | /// Complexity: /O(n + m)/ time and /O(m)/ memory. 442 | /// 443 | /// @ 444 | /// adjacencyList 'empty' == [] 445 | /// adjacencyList ('vertex' x) == [(x, [])] 446 | /// adjacencyList ('edge' 1 2) == [(1, [2]), (2, [])] 447 | /// adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])] 448 | /// 'stars' . adjacencyList == id 449 | /// @ 450 | let adjacencyList (g : 'a Graph) : ('a * 'a seq) seq = 451 | g |> toAdjacencyMap |> AdjacencyMap.adjacencyList 452 | 453 | /// The /adjacency map/ of a graph: each vertex is associated with a set of its 454 | /// direct successors. 455 | /// Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a 456 | /// graph can be quadratic with respect to the expression size /s/. 457 | let adjacencyMap (g : 'a Graph) : Map<'a, 'a Set> = 458 | g |> toAdjacencyMap |> (fun (AdjacencyMap m) -> m) 459 | 460 | /// The /path/ on a list of vertices. 461 | /// Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 462 | /// given list. 463 | /// 464 | /// @ 465 | /// path [] == 'empty' 466 | /// path [x] == 'vertex' x 467 | /// path [x,y] == 'edge' x y 468 | /// path . 'reverse' == 'transpose' . path 469 | /// @ 470 | let path (xs : 'a list) : 'a Graph = 471 | match xs with 472 | | [] -> empty 473 | | [x] -> vertex x 474 | | _::ys -> edges (Seq.zip xs ys) 475 | 476 | //-- The /circuit/ on a list of vertices. 477 | //-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 478 | //-- given list. 479 | //-- 480 | //-- @ 481 | //-- circuit [] == 'empty' 482 | //-- circuit [x] == 'edge' x x 483 | //-- circuit [x,y] == 'edges' [(x,y), (y,x)] 484 | //-- circuit . 'reverse' == 'transpose' . circuit 485 | //-- @ 486 | let circuit (xs : 'a list) : 'a Graph = 487 | match xs with 488 | | [] -> empty 489 | | x::_ -> path (xs @ [x]) 490 | 491 | /// The /clique/ on a list of vertices. 492 | /// Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 493 | /// given list. 494 | /// 495 | /// @ 496 | /// clique [] == 'empty' 497 | /// clique [x] == 'vertex' x 498 | /// clique [x,y] == 'edge' x y 499 | /// clique [x,y,z] == 'edges' [(x,y), (x,z), (y,z)] 500 | /// clique (xs ++ ys) == 'connect' (clique xs) (clique ys) 501 | /// clique . 'reverse' == 'transpose' . clique 502 | /// @ 503 | let clique (xs : 'a seq) : 'a Graph = 504 | xs |> Seq.map vertex |> connects 505 | 506 | /// The /biclique/ on two lists of vertices. 507 | /// Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the 508 | /// lengths of the given lists. 509 | /// 510 | /// @ 511 | /// biclique [] [] == 'empty' 512 | /// biclique [x] [] == 'vertex' x 513 | /// biclique [] [y] == 'vertex' y 514 | /// biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] 515 | /// biclique xs ys == 'connect' ('vertices' xs) ('vertices' ys) 516 | /// @ 517 | let biclique (xs : 'a list) (ys : 'a list) : 'a Graph = 518 | match xs, ys with 519 | | _, [] -> vertices xs 520 | | [], _ -> vertices ys 521 | | xs, ys -> connect (vertices xs) (vertices ys) 522 | 523 | /// The /star/ formed by a centre vertex connected to a list of leaves. 524 | /// Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 525 | /// given list. 526 | /// 527 | /// @ 528 | /// star x [] == 'vertex' x 529 | /// star x [y] == 'edge' x y 530 | /// star x [y,z] == 'edges' [(x,y), (x,z)] 531 | /// star x ys == 'connect' ('vertex' x) ('vertices' ys) 532 | /// @ 533 | let star (x : 'a) (ys : 'a list) : 'a Graph = 534 | connect (vertex x) (vertices ys) 535 | 536 | /// The /stars/ formed by overlaying a list of 'star's. An inverse of 537 | /// 'adjacencyList'. 538 | /// Complexity: /O(L)/ time, memory and size, where /L/ is the total size of the 539 | /// input. 540 | /// 541 | /// @ 542 | /// stars [] == 'empty' 543 | /// stars [(x, [])] == 'vertex' x 544 | /// stars [(x, [y])] == 'edge' x y 545 | /// stars [(x, ys)] == 'star' x ys 546 | /// stars == 'overlays' . map (uncurry 'star') 547 | /// stars . 'adjacencyList' == id 548 | /// 'overlay' (stars xs) (stars ys) == stars (xs ++ ys) 549 | /// @ 550 | let stars (stars : ('a * 'a list) seq) : 'a Graph = 551 | stars |> Seq.map ((<||) star) |> overlays 552 | 553 | /// The /tree graph/ constructed from a given 'Tree.Tree' data structure. 554 | /// Complexity: /O(T)/ time, memory and size, where /T/ is the size of the 555 | /// given tree (i.e. the number of vertices in the tree). 556 | /// 557 | /// @ 558 | /// tree (Node x []) == 'vertex' x 559 | /// tree (Node x [Node y [Node z []]]) == 'path' [x,y,z] 560 | /// tree (Node x [Node y [], Node z []]) == 'star' x [y,z] 561 | /// tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] 562 | /// @ 563 | let rec tree (tree : 'a Tree) : 'a Graph = 564 | match tree.SubForest with 565 | | [] -> vertex tree.RootLabel 566 | | f -> 567 | overlay 568 | (star tree.RootLabel (f |> List.map (fun t -> t.RootLabel))) 569 | (f |> List.filter (fun t -> t.SubForest |> List.isEmpty |> not) |> forest) 570 | 571 | /// The /forest graph/ constructed from a given 'Tree.Forest' data structure. 572 | /// Complexity: /O(F)/ time, memory and size, where /F/ is the size of the 573 | /// given forest (i.e. the number of vertices in the forest). 574 | /// 575 | /// @ 576 | /// forest [] == 'empty' 577 | /// forest [x] == 'tree' x 578 | /// forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)] 579 | /// forest == 'overlays' . map 'tree' 580 | /// @ 581 | and forest (f : 'a Forest) : 'a Graph = 582 | f |> List.map tree |> overlays 583 | 584 | /// Auxiliary function for 'mesh' and 'torus' 585 | let pairs (xs : 'a list) : ('a * 'a) list = 586 | match xs with 587 | | [] -> [] 588 | | y::ys -> List.zip xs (ys @ [y]) 589 | 590 | let rec init (xs : 'a list) : 'a list = 591 | match xs with 592 | | [] -> failwith "List was empty" 593 | | [x] -> [] 594 | | x::xs -> x::(init xs) 595 | 596 | /// Construct a /mesh graph/ from two lists of vertices. 597 | /// Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the 598 | /// lengths of the given lists. 599 | /// 600 | /// @ 601 | /// mesh xs [] == 'empty' 602 | /// mesh [] ys == 'empty' 603 | /// mesh [x] [y] == 'vertex' (x, y) 604 | /// mesh xs ys == 'box' ('path' xs) ('path' ys) 605 | /// mesh [1..3] "ab" == 'edges' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\')), ((1,\'b\'),(2,\'b\')), ((2,\'a\'),(2,\'b\')) 606 | /// , ((2,\'a\'),(3,\'a\')), ((2,\'b\'),(3,\'b\')), ((3,\'a\'),(3,\'b\')) ] 607 | /// @ 608 | let mesh (xs : 'a list) (ys : 'b list) : ('a * 'b) Graph = 609 | match xs, ys with 610 | | [], _ -> empty 611 | | _, [] -> empty 612 | | [x], [y] -> vertex (x, y) 613 | | _, _ -> 614 | let lx = List.last xs 615 | let ly = List.last ys 616 | let ipxs = init (pairs xs) 617 | let ipys = init (pairs ys) 618 | seq { 619 | for (a1, a2) in ipxs do 620 | for (b1, b2) in ipys do 621 | yield (a1, b1), [a1, b2 ; a2, b1] 622 | for (y1, y2) in ipys do 623 | yield (lx, y1), [lx, y2] 624 | for (x1, x2) in ipxs do 625 | yield (x1, ly), [x2, ly] 626 | } 627 | |> stars 628 | 629 | /// Construct a /torus graph/ from two lists of vertices. 630 | /// Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the 631 | /// lengths of the given lists. 632 | /// 633 | /// @ 634 | /// torus xs [] == 'empty' 635 | /// torus [] ys == 'empty' 636 | /// torus [x] [y] == 'edge' (x,y) (x,y) 637 | /// torus xs ys == 'box' ('circuit' xs) ('circuit' ys) 638 | /// torus [1,2] "ab" == 'edges' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\')), ((1,\'b\'),(1,\'a\')), ((1,\'b\'),(2,\'b\')) 639 | /// , ((2,\'a\'),(1,\'a\')), ((2,\'a\'),(2,\'b\')), ((2,\'b\'),(1,\'b\')), ((2,\'b\'),(2,\'a\')) ] 640 | /// @ 641 | let torus (xs : 'a list) (ys : 'b list) : ('a * 'b) Graph = 642 | seq { 643 | for (a1, a2) in pairs xs do 644 | for (b1, b2) in pairs ys do 645 | yield (a1, b1), [(a1, b2) ; (a2, b1)] 646 | } 647 | |> stars 648 | 649 | /// Construct a /De Bruijn graph/ of a given non-negative dimension using symbols 650 | /// from a given alphabet. 651 | /// Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the 652 | /// alphabet and /D/ is the dimension of the graph. 653 | /// 654 | /// @ 655 | /// deBruijn 0 xs == 'edge' [] [] 656 | /// n > 0 ==> deBruijn n [] == 'empty' 657 | /// deBruijn 1 [0,1] == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ] 658 | /// deBruijn 2 "0" == 'edge' "00" "00" 659 | /// deBruijn 2 "01" == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11") 660 | /// , ("10","00"), ("10","01"), ("11","10"), ("11","11") ] 661 | /// 'transpose' (deBruijn n xs) == 'fmap' 'reverse' $ deBruijn n xs 662 | /// 'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n 663 | /// n > 0 ==> 'edgeCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) 664 | /// @ 665 | let deBruijn (len : int) (alphabet : 'a list) : 'a list Graph = 666 | match len with 667 | | 0 -> edge [] [] 668 | | _ -> 669 | let overlaps = [2..len] |> List.map (fun _ -> alphabet) 670 | let skeleton = overlaps |> List.map (fun s -> Choice1Of2 s, Choice2Of2 s) |> edges 671 | let expand v = alphabet |> List.map (fun a -> match v with Choice1Of2 left -> [a] @ left | Choice2Of2 right -> right @ [a]) |> vertices 672 | bind skeleton expand 673 | 674 | /// Construct the /induced subgraph/ of a given graph by removing the 675 | /// vertices that do not satisfy a given predicate. 676 | /// Complexity: /O(s)/ time, memory and size, assuming that the predicate takes 677 | /// /O(1)/ to be evaluated. 678 | /// 679 | /// @ 680 | /// induce (const True ) x == x 681 | /// induce (const False) x == 'empty' 682 | /// induce (/= x) == 'removeVertex' x 683 | /// induce p . induce q == induce (\\x -> p x && q x) 684 | /// 'isSubgraphOf' (induce p x) x == True 685 | /// @ 686 | let induce (p : 'a -> bool) (g : 'a Graph) : 'a Graph = 687 | let k f x y = 688 | match x, y with 689 | | _, Empty -> x 690 | | Empty, _ -> y 691 | | _ -> f x y 692 | foldg empty (fun x -> if p x then vertex x else empty) (k overlay) (k connect) g 693 | 694 | /// Remove a vertex from a given graph. 695 | /// Complexity: /O(s)/ time, memory and size. 696 | /// 697 | /// @ 698 | /// removeVertex x ('vertex' x) == 'empty' 699 | /// removeVertex 1 ('vertex' 2) == 'vertex' 2 700 | /// removeVertex x ('edge' x x) == 'empty' 701 | /// removeVertex 1 ('edge' 1 2) == 'vertex' 2 702 | /// removeVertex x . removeVertex x == removeVertex x 703 | /// @ 704 | let removeVertex (v : 'a) (g : 'a Graph) : 'a Graph = 705 | induce ((<>) v) g 706 | 707 | /// The context of a subgraph comprises the input and output vertices outside 708 | /// the subgraph that are connected to the vertices inside the subgraph. 709 | type 'a Context = 710 | { 711 | Inputs : 'a list 712 | Outputs : 'a list 713 | } 714 | 715 | /// 'Focus' on a specified subgraph. 716 | let focus (f : 'a -> bool) (g : 'a Graph) : 'a Focus = 717 | foldg Focus.emptyFocus (Focus.vertexFocus f) Focus.overlayFoci Focus.connectFoci g 718 | 719 | /// Extract the context from a graph 'Focus'. Returns @Nothing@ if the focus 720 | /// could not be obtained. 721 | let context (p : 'a -> bool) (g : 'a Graph) : 'a Context option = 722 | let f = focus p g 723 | if f.Ok then 724 | { Inputs = f.Is ; Outputs = f.Os } |> Some 725 | else 726 | None 727 | 728 | /// Transpose a given graph. 729 | /// Complexity: /O(s)/ time, memory and size. 730 | /// 731 | /// @ 732 | /// transpose 'empty' == 'empty' 733 | /// transpose ('vertex' x) == 'vertex' x 734 | /// transpose ('edge' x y) == 'edge' y x 735 | /// transpose . transpose == id 736 | /// transpose ('box' x y) == 'box' (transpose x) (transpose y) 737 | /// 'edgeList' . transpose == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' 738 | /// @ 739 | let transpose (g : 'a Graph) : 'a Graph = 740 | foldg empty vertex overlay (fun x y -> connect y x) g 741 | 742 | /// Filter vertices in a subgraph context. 743 | let filterContext (s : 'a) (i : 'a -> bool) (o : 'a -> bool) (g : 'a Graph) : 'a Graph = 744 | let maybe b f a = match a with Some a -> f a | None -> b 745 | let go (context : 'a Context) = 746 | let g1 = induce ((<>) s) g 747 | let g2 = transpose (star s (List.filter i context.Inputs)) 748 | let g3 = star s (List.filter o context.Outputs) 749 | overlay (overlay g1 g2) g3 750 | maybe g go (context ((=) s) g) 751 | 752 | /// Remove an edge from a given graph. 753 | /// Complexity: /O(s)/ time, memory and size. 754 | /// 755 | /// @ 756 | /// removeEdge x y ('edge' x y) == 'vertices' [x,y] 757 | /// removeEdge x y . removeEdge x y == removeEdge x y 758 | /// removeEdge x y . 'removeVertex' x == 'removeVertex' x 759 | /// removeEdge 1 1 (1 * 1 * 2 * 2) == 1 * 2 * 2 760 | /// removeEdge 1 2 (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2 761 | /// 'size' (removeEdge x y z) <= 3 * 'size' z 762 | /// @ 763 | let removeEdge (s : 'a) (t : 'a) (g : 'a Graph) : 'a Graph = 764 | filterContext s ((<>) s) ((<>) t) g 765 | 766 | /// The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a 767 | /// given 'Graph'. If @y@ already exists, @x@ and @y@ will be merged. 768 | /// Complexity: /O(s)/ time, memory and size. 769 | /// 770 | /// @ 771 | /// replaceVertex x x == id 772 | /// replaceVertex x y ('vertex' x) == 'vertex' y 773 | /// replaceVertex x y == 'mergeVertices' (== x) y 774 | /// @ 775 | let replaceVertex (u : 'a) (v : 'a) (g : 'a Graph) : 'a Graph = 776 | map (fun w -> if w = u then v else w) g 777 | 778 | /// | Merge vertices satisfying a given predicate into a given vertex. 779 | /// Complexity: /O(s)/ time, memory and size, assuming that the predicate takes 780 | /// /O(1)/ to be evaluated. 781 | /// 782 | /// @ 783 | /// mergeVertices (const False) x == id 784 | /// mergeVertices (== x) y == 'replaceVertex' x y 785 | /// mergeVertices even 1 (0 * 2) == 1 * 1 786 | /// mergeVertices odd 1 (3 + 4 * 5) == 4 * 1 787 | /// @ 788 | let mergeVertices (p : 'a -> bool) (v : 'a) (g : 'a Graph) : 'a Graph = 789 | map (fun w -> if p w then v else w) g 790 | 791 | /// Split a vertex into a list of vertices with the same connectivity. 792 | /// Complexity: /O(s + k * L)/ time, memory and size, where /k/ is the number of 793 | /// occurrences of the vertex in the expression and /L/ is the length of the 794 | /// given list. 795 | /// 796 | /// @ 797 | /// splitVertex x [] == 'removeVertex' x 798 | /// splitVertex x [x] == id 799 | /// splitVertex x [y] == 'replaceVertex' x y 800 | /// splitVertex 1 [0,1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3) 801 | /// @ 802 | let splitVertex (v : 'a) (us : 'a list) (g : 'a Graph) : 'a Graph = 803 | bind g (fun w -> if w = v then vertices us else vertex w) 804 | 805 | //{-# RULES 806 | //"transpose/Empty" transpose Empty = Empty 807 | //"transpose/Vertex" forall x. transpose (Vertex x) = Vertex x 808 | //"transpose/Overlay" forall g1 g2. transpose (Overlay g1 g2) = Overlay (transpose g1) (transpose g2) 809 | //"transpose/Connect" forall g1 g2. transpose (Connect g1 g2) = Connect (transpose g2) (transpose g1) 810 | 811 | //"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs) 812 | //"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs)) 813 | 814 | //"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs 815 | //"transpose/clique" forall xs. transpose (clique xs) = clique (reverse xs) 816 | // #-} 817 | 818 | let simple (op : 'g -> 'g -> 'g) (x : 'g) (y : 'g) : 'g = 819 | let z = op x y 820 | if x = z then 821 | x 822 | else if y = z then 823 | y 824 | else 825 | z 826 | 827 | /// Simplify a graph expression. Semantically, this is the identity function, 828 | /// but it simplifies a given expression according to the laws of the algebra. 829 | /// The function does not compute the simplest possible expression, 830 | /// but uses heuristics to obtain useful simplifications in reasonable time. 831 | /// Complexity: the function performs /O(s)/ graph comparisons. It is guaranteed 832 | /// that the size of the result does not exceed the size of the given expression. 833 | /// 834 | /// @ 835 | /// simplify == id 836 | /// 'size' (simplify x) <= 'size' x 837 | /// simplify 'empty' '===' 'empty' 838 | /// simplify 1 '===' 1 839 | /// simplify (1 + 1) '===' 1 840 | /// simplify (1 + 2 + 1) '===' 1 + 2 841 | /// simplify (1 * 1 * 1) '===' 1 * 1 842 | /// @ 843 | let simplify (g : 'a Graph) : 'a Graph = 844 | foldg empty vertex (simple overlay) (simple connect) g 845 | 846 | /// Compute the /Cartesian product/ of graphs. 847 | /// Complexity: /O(s1 * s2)/ time, memory and size, where /s1/ and /s2/ are the 848 | /// sizes of the given graphs. 849 | /// 850 | /// @ 851 | /// box ('path' [0,1]) ('path' "ab") == 'edges' [ ((0,\'a\'), (0,\'b\')) 852 | /// , ((0,\'a\'), (1,\'a\')) 853 | /// , ((0,\'b\'), (1,\'b\')) 854 | /// , ((1,\'a\'), (1,\'b\')) ] 855 | /// @ 856 | /// Up to an isomorphism between the resulting vertex types, this operation 857 | /// is /commutative/, /associative/, /distributes/ over 'overlay', has singleton 858 | /// graphs as /identities/ and 'empty' as the /annihilating zero/. Below @~~@ 859 | /// stands for the equality up to an isomorphism, e.g. @(x, ()) ~~ x@. 860 | /// 861 | /// @ 862 | /// box x y ~~ box y x 863 | /// box x (box y z) ~~ box (box x y) z 864 | /// box x ('overlay' y z) == 'overlay' (box x y) (box x z) 865 | /// box x ('vertex' ()) ~~ x 866 | /// box x 'empty' ~~ 'empty' 867 | /// 'transpose' (box x y) == box ('transpose' x) ('transpose' y) 868 | /// 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y 869 | /// 'edgeCount' (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y 870 | /// @ 871 | let box (x : 'a Graph) (y : 'b Graph) : ('a * 'b) Graph = 872 | let xs = y |> toList |> List.map (fun b -> map (fun a -> a, b) x) 873 | let ys = x |> toList |> List.map (fun a -> map (fun b -> a, b) y) 874 | xs @ ys |> overlays 875 | -------------------------------------------------------------------------------- /Alga.FSharp/Internal.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp.Internal 2 | 3 | /// The /focus/ of a graph expression is a flattened represenentation of the 4 | /// subgraph under focus, its context, as well as the list of all encountered 5 | /// vertices. See 'Algebra.Graph.removeEdge' for a use-case example. 6 | type 'a Focus = 7 | { 8 | Ok : bool // True if focus on the specified subgraph is obtained. 9 | Is : 'a List // Inputs into the focused subgraph. 10 | Os : 'a List // Outputs out of the focused subgraph. 11 | Vs : 'a List // All vertices (leaves) of the graph expression. 12 | } 13 | 14 | /// An auxiliary data type for 'hasEdge': when searching for an edge, we can hit 15 | /// its 'Tail', i.e. the source vertex, the whole 'Edge', or 'Miss' it entirely. 16 | type Hit = Miss | Tail | Edge 17 | 18 | [] 19 | module Focus = 20 | 21 | let focus ok is os vs = { Ok = ok ; Is = is ; Os = os ; Vs = vs } 22 | 23 | /// Focus on the empty graph. 24 | let emptyFocus<'a> : 'a Focus = 25 | focus false [] [] [] 26 | 27 | /// Focus on the graph with a single vertex, given a predicate indicating 28 | /// whether the vertex is of interest. 29 | let vertexFocus (f : 'a -> bool) (x : 'a) : 'a Focus = 30 | focus (f x) [] [] [x] 31 | 32 | /// Overlay two foci. 33 | let overlayFoci (x : 'a Focus) (y : 'a Focus) : 'a Focus = 34 | focus (x.Ok || y.Ok) (x.Is @ y.Is) (x.Os @ y.Os) (x.Vs @ y.Vs) 35 | 36 | /// Connect two foci. 37 | let connectFoci (x : 'a Focus) (y : 'a Focus) : 'a Focus = 38 | let xs = if y.Ok then x.Vs else x.Is 39 | let ys = if x.Ok then y.Vs else y.Os 40 | focus (x.Ok || y.Ok) (xs @ y.Is) (x.Os @ ys) (x.Vs @ y.Vs) 41 | -------------------------------------------------------------------------------- /Alga.FSharp/Map.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp 2 | 3 | [] 4 | module Map = 5 | 6 | /// Return all keys of the map. 7 | let keys m = m |> Map.toSeq |> Seq.map fst 8 | 9 | /// The set of all keys of the map. 10 | let keysSet m = m |> keys |> Set.ofSeq 11 | 12 | /// A map with a single element. 13 | let singleton k v = Map.empty |> Map.add k v 14 | 15 | /// Union with a combining function. 16 | let unionWith f m1 m2 = 17 | Map.fold (fun m k v -> Map.add k (match Map.tryFind k m with None -> v | Some v' -> f v v') m) m1 m2 18 | 19 | /// The union of a list of maps, with a combining operation: (unionsWith f == foldl (unionWith f) empty). 20 | let unionsWith f ms = 21 | Seq.fold (unionWith f) Map.empty ms 22 | 23 | /// The expression (isSubmapOfBy f t1 t2) returns true if all keys in t1 are in tree t2, and when f returns true when applied to their respective values. 24 | let isSubmapOfBy (f : 'v1 -> 'v2 -> bool) (m1 : Map<'k, 'v1>) (m2 : Map<'k, 'v2>) : bool = 25 | m1 |> Map.forall (fun k v1 -> match Map.tryFind k m2 with | None -> false | Some v2 -> f v1 v2) 26 | 27 | /// Build a map from a set of keys and a function which for each key computes its value. 28 | let fromSet (f : 'k -> 'v) (keys : 'k Set) : Map<'k, 'v> = 29 | keys |> Seq.map (fun k -> k, f k) |> Map.ofSeq 30 | 31 | /// Update a value at a specific key with the result of the provided function. When the key is not a member of the map, the original map is returned. 32 | let adjust (f : 'a -> 'a) (k : 'k) (m : Map<'k, 'a>) : Map<'k, 'a> = 33 | match m |> Map.tryFind k with 34 | | Some v -> m |> Map.add k (f v) 35 | | None -> m 36 | 37 | /// mapKeysWith c f s is the map obtained by applying f to each key of s. 38 | /// The size of the result may be smaller if f maps two or more distinct keys to the same new key. 39 | /// In this case the associated values will be combined using c. The value at the greater of the two original keys is used as the first argument to c. 40 | let mapKeysWith (f : 'a -> 'a -> 'a) (g : 'k1 -> 'k2) (m : Map<'k1, 'a>) : Map<'k2, 'a> = 41 | m 42 | |> Map.toSeq 43 | |> Seq.map (fun (k, v) -> g k, v) 44 | |> Seq.groupBy fst 45 | |> Seq.map (fun (k, vs) -> k, vs |> Seq.map snd |> Seq.reduce f) 46 | |> Map.ofSeq 47 | -------------------------------------------------------------------------------- /Alga.FSharp/Option.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp 2 | 3 | [] 4 | module Option = 5 | 6 | let guard b = 7 | match b with 8 | | true -> Some () 9 | | false -> None 10 | 11 | 12 | type OptionBuilder () = 13 | 14 | member __.Return a = Some a 15 | 16 | member __.ReturnFrom (a : 'a option) = a 17 | 18 | member __.Bind (a : 'a option, f : 'a -> 'b option) : 'b option = 19 | Option.bind f a 20 | 21 | 22 | [] 23 | module OptionBuilder = 24 | 25 | let option = OptionBuilder () 26 | -------------------------------------------------------------------------------- /Alga.FSharp/Tree.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp 2 | 3 | /// Non-empty, possibly infinite, multi-way trees; also known as rose trees. 4 | type 'a Tree = 5 | { 6 | RootLabel : 'a 7 | SubForest : 'a Forest 8 | } 9 | 10 | and 'a Forest = 'a Tree list 11 | 12 | [] 13 | module Tree = 14 | 15 | let rec map (f : 'a -> 'b) (t : 'a Tree) : 'b Tree = 16 | { 17 | RootLabel = f t.RootLabel 18 | SubForest = List.map (map f) t.SubForest 19 | } 20 | 21 | /// Returns the elements of a tree in pre-order. 22 | let rec flatten (t : 'a Tree) : 'a seq = 23 | seq { 24 | yield t.RootLabel 25 | for t in t.SubForest do yield! flatten t 26 | } 27 | 28 | let toList (t : 'a Tree) : 'a list = 29 | t |> flatten |> List.ofSeq 30 | -------------------------------------------------------------------------------- /Alga.FSharp/Typed.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp 2 | 3 | (* 4 | Module : Data.Graph.Typed 5 | Copyright : (c) Anton Lorenzen, Andrey Mokhov 2016-2018 6 | License : MIT (see the file LICENSE) 7 | Maintainer : anfelor@posteo.de, andrey.mokhov@gmail.com 8 | Stability : unstable 9 | 10 | __Alga__ is a library for algebraic construction and manipulation of graphs 11 | in Haskell. See for the 12 | motivation behind the library, the underlying theory, and implementation details. 13 | 14 | This module provides primitives for interoperability between this library and 15 | the "Data.Graph" module of the containers library. It is for internal use only 16 | and may be removed without notice at any point. 17 | *) 18 | 19 | /// 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in 20 | /// the "Data.Graph" module of the @containers@ library. 21 | type 'a GraphKL = 22 | { 23 | /// Array-based graph representation (King and Launchbury, 1995). 24 | ToGraphKL : UntypedGraph 25 | /// A mapping of "Data.Graph.Vertex" to vertices of type @a@. 26 | /// This is partial and may fail if the vertex is out of bounds. 27 | FromVertexKL : Vertex -> 'a 28 | /// A mapping from vertices of type @a@ to "Data.Graph.Vertex". 29 | /// Returns 'Nothing' if the argument is not in the graph. 30 | ToVertexKL : 'a -> Vertex option 31 | } 32 | 33 | [] 34 | module Typed = 35 | 36 | /// Compute the /depth-first search/ forest of a graph. 37 | /// 38 | /// In the following we will use the helper function: 39 | /// 40 | /// @ 41 | /// (%) :: (GraphKL Int -> a) -> AM.AdjacencyMap Int -> a 42 | /// a % g = a $ fromAdjacencyMap g 43 | /// @ 44 | /// for greater clarity. (One could use an AdjacencyIntMap just as well) 45 | /// 46 | /// @ 47 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % 'Algebra.Graph.AdjacencyMap.edge' 1 1) == 'AM.vertex' 1 48 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % 'Algebra.Graph.AdjacencyMap.edge' 1 2) == 'Algebra.Graph.AdjacencyMap.edge' 1 2 49 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % 'Algebra.Graph.AdjacencyMap.edge' 2 1) == 'AM.vertices' [1, 2] 50 | /// 'AM.isSubgraphOf' ('Algebra.Graph.AdjacencyMap.forest' $ dfsForest % x) x == True 51 | /// dfsForest % 'Algebra.Graph.AdjacencyMap.forest' (dfsForest % x) == dfsForest % x 52 | /// dfsForest % 'AM.vertices' vs == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs) 53 | /// 'Algebra.Graph.AdjacencyMap.dfsForestFrom' ('Algebra.Graph.AdjacencyMap.vertexList' x) % x == dfsForest % x 54 | /// dfsForest % (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1 55 | /// , subForest = [ Node { rootLabel = 5 56 | /// , subForest = [] }]} 57 | /// , Node { rootLabel = 3 58 | /// , subForest = [ Node { rootLabel = 4 59 | /// , subForest = [] }]}] 60 | /// @ 61 | let dfsForest (g : 'a GraphKL) : 'a Forest = 62 | List.map (Tree.map g.FromVertexKL) (Untyped.dff g.ToGraphKL) 63 | 64 | /// Compute the /depth-first search/ forest of a graph, searching from each of 65 | /// the given vertices in order. Note that the resulting forest does not 66 | /// necessarily span the whole graph, as some vertices may be unreachable. 67 | /// 68 | /// @ 69 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [1] % 'Algebra.Graph.AdjacencyMap.edge' 1 1) == 'AM.vertex' 1 70 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [1] % 'Algebra.Graph.AdjacencyMap.edge' 1 2) == 'Algebra.Graph.AdjacencyMap.edge' 1 2 71 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [2] % 'Algebra.Graph.AdjacencyMap.edge' 1 2) == 'AM.vertex' 2 72 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [3] % 'Algebra.Graph.AdjacencyMap.edge' 1 2) == 'AM.empty' 73 | /// 'Algebra.Graph.AdjacencyMap.forest' (dfsForestFrom [2, 1] % 'Algebra.Graph.AdjacencyMap.edge' 1 2) == 'Algebra.Graph.AdjacencyMap.vertices' [1, 2] 74 | /// 'Algebra.Graph.AdjacencyMap.isSubgraphOf' ('Algebra.Graph.AdjacencyMap.forest' $ dfsForestFrom vs % x) x == True 75 | /// dfsForestFrom ('Algebra.Graph.AdjacencyMap.vertexList' x) % x == 'dfsForest' % x 76 | /// dfsForestFrom vs % 'Algebra.Graph.AdjacencyMap.vertices' vs == map (\\v -> Node v []) ('Data.List.nub' vs) 77 | /// dfsForestFrom [] % x == [] 78 | /// dfsForestFrom [1, 4] % (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1 79 | /// , subForest = [ Node { rootLabel = 5 80 | /// , subForest = [] } 81 | /// , Node { rootLabel = 4 82 | /// , subForest = [] }] 83 | /// @ 84 | let dfsForestFrom (vs : 'a seq) (g : 'a GraphKL) : 'a Forest = 85 | Untyped.dfs g.ToGraphKL (vs |> Seq.choose g.ToVertexKL) |> List.map (Tree.map g.FromVertexKL) 86 | 87 | /// Compute the list of vertices visited by the /depth-first search/ in a graph, 88 | /// when searching from each of the given vertices in order. 89 | /// 90 | /// @ 91 | /// dfs [1] % 'Algebra.Graph.AdjacencyMap.edge' 1 1 == [1] 92 | /// dfs [1] % 'Algebra.Graph.AdjacencyMap.edge' 1 2 == [1,2] 93 | /// dfs [2] % 'Algebra.Graph.AdjacencyMap.edge' 1 2 == [2] 94 | /// dfs [3] % 'Algebra.Graph.AdjacencyMap.edge' 1 2 == [] 95 | /// dfs [1,2] % 'Algebra.Graph.AdjacencyMap.edge' 1 2 == [1,2] 96 | /// dfs [2,1] % 'Algebra.Graph.AdjacencyMap.edge' 1 2 == [2,1] 97 | /// dfs [] % x == [] 98 | /// dfs [1,4] % (3 * (1 + 4) * (1 + 5)) == [1, 5, 4] 99 | /// 'Algebra.Graph.AdjacencyMap.isSubgraphOf' ('Algebra.Graph.AdjacencyMap.vertices' $ dfs vs x) x == True 100 | /// @ 101 | let dfs (vs : 'a seq) (g : 'a GraphKL) : 'a seq = 102 | g |> dfsForestFrom vs |> Seq.collect Tree.flatten 103 | 104 | /// Compute the /topological sort/ of a graph. 105 | /// Unlike the (Int)AdjacencyMap algorithm this returns 106 | /// a result even if the graph is cyclic. 107 | /// 108 | /// @ 109 | /// topSort % (1 * 2 + 3 * 1) == [3,1,2] 110 | /// topSort % (1 * 2 + 2 * 1) == [1,2] 111 | /// @ 112 | let topSort (g : 'a GraphKL) : 'a seq = 113 | Seq.map g.FromVertexKL (Untyped.topSort g.ToGraphKL) 114 | -------------------------------------------------------------------------------- /Alga.FSharp/Untyped.fs: -------------------------------------------------------------------------------- 1 | namespace Alga.FSharp 2 | 3 | /// Abstract representation of vertices. 4 | type Vertex = int 5 | 6 | /// Adjacency list representation of a graph, mapping each vertex to its 7 | /// list of successors. 8 | type UntypedGraph = Vertex list array 9 | 10 | /// An edge from the first vertex to the second. 11 | type Edge = Vertex * Vertex 12 | 13 | 14 | [] 15 | module Untyped = 16 | open System 17 | 18 | let vertices (g : UntypedGraph) : Vertex list = 19 | List.init g.Length id 20 | 21 | let edges (g : UntypedGraph) : Edge list = 22 | g |> vertices |> List.collect (fun v -> g.[v] |> List.map (fun v2 -> v, v2)) 23 | 24 | /// Build a graph from a list of nodes uniquely identified by keys, 25 | /// with a list of keys of nodes this node should have edges to. 26 | /// The out-list may contain keys that don't correspond to 27 | /// nodes of the graph; they are ignored. 28 | let graphFromEdges (edges : ('node * 'key * 'key seq) seq) : (UntypedGraph * (Vertex -> ('node * 'key * 'key seq)) * ('key -> Vertex option)) = 29 | raise <| NotImplementedException "TODO: Implement me" 30 | 31 | /// A spanning forest of the part of the graph reachable from the listed 32 | /// vertices, obtained from a depth-first search of the graph starting at 33 | /// each of the listed vertices in order. 34 | let dfs (g : UntypedGraph) (vs : Vertex seq) : Vertex Forest = 35 | raise <| NotImplementedException "TODO: Implement me" 36 | 37 | /// A spanning forest of the graph, obtained from a depth-first search of 38 | /// the graph starting from each vertex in an unspecified order. 39 | let dff (g : UntypedGraph) : Vertex Forest = 40 | dfs g (vertices g) 41 | 42 | let rec postorder (t : 'a Tree) : 'a list = 43 | postorderF t.SubForest @ [t.RootLabel] 44 | 45 | and postorderF (ts : 'a Forest) : 'a list = 46 | ts |> List.collect postorder 47 | 48 | let postOrd (g : UntypedGraph) : Vertex list = 49 | g |> dff |> postorderF 50 | 51 | /// A topological sort of the graph. 52 | /// The order is partially specified by the condition that a vertex /i/ 53 | /// precedes /j/ whenever /j/ is reachable from /i/ but not vice versa. 54 | let topSort (g : UntypedGraph) : Vertex list = 55 | g |> postOrd |> List.rev 56 | 57 | /// Build a graph from a list of edges. 58 | let buildG (size : int) (es : Edge list) : UntypedGraph = 59 | let g = Array.replicate size [] 60 | es |> List.iter (fun (v1, v2) -> g.[v1] <- v2 :: g.[v1]) 61 | g 62 | 63 | let reverseE (g : UntypedGraph) : Edge list = 64 | g |> edges |> List.map (fun (v, w) -> w, v) 65 | 66 | /// The graph obtained by reversing all edges. 67 | let transposeG (g : UntypedGraph) : UntypedGraph = 68 | buildG g.Length (reverseE g) 69 | 70 | /// The strongly connected components of a graph. 71 | let scc (g : UntypedGraph) : Vertex Forest = 72 | g |> transposeG |> postOrd |> List.rev |> dfs g 73 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Nicholas Cowle 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Alga.FSharp 2 | 3 | [![Build Status](https://travis-ci.org/algebraic-graphs/fsharp.svg?branch=master)](https://travis-ci.org/algebraic-graphs/fsharp) 4 | 5 | Alga.FSharp is an F# port of the [Algebraic graphs library](https://github.com/snowleopard/alga) by [Andrey Mokhov](https://www.ncl.ac.uk/engineering/staff/profile/andreymokhov.html#background). The library is .NET Standard, so can be built and run on Windows, Linux and macOS alike. 6 | 7 | ## Checkout, building and editing 8 | 9 | To work on Alga.FSharp, I recommend using the cross-platform editor [Visual Studio Code](https://code.visualstudio.com/) with the [Ionide](http://ionide.io/) extension. 10 | 11 | First, ensure you have the following installed: 12 | * .NET Core (https://www.microsoft.com/net/download) 13 | * Visual Studio Code (https://code.visualstudio.com/) 14 | * From inside Visual Studio Code, the Ionide extension 15 | 16 | Now, run the following commands in the terminal: 17 | 18 | ``` 19 | git clone https://github.com/nickcowle/alga-fsharp.git 20 | cd alga-fsharp 21 | dotnet build 22 | code . 23 | ``` 24 | 25 | ## Main idea 26 | 27 | Consider the following data type, which is defined in the top-level module 28 | [Graph](https://github.com/nickcowle/alga-fsharp/blob/master/Alga.FSharp/Graph.fs) 29 | of the library: 30 | 31 | ```fsharp 32 | type 'a Graph = 33 | | Empty 34 | | Vertex of 'a 35 | | Overlay of 'a Graph * 'a Graph 36 | | Connect of 'a Graph * 'a Graph 37 | ``` 38 | 39 | We can give the following semantics to the constructors in terms of the pair **(V, E)** of graph *vertices* and *edges*: 40 | 41 | * `Empty` constructs the empty graph **(∅, ∅)**. 42 | * `Vertex x` constructs a graph containing a single vertex, i.e. **({x}, ∅)**. 43 | * `Overlay (x, y)` overlays graphs **(Vx, Ex)** and **(Vy, Ey)** constructing **(Vx ∪ Vy, Ex ∪ Ey)**. 44 | * `Connect (x, y)` connects graphs **(Vx, Ex)** and **(Vy, Ey)** constructing **(Vx ∪ Vy, Ex ∪ Ey ∪ Vx × Vy)**. 45 | 46 | The laws associated with the constructors of this type are remarkably similar to those of a [semiring](https://en.wikipedia.org/wiki/Semiring), 47 | so we use `+` and `*` as convenient shortcuts for `Overlay` and `Connect`, respectively: 48 | 49 | * (`+`, `Empty`) is an idempotent commutative monoid. 50 | * (`*`, `Empty`) is a monoid. 51 | * `*` distributes over `+`, that is: `x * (y + z) == x * y + x * z` and `(x + y) * z == x * z + y * z`. 52 | * `*` can be decomposed: `x * y * z == x * y + x * z + y * z`. 53 | 54 | This algebraic structure corresponds to *unlabelled directed graphs*: every expression represents a graph, and every 55 | graph can be represented by an expression. Other types of graphs (e.g. undirected) can be obtained by modifying the 56 | above set of laws. Algebraic graphs provide a convenient, safe and powerful interface for working with graphs in F#, 57 | and allow the application of equational reasoning for proving the correctness of graph algorithms. 58 | --------------------------------------------------------------------------------