Products of FinCats and isomorphism testing of diagrams of C-sets

src/categorical_algebra/CSets.jl

@@ -36,6 +36,7 @@
 import ..FinSets: FinSet, FinFunction, FinDomFunction, force, predicate, 
                   is_monic, is_epic, preimage
 import ..FinCats: FinDomFunctor, components, is_natural
+using ..FinCats: FinCatPresentation
 
 # Sets interop
 ##############
@@ -236,6 +237,19 @@
   return X
 end
 
+# Set-valued FinDomFunctors as ACSets, no specific ACS type given
+function ACSetFunctor(F::FinDomFunctor; structacset=false)
+  S = presentation(dom(F))
+  X = if structacset 
+    AnonACSet(S) 
+  else 
+    DynamicACSet("ACSetFunctor", S)
+  end
+  copy_parts!(X, F)
+  return X
+end
+
+
 """ Copy parts from a set-valued `FinDomFunctor` to an `ACSet`.
 """
 function ACSetInterface.copy_parts!(X::ACSet, F::FinDomFunctor)
@@ -1397,4 +1411,36 @@
 is_cartesian(f,hs=homs(acset_schema(dom(f)),just_names=true)) = all(h->is_cartesian_at(f,h),hs)
 
 
+@present SchArr(FreeSchema) begin (S,T)::Ob; arr::Hom(S, T) end
+
+function FinDomFunctor(f::T) where {ACS, T<:ACSetTransformation{ACS}}
+  obs = Dict(:S=>dom(f), :T => codom(f))
+  FinDomFunctor(obs, Dict(:arr=>f), FinCat(SchArr), TypeCat{ACS,T}())
+end
+
+"""Convert a nonempty C->D->Set into a (CxD)->Set"""
+function uncurry(d::FinDomFunctor)
+  S = acset_schema(ob_map(d, first(ob_generators(dom(d))))) # assumes not empty
+  shapelim = product(FinCatPresentation[dom(d), FinCat(Presentation(S))])
+  shape_ind, part_ind = legs(shapelim)
+  apx = apex(shapelim)
+  omap = Dict(map(ob_generators(apx)) do o
+    o => FinSet(ob_map(d, ob_map(shape_ind, o)), Symbol(ob_map(part_ind, o)))
+  end)
+
+  hmap = Dict(map(hom_generators(apx)) do o
+    x = hom_map(shape_ind, o)
+    y = hom_map(part_ind, o)
+    if first(typeof(x).parameters) == :id # comes from a hom w/in an ACSet
+      o => FinFunction(ob_map(d, only(x.args)), Symbol(y))
+    elseif first(typeof(y).parameters) == :id # comes from an ACSetTransformation
+      o => hom_map(d, x)[Symbol(only(y.args))]
+    else
+      error("x $x $(typeof(x)) y $y $(typeof(y))")
+    end
+  end)
+
+  return FinDomFunctor(omap, hmap, apx, TypeCat{SetOb, FinDomFunction{Int}}())
+end
+
 end # module

src/categorical_algebra/Diagrams.jl

@@ -8,11 +8,11 @@ using StructEquality
 
 using GATlab
 import ...Theories: dom, codom, id, compose, ⋅, ∘, munit
-using ...Theories: ThCategory, composeH, FreeSchema
+using ...Theories: ThCategory, composeH, FreeSchema, Ob, Hom
 import ..Categories: ob_map, hom_map, op, co
 using ..FinCats, ..FreeDiagrams, ..FinSets
 using ..FinCats: mapvals,FinDomFunctorMap,FinCatPresentation
-import ..FinCats: force, collect_ob, collect_hom
+import ..FinCats: force, collect_ob, collect_hom, FinFunctor
 import ..Limits: limit, colimit, universal
 import ..FinSets: FinDomFunction
 # Data types
@@ -309,4 +309,32 @@ isnothing(dom_shape) ? DiagramHom{op}([Pair(j, f)], d, d′) :
    DiagramHom{op}(Dict(only(ob_generators(dom(diagram(d′)))) => Pair(j, f)),d,d′)
 end
 
+# Cast Catlab data structures to diagrams
+#########################################
+
+function FinDomFunctor(sp::Multispan{T, F}) where {T,F}
+  J, s = Presentation(FreeSchema), collect(sp)
+  obs = Ob.(Ref(FreeSchema), [:apex; [Symbol("foot$i") for i in 1:length(s)]])
+  omap = Dict(add_generator!(J, first(obs)) => apex(sp))
+  hmap = Dict(map(enumerate(obs[2:end])) do (i, o)
+    add_generator!(J, o)
+    omap[o] = codom(s[i])
+    add_generator!(J, Hom(Symbol("leg$i"),first(obs), o)) => s[i]
+  end)
+  FinDomFunctor(omap, hmap, FinCat(J), TypeCat{T, F}()) 
+end
+
+function FinDomFunctor(sp::Multicospan{T, F}) where {T,F}
+  J, s = Presentation(FreeSchema), collect(sp)
+  obs = Ob.(Ref(FreeSchema), [:apex; [Symbol("foot$i") for i in 1:length(s)]])
+  omap = Dict(add_generator!(J, first(obs)) => apex(sp))
+  hmap = Dict(map(enumerate(obs[2:end])) do (i, o)
+    add_generator!(J, o)
+    omap[o] = dom(s[i])
+    add_generator!(J, Hom(Symbol("leg$i"), o, first(obs))) => s[i]
+  end)
+  FinDomFunctor(omap, hmap, FinCat(J), TypeCat{T, F}())
+end
+
+
 end

src/categorical_algebra/HomSearch.jl

@@ -981,5 +981,23 @@ end
 maximum_common_subobject(Xs::T...; abstract=true) where T <: ACSet = 
   maximum_common_subobject(collect(Xs); abstract)
 
+# Isomorphism between morphisms and diagrams
+############################################
+
+function is_isomorphic(X::ACSetTransformation, Y::ACSetTransformation; alg=BacktrackingSearch())
+  cX, cY = CSets.ACSetFunctor.(CSets.uncurry.(FinSets.FinDomFunctor.([X,Y])))
+  is_isomorphic(cX, cY; alg)
+end
+
+function is_isomorphic(X::Multispan, Y::Multispan; alg=BacktrackingSearch())
+  cX, cY = CSets.ACSetFunctor.(CSets.uncurry.(FinSets.FinDomFunctor.([X,Y])))
+  is_isomorphic(cX, cY; alg)
+end
+
+function is_isomorphic(X::Multicospan, Y::Multicospan; alg=BacktrackingSearch())
+  cX, cY = CSets.ACSetFunctor.(CSets.uncurry.(FinSets.FinDomFunctor.([X,Y])))
+  is_isomorphic(cX, cY; alg)
+end
+
 
 end # module

src/categorical_algebra/Limits.jl

@@ -13,7 +13,8 @@ export AbstractLimit, AbstractColimit, Limit, Colimit,
   BinaryCoequalizer, Coequalizer, coequalizer, proj,
   @cartesian_monoidal_instance, @cocartesian_monoidal_instance,
   ComposeProductEqualizer, ComposeCoproductCoequalizer,
-  SpecializeLimit, SpecializeColimit, ToBipartiteLimit, ToBipartiteColimit
+  SpecializeLimit, SpecializeColimit, ToBipartiteLimit, ToBipartiteColimit,
+  product_fincat
 
 using StructEquality
 using StaticArrays: StaticVector, SVector
@@ -26,6 +27,7 @@ import ...Theories: dom, codom, ob, hom,
   initial, coproduct, coproj1, coproj2, coequalizer, proj,
   delete, create, pair, copair, factorize, universal
 using ..FinCats, ..FreeDiagrams
+using ..FinCats: FinCatPresentation
 import ..FreeDiagrams: apex, legs
 
 # Data types for limits
@@ -637,5 +639,122 @@ function universal(colim::BipartiteColimit, cocone::Multicospan)
   universal(colim, cocone)
 end
 
+# Product of FinCats
+####################
+
+"""
+Product of finitely-presented categories has the cartesian product of ob
+generators as its objects. Its morphisms are generated by, for each morphism in
+the underlying categories, taking the product of that morphism with the
+identity morphism of all objects of all other categories. For example:
+
+ h                  f   g
+X->Y multiplied by A->B<-C is:
+
+                  (f,idY)  (g, idY)
+                 YA  ->  YB   <-  YC
+         (h,idA) ↑       ↑(h,idB)  ↑(h,idC)
+                 XA  ->  XB   <-  XC
+                  (f,idX)  (g, idX)
+
+For any pair (e.g. f:A->B, h:X->Y), we get a naturality square
+
+                (f,idX)
+          A × X  ---->  B × X
+            |             |
+  (id(A),h) |             | (id(B),h)
+          A × Y  --->   B × Y
+              (f,id(Y))
+
+For any triple, we get a naturality cube (six naturality squares), and so on.
+"""
+function product(Xs::AbstractVector{<:FinCatPresentation}; kw...)
+  # Get cartesian product of obs and homs
+  #--------------------------------------
+  # obs as component tuples
+  obs = collect(Iterators.product([ob_generators(x)  for x in Xs]...))[:]
+  obdict = Dict([v => k for (k, v) in enumerate(obs)]) # get index from Ob-tuple
+
+  # component tuples for the generating morphisms 
+  homs = vcat(map(enumerate(Xs)) do (i, X)
+    vcat(map(hom_generators(X)) do h
+      p = [id.(ob_generators(Y)) for (j,Y) in enumerate(Xs) if j != i]
+      map(collect.(collect(Iterators.product(p...))[:])) do hgens
+        tuple(insert!(Vector{Any}(hgens), i, h)...)
+      end
+    end...)
+  end...)
+
+  # Create new presentation with tuple-looking names
+  #-------------------------------------------------
+  p = Presentation(FreeSchema)
+  ogens = Ob.(Ref(FreeSchema), Symbol.(obs))
+  add_generator!.(Ref(p), ogens)
+
+  # Lookup mapping from tuples of morphisms to generating morphisms in product
+  # Note the only morphisms here are ones with exactly one non-id component
+  hgens = Dict{Tuple,FreeSchema.Hom}(map(homs) do hs
+    hs => add_generator!(p, Hom(Symbol(hs), map([dom, codom]) do dom_codom
+      ogens[obdict[tuple([dom_codom(X, h) for (h, X) in zip(hs, Xs)]...)]]
+    end...))
+  end)
+
+  # Also add to hom-dictionary the morphisms which have only id components.
+  for (k,v) in zip(obs, ogens)
+    hgens[tuple(id.(k)...)] = id(v)
+  end
+
+  # Naturality squares
+  #-------------------
+  # Add (possibly) multiple naturality squares for each unordered pair of FinCats
+  for i in 1:(length(Xs) - 1), j in (i+1):length(Xs)
+    # Add multiple naturality squares for each morphism in Xᵢ and morphism in Xⱼ
+    for (hᵢ, hⱼ) in Iterators.product(hom_generators.(getindex.(Ref(Xs), [i, j]))...)
+      (dᵢ, cdᵢ), (dⱼ, cdⱼ) = [id.([dom(x), codom(x)]) for x in [hᵢ, hⱼ]]
+      square_sides = [[hᵢ, dⱼ], [cdᵢ, hⱼ], [dᵢ, hⱼ], [hᵢ, cdⱼ]]
+      # One square for each combination of objects in the non-i, non-j FinCats
+      args = [id.(ob_generators(x)) for (k, x) in enumerate(Xs) if k ∉ (i,j)]
+      for hs in Vector{Any}.(collect.(Iterators.product(args...)))
+        # Assemble sides of the square
+        a₁, a₂, b₁, b₂ = map(square_sides) do (x₁, x₂)
+          hs′ = deepcopy(hs) # morphism but it's missing the i,j components 
+          insert!(hs′, i, x₁); insert!(hs′, j, x₂) # add them in, noting i < j
+          hgens[tuple(hs′...)] # morphism for this side of the nat. square
+        end
+        add_equation!(p, a₁⋅a₂, b₁⋅b₂)
+      end
+    end
+  end
+
+  # Add equations from base categories
+  #-----------------------------------
+  for (i, X) in enumerate(Xs)
+    for lr in equations(X)
+      is = [j == i ? [nothing] : id.(ob_generators(x))
+            for (j, x) in enumerate(Xs)]
+      for bkgrnd in Iterators.product(is...)
+        l_, r_ = map(lr) do t
+          comps = (t isa HomExpr{:id} || t isa HomExpr{:generator}) ? [t] : t.args
+          comps_ = map(comps) do comp
+            hgens[tuple([k==i ? comp : c for (k,c) in enumerate(bkgrnd)]...)]
+          end
+          compose(comps_)
+        end
+        add_equation!(p, l_, r_)
+      end
+    end
+  end
+
+  # Create projection maps
+  #-----------------------
+  ls = map(enumerate(Xs)) do (i, Xᵢ)
+    os, hs = map([obs, homs]) do generator_tuples
+      Dict([Symbol(o) => o[i] for o in generator_tuples])
+    end
+    FinDomFunctor(os, hs, FinCat(p), Xᵢ)
+  end
+  Limit(DiscreteDiagram(Xs), Multispan(ls))
 end
 
+
+end

test/categorical_algebra/CSets.jl

@@ -821,4 +821,37 @@ hs = [:it,:ot]
 @test sum(h->is_cartesian(h,hs),homoms) == 12
 
 
-end
+# Test isomorphism of higher structures
+#######################################
+
+s, t = homomorphisms(Graph(1), path_graph(Graph, 2))
+@test is_isomorphic(s, s)
+@test !is_isomorphic(s, t)
+
+sp = Span(s, t);
+p2 = @acset Graph begin V=2; E=1; src=2; tgt=1 end;
+sp2 = Span(s, ACSetTransformation(Graph(1), p2; V=[1]));
+@test is_isomorphic(sp, sp2)
+
+# G1 = 3-cycle, G2 = 3-cycle with extra vertex
+G1 = @acset Graph begin V=3; E=3; src=[1,2,3]; tgt=[2,3,1] end;
+G1′ = @acset Graph begin V=3; E=3; src=[3,2,1]; tgt=[2,1,3] end;
+G2 = @acset Graph begin V=4; E=3; src=[2,3,4]; tgt=[3,4,2] end;
+G2′ = @acset Graph begin V=4; E=3; src=[1,2,3]; tgt=[2,3,1] end;
+h, h′ = homomorphism.([G1,G1′],[G2,G2′])
+@test is_isomorphic(h, h′)
+
+# Test pullback up to iso
+G = @acset Graph begin V=3; E=3; src=[1,1,2]; tgt=[1,2,2] end
+f = homomorphism(path_graph(Graph, 3), G; initial=(E=[1,2],))
+g = homomorphism(path_graph(Graph, 2), G; initial=(E=[2],))
+eq = cone(pullback(f,g));
+
+bkwd_path_3 = @acset Graph begin V=3; E=2; src=[3,2]; tgt=[2,1] end
+bkwd_path_2 = @acset Graph begin V=2; E=1; src=2; tgt=1 end
+bkwd_apex = @acset Graph begin V=3; E=1; src=1; tgt=3 end
+exp_L = homomorphisms(bkwd_apex, bkwd_path_3; monic=true, initial=(E=[2],)) |> only
+exp_R = homomorphisms(bkwd_apex, bkwd_path_2; initial=(V=[2,2,1],)) |> only
+is_isomorphic(eq, Span(exp_L,exp_R))
+
+end # module

test/categorical_algebra/HomSearch.jl

@@ -323,5 +323,40 @@ rem_part!(v2, :V, 1)
 @test is_isomorphic(v1,v2)
 @test is_isomorphic(v2,v1)
 
+# Test isomorphism of higher structures
+#######################################
+using Catlab,Test
+s, t = homomorphisms(Graph(1), path_graph(Graph, 2));
+@test is_isomorphic(s, s)
+@test !is_isomorphic(s, t)
+
+sp = Span(s, t);
+p2 = @acset Graph begin V=2; E=1; src=2; tgt=1 end;
+sp2 = Span(s, ACSetTransformation(Graph(1), p2; V=[1]));
+@test is_isomorphic(sp, sp2)
+
+@test is_isomorphic(Cospan(s, t), Cospan(s, t))
+
+
+# G1 = 3-cycle, G2 = 3-cycle with extra vertex
+G1 = @acset Graph begin V=3; E=3; src=[1,2,3]; tgt=[2,3,1] end;
+G1′ = @acset Graph begin V=3; E=3; src=[3,2,1]; tgt=[2,1,3] end;
+G2 = @acset Graph begin V=4; E=3; src=[2,3,4]; tgt=[3,4,2] end;
+G2′ = @acset Graph begin V=4; E=3; src=[1,2,3]; tgt=[2,3,1] end;
+h, h′ = homomorphism.([G1,G1′],[G2,G2′])
+@test is_isomorphic(h, h′)
+
+# Test pullback up to iso
+G = @acset Graph begin V=3; E=3; src=[1,1,2]; tgt=[1,2,2] end
+f = homomorphism(path_graph(Graph, 3), G; initial=(E=[1,2],))
+g = homomorphism(path_graph(Graph, 2), G; initial=(E=[2],))
+eq = cone(pullback(f,g));
+
+bkwd_path_3 = @acset Graph begin V=3; E=2; src=[3,2]; tgt=[2,1] end
+bkwd_path_2 = @acset Graph begin V=2; E=1; src=2; tgt=1 end
+bkwd_apex = @acset Graph begin V=3; E=1; src=1; tgt=3 end
+exp_L = homomorphisms(bkwd_apex, bkwd_path_3; monic=true, initial=(E=[2],)) |> only
+exp_R = homomorphisms(bkwd_apex, bkwd_path_2; initial=(V=[2,2,1],)) |> only
+is_isomorphic(eq, Span(exp_L,exp_R))
 
 end # module

test/categorical_algebra/Limits.jl

@@ -64,4 +64,28 @@ epi, mono = epi_mono(f)
 @test is_epic(epi)
 @test is_monic(mono)
 
+# Limits of FinCats
+###################
+
+# Cube, except one dimension has an involution on one terminus
+@present X(FreeSchema) begin (X₀,X₁)::Ob; x::Hom(X₀,X₁) end
+@present Y(FreeSchema) begin (Y₀,Y₁)::Ob; y::Hom(Y₀,Y₁) end
+@present Z(FreeSchema) begin 
+  (Z₀,Z₁)::Ob; z::Hom(Z₀,Z₁); 
+  inv::Hom(Z₁,Z₁); compose(inv, inv) == inv 
+end
+
+π₁,π₂,π₃ = XYZ = product(FinCat.([X,Y,Z]))
+
+@test hom_map(π₂, Symbol("(id(X₀), id(Y₁), inv)")) == id(last(Y.generators[:Ob]))
+@test hom_map(π₃, Symbol("(id(X₀), id(Y₁), inv)")) == last(Z.generators[:Hom])
+
+# 8 vertices on a cube
+@test length(ob_generators(apex(XYZ))) == 8
+# 12 sides of cube, plus loops on the corners of the top face 
+@test length(hom_generators(apex(XYZ))) == 12+4
+# 6 faces of the cube, plus equations on the four loops
+# plus inv naturality squares with (x Y₀ -) (x Y₁ -) (X₀ y -) (X₁ y -)
+@test length(equations(presentation(apex(XYZ)))) == 6 + 4 + 4
+
 end