diff --git a/src/categorical_algebra/CSetDataStructures.jl b/src/categorical_algebra/CSetDataStructures.jl index ea92578a7..12a11c237 100644 --- a/src/categorical_algebra/CSetDataStructures.jl +++ b/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) diff --git a/src/categorical_algebra/CategoricalAlgebra.jl b/src/categorical_algebra/CategoricalAlgebra.jl index bf03cc564..68b645a58 100644 --- a/src/categorical_algebra/CategoricalAlgebra.jl +++ b/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 diff --git a/src/categorical_algebra/PACSets.jl b/src/categorical_algebra/PACSets.jl new file mode 100644 index 000000000..9461d2cd5 --- /dev/null +++ b/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 diff --git a/src/theories/MonoidalSchema.jl b/src/theories/MonoidalSchema.jl new file mode 100644 index 000000000..e130f283d --- /dev/null +++ b/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 diff --git a/src/theories/Theories.jl b/src/theories/Theories.jl index 8b0094a99..052383931 100644 --- a/src/theories/Theories.jl +++ b/src/theories/Theories.jl @@ -27,5 +27,6 @@ include("HigherCategory.jl") include("Preorders.jl") include("Relations.jl") include("Schema.jl") +include("MonoidalSchema.jl") end diff --git a/test/categorical_algebra/PACSets.jl b/test/categorical_algebra/PACSets.jl new file mode 100644 index 000000000..4de3f85ff --- /dev/null +++ b/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 + diff --git a/test/theories/MonoidalSchema.jl b/test/theories/MonoidalSchema.jl new file mode 100644 index 000000000..418aff5d7 --- /dev/null +++ b/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