Product ACSets

src/categorical_algebra/CSetDataStructures.jl

@@ -27,6 +27,8 @@ const StructCSet = StructACSet{S,Tuple{},Idxed,UniqueIdxed} where
 q(s::Symbol) = Expr(:quote,s)
 q(s::GATExpr) = q(nameof(s))
 
+Syntax.nameof(s::Symbol) = s
+
 """ Creates a quoted named tuple used for `StructACSet`s
 """
 function pi_type(dom::Vector, F::Function)

src/categorical_algebra/CategoricalAlgebra.jl

@@ -15,6 +15,7 @@ include("StructuredCospans.jl")
 include("CommutativeDiagrams.jl")
 include("DataMigration.jl")
 include("DPO.jl")
+include("PACSets.jl")
 
 @reexport using .FreeDiagrams
 @reexport using .CommutativeDiagrams

src/categorical_algebra/PACSets.jl

@@ -0,0 +1,156 @@
+module PACSets
+
+export @pacset_type, @abstract_pacset_type, StructPACSet
+
+using MLStyle
+using StaticArrays
+using Reexport
+
+using ...Present
+@reexport using ...ACSetInterface
+using ...Theories: MSchemaDesc, MSchemaDescType, MSchemaDescTypeType, MonoidalSchema
+@reexport using ...Theories: FreeMonoidalSchema
+using ...CSetDataStructures: pi_type, pi_type_elt, q
+
+abstract type StructPACSet{S<:MSchemaDescType, Ts<:Tuple} end
+
+function product_hom_type(s::MSchemaDesc, f::Symbol)
+  component_ty = :(Array{Int64, $(length(s.doms[f]))})
+  :(Tuple{$(fill(component_ty, length(s.codoms[f]))...)})
+end
+
+function product_attr_type(s::MSchemaDesc, f::Symbol)
+  component_tys = [:(Array{$T, $(length(s.doms[f]))}) for T in s.codoms[f]]
+  :(Tuple{$(component_tys...)})
+end
+
+function array_initializer(s::MSchemaDesc, f::Symbol; attr=false, sizes=false)
+  type = attr ? x -> x : _ -> :Int64
+  size = sizes ? x -> x : _ -> 0
+  Expr(:tuple,
+       [:(Array{$(type(y)), $(length(s.doms[f]))}(
+         undef, $(Expr(:tuple, [size(x) for x in s.doms[f]]...))))
+       for y in s.codoms[f]]...)
+end
+
+function struct_pacset(name::Symbol, parent, p::Presentation{MonoidalSchema})
+  s = MSchemaDesc(p)
+  parameterized_type, new_call = if length(s.attrtypes) > 0
+    (:($name{$(s.attrtypes...)}), :(new{$(s.attrtypes...)}))
+  else
+    (name, :new)
+  end
+  schema_type = MSchemaDescTypeType(s)
+  obs_t = :($(GlobalRef(StaticArrays, :MVector)){$(length(s.obs)), Int})
+  quote
+    struct $parameterized_type <: $parent{$schema_type, Tuple{$(s.attrtypes...)}}
+      obs::$obs_t
+      homs::$(pi_type(s.homs, f -> product_hom_type(s, f)))
+      attrs::$(pi_type(s.attrs, f -> product_attr_type(s, f)))
+      function $parameterized_type() where {$(s.attrtypes...)}
+        $new_call(
+          $obs_t(zeros(Int, $(length(s.obs)))),
+          $(pi_type_elt(s.homs, f -> array_initializer(s, f))),
+          $(pi_type_elt(s.attrs, f -> array_initializer(s, f; attr=true)))
+        )
+      end
+
+      function $parameterized_type(
+        ;$([Expr(:kw, x, 0) for x in s.obs]...),
+        $([Expr(:kw, f, nothing) for f in s.homs]...),
+        $([Expr(:kw, a, nothing) for a in s.attrs]...)) where {$(s.attrtypes...)}
+        $(Expr(:block,
+               (map(vcat(s.homs, s.attrs)) do a
+                 quote
+                   if $a != nothing
+                     $(Expr(:block,
+                            (map(enumerate(s.doms[a])) do (i,x)
+                              quote
+                                if $x != 0
+                                  @assert $x == size($a)[$i]
+                                else
+                                  $x = size($a)[$i]
+                                end
+                              end
+                             end)...))
+                   end
+                 end
+                end)...))
+        pacs = $new_call(
+          $obs_t($(Expr(:vect, s.obs...))),
+          $(pi_type_elt(s.homs, f -> array_initializer(s, f; sizes = true))),
+          $(pi_type_elt(s.attrs, f -> array_initializer(s, f; sizes = true, attr=true)))
+        )
+        $(Expr(:block,
+               [:($(GlobalRef(ACSetInterface, :set_subpart!))(pacs, $(q(f)), $f))
+                for f in vcat(s.homs, s.attrs)]...))
+        pacs
+      end
+    end
+  end
+end
+
+macro pacset_type(head)
+  head, parent = @match head begin
+    Expr(:(<:), h, p) => (h,p)
+    _ => (head, GlobalRef(PACSets, :StructPACSet))
+  end
+  name, schema, idx_args = @match head begin
+    Expr(:call, name, schema, idx_args...) => (name, schema, idx_args)
+    _ => error("Unsupported head for @pacset_type")
+  end
+
+  quote
+    const tmp = $(esc(:eval))($(GlobalRef(PACSets, :struct_pacset))(
+      $(Expr(:quote, name)), $(Expr(:quote, parent)), $(esc(schema))
+    ))
+  end
+end
+
+ACSetInterface.nparts(pacs::StructPACSet, x::Symbol) = _nparts(pacs, Val{x})
+
+@generated function _nparts(pacs::StructPACSet{S}, ::Type{Val{x}}) where {S,x}
+  s = MSchemaDesc(S)
+  :(pacs.obs[$(findfirst(s.obs .== x))])
+end
+
+ACSetInterface.subpart(pacs::StructPACSet, f::Symbol) = _subpart(pacs, Val{f})
+
+@generated function _subpart(pacs::StructPACSet{S}, ::Type{Val{f}}) where {S, f}
+  s = MSchemaDesc(S)
+  if f ∈ s.homs
+    :(pacs.homs.$f[1])
+  elseif f ∈ s.attrs
+    :(pacs.attrs.$f[1])
+  else
+    error("subpart $f not found")
+  end
+end
+
+ACSetInterface.set_subpart!(pacs::StructPACSet, f::Symbol, val) = _set_subpart!(pacs, Val{f}, val)
+
+@generated function _set_subpart!(pacs::StructPACSet{S, Ts}, ::Type{Val{f}}, val::Array{T,n}) where
+  {S, Ts, f, T, n}
+  s = MSchemaDesc(S)
+  @assert n == length(s.doms[f])
+  cod = only(s.codoms[f])
+  if f ∈ s.homs
+    @assert T == Int64
+    quote
+      @assert size(val) == size(pacs.homs.$f[1])
+      pacs.homs.$f[1] .= val
+    end
+  else
+    @assert T == Ts.parameters[findfirst(s.attrtypes .== cod)]
+    quote
+      @assert size(val) == size(pacs.attrs.$f[1])
+      pacs.attrs.$f[1] .= val
+    end
+  end
+end
+
+@generated function _set_subpart!(pacs::StructPACSet, _, val::Nothing)
+  :(nothing)
+end
+
+end

src/theories/MonoidalSchema.jl

@@ -0,0 +1,121 @@
+export MonoidalSchema, FreeMonoidalSchema
+
+using AutoHashEquals
+
+""" The GAT that parameterizes pacsets (product acsets)
+
+A monoidal schema is comprised of a monoidal category split into two parts, one
+of which is discrete.
+
+In theory you should be able to take monoidal products of attributes/attribute
+types, but I'm too lazy to write that down right now.
+"""
+@theory MonoidalSchema{Ob,Hom,AttrType,Attr} <: MonoidalCategory{Ob,Hom} begin
+  AttrType::TYPE
+  Attr(dom::Ob,codom::AttrType)::TYPE
+
+  """ Composition is given by the action of the profunctor on C.
+  """
+  compose(f::Hom(A,B), g::Attr(B,X))::Attr(A,X) ⊣ (A::Ob, B::Ob, X::AttrType)
+
+  (compose(f, compose(g, a)) == compose(compose(f, g), a)
+    ⊣ (A::Ob, B::Ob, C::Ob, X::AttrType, f::Hom(A,B), g::Hom(B,C), a::Attr(C, X)))
+  compose(id(A), a) == a ⊣ (A::Ob, X::AttrType, a::Attr(A,X))
+end
+
+@syntax FreeMonoidalSchema{ObExpr,HomExpr,AttrTypeExpr,AttrExpr} MonoidalSchema begin
+  otimes(A::Ob, B::Ob) = associate_unit(new(A,B), munit)
+  otimes(f::Hom, g::Hom) = associate(new(f,g))
+  # should have a normal representation for precompose of a morphism + a generator attribute
+  compose(f::Hom, g::Hom) = associate_unit(new(f,g; strict=true), id)
+  compose(f::Hom, x::Attr) = associate_unit(new(f,x; strict=true), id)
+end
+
+""" A monoidal schema encoded in a type, using a whole-grained Petri net like
+encoding
+
+All of the parameters are tuples of symbols. Obs, Homs, AttrTypes, and Attrs all
+give the names for the generators, and InputOb, InputMorph, OutputOb,
+OutputMorph give the inputs and outputs of the homs/attrs, whole-grained Petri
+net style
+"""
+struct MSchemaDescType{Obs, Homs, AttrTypes, Attrs, InputOb, InputMorph, OutputOb, OutputMorph}
+end
+
+@auto_hash_equals struct MSchemaDesc
+  obs::Vector{Symbol}
+  homs::Vector{Symbol}
+  attrtypes::Vector{Symbol}
+  attrs::Vector{Symbol}
+  doms::Dict{Symbol, Vector{Symbol}}
+  codoms::Dict{Symbol, Vector{Symbol}}
+end
+
+function push_to_index!(d::Dict{K,Vector{V}}, k::K, v::V) where {K,V}
+  if !(k ∈ keys(d))
+    d[k] = V[]
+  end
+  push!(d[k], v)
+end
+
+function MSchemaDesc(
+  ::Type{MSchemaDescType{Obs, Homs, AttrTypes, Attrs,
+                         InputOb, InputMorph, OutputOb, OutputMorph}}) where
+    {Obs, Homs, AttrTypes, Attrs, InputOb, InputMorph, OutputOb, OutputMorph}
+  @assert length(InputOb) == length(InputMorph) && length(OutputOb) == length(OutputMorph)
+  obs = Symbol[Obs...]
+  homs = Symbol[Homs...]
+  attrtypes = Symbol[AttrTypes...]
+  attrs = Symbol[Attrs...]
+  doms = Dict{Symbol, Vector{Symbol}}()
+  codoms = Dict{Symbol, Vector{Symbol}}()
+  for (x,f) in zip([InputOb...], [InputMorph...])
+    push_to_index!(doms, f, x)
+  end
+  for (x,f) in zip([OutputOb...], [OutputMorph...])
+    push_to_index!(codoms, f, x)
+  end
+  MSchemaDesc(obs, homs, attrtypes, attrs, doms, codoms)
+end
+
+normalize_monoidal_ob(_::ObExpr{:munit}) = Symbol[]
+normalize_monoidal_ob(x::ObExpr{:generator}) = [nameof(x)]
+normalize_monoidal_ob(x::ObExpr{:otimes}) = vcat(normalize_monoidal_ob.(x.args)...)
+
+
+function MSchemaDesc(p::Presentation)
+  obs,homs,attrtypes,attrs = map(t -> p.generators[t],[:Ob,:Hom,:AttrType,:Attr])
+  ob_syms,hom_syms,attrtype_syms,attr_syms = map(xs -> nameof.(xs),
+                                                 [obs,homs,attrtypes,attrs])
+  hom_doms = Dict(nameof(f) => normalize_monoidal_ob(dom(f)) for f in homs)
+  attr_doms = Dict(nameof(f) => normalize_monoidal_ob(dom(f)) for f in attrs)
+  hom_codoms = Dict(nameof(f) => normalize_monoidal_ob(codom(f)) for f in homs)
+  attr_codoms = Dict(nameof(f) => [nameof(codom(f))] for f in attrs)
+
+  MSchemaDesc(
+    ob_syms, hom_syms, attrtype_syms, attr_syms,
+    Dict(hom_doms..., attr_doms...),
+    Dict(hom_codoms..., attr_codoms...)
+  )
+end
+
+function MSchemaDescTypeType(s::MSchemaDesc)
+  input_obs = Symbol[]
+  input_morphs = Symbol[]
+  output_obs = Symbol[]
+  output_morphs = Symbol[]
+  for (f,ins) in s.doms
+    append!(input_obs, ins)
+    append!(input_morphs, fill(f, length(ins)))
+  end
+  for (f,outs) in s.codoms
+    append!(output_obs, outs)
+    append!(output_morphs, fill(f, length(outs)))
+  end
+  MSchemaDescType{Tuple(s.obs), Tuple(s.homs), Tuple(s.attrtypes), Tuple(s.attrs),
+                  Tuple(input_obs), Tuple(input_morphs), Tuple(output_obs), Tuple(output_morphs)}
+end
+
+function MSchemaDescTypeType(p::Presentation)
+  MSchemaDescTypeType(MSchemaDesc(p))
+end

src/theories/Theories.jl

@@ -27,5 +27,6 @@ include("HigherCategory.jl")
 include("Preorders.jl")
 include("Relations.jl")
 include("Schema.jl")
+include("MonoidalSchema.jl")
 
 end

test/categorical_algebra/PACSets.jl

@@ -0,0 +1,24 @@
+module TestPACSets
+
+using Test
+using Catlab.Theories, Catlab.Present, Catlab.CategoricalAlgebra.PACSets
+
+@present TheoryMatrixGraph(FreeMonoidalSchema) begin
+  V::Ob
+  EdgeTy::AttrType
+  edges::Attr(V ⊗ V, EdgeTy)
+end
+
+@pacset_type MatrixGraph(TheoryMatrixGraph)
+
+# Intelligently set the number of vertices based on the edge matrix
+g = MatrixGraph{Bool}(edges = Bool[0 1 1; 0 0 1; 0 0 0])
+
+@test nparts(g, :V) == 3
+@test subpart(g, :edges) == Bool[0 1 1; 0 0 1; 0 0 0]
+
+# Won't accept a non-square matrix
+@test_throws AssertionError MatrixGraph{Bool}(edges = Bool[0 0 0])
+
+end
+

test/theories/MonoidalSchema.jl

@@ -0,0 +1,26 @@
+module TestMonoidalSchema
+
+using Test
+using Catlab.Present, Catlab.Theories
+using Catlab.Theories: MSchemaDesc, MSchemaDescType, MSchemaDescTypeType
+
+@present ThExp(FreeMonoidalSchema) begin
+  Sample::Ob
+  Feature::Ob
+  T::AttrType
+  X::Attr(Sample ⊗ Feature, T)
+  y::Attr(Sample, T)
+end
+
+s = MSchemaDesc(ThExp)
+
+@test s.obs == [:Sample, :Feature]
+@test s.attrs == [:X, :y]
+@test s.doms[:X] == [:Sample, :Feature]
+@test s.codoms[:y] == [:T]
+
+S = MSchemaDescTypeType(s)
+
+@test MSchemaDesc(S) == s
+
+end