複体の場合の数

  • n個の要素があって、そのすべてが1つ以上の単体に属するものとして、何通りの複体が存在するかを考えてみる
    • n=1のときは[\{1\}]の1通り
    • n=2のときは[\{1\},\{2\}],[\{1,2\}]の2通り
    • n=3のときは[\{1\},\{2\},\{3\}],[\{1,3\},\{2}],[\{1\},\{2,3\}],[\{1,3\},\{2,3\}],[\{1,2\},\{3\}],[\{1,2\},\{1,3\}],[\{1,2\},\{2,3\}],[\{1,2\},\{1,3\},\{2,3\}],[\{1,2,3\}]の9通り
  • n=4のときは、114通りらしい
  • n=5のときは、『とても多い』らしい
  • 何かうまい計算方法はないのだろうか?
  • ひとまず、Rでべたべたに「すべての場合」を考えて数え上げてみる
  • これを使って、n=4の場合に114ということが分かった
  • 1,2,9,114を使ってオンライン数列大辞典を検索してみたら、数列ID:A006126 "Number of hierarchical models with linear terms forced. Also number of antichain covers of a labeled n-set"のようだ。
  • 1, 2, 9, 114, 6894, 7785062, 2414627396434, 56130437209370320359966
  • 関係すること、ひとまずリンク
library(sets)

# 集合を要素とするリストを引数とし
# その複体表現(最大化単体のリスト)を返す
set2complex <- function(s){
	if(length(s)==1){
		return(s)
	}else{
		# 集合間の真部分集合関係をチェックして
		Subs<-outer(s,s,FUN="set_is_proper_subset")
		# 「含む」集合のみを取り出す
		diag(Subs)<-FALSE
		ret <- abs(sign(apply(Subs,1,sum))-1)
		return(s[which(ret==1)])

	}

}
c1 <- set2complex(list(as.set(1),as.set(c(1,3)),as.set(c(1,4)),as.set(c(2,4))))
c1
# 複体表現から、そこに含まれるすべての単体を列挙する
complex2set <- function(t){
	# 複体表現に使われている最大化単体に属する部分単体を列挙する
	# そのユニークをとる(集合で扱うとユニークがとれる)
	tmp <- lapply(t,set_power)
	if(length(tmp) == 1){
		return(tmp[[1]])
	}else{
		ret <- tmp[[1]]
		for(i in 2:length(tmp)){
			ret <- set_union(ret,tmp[[i]])
		}
		return(ret)
	}
}
s1 <- complex2set(c1)
s1
# 集合のリストについて、ペアワイズで一致を調べ
# その結果を利用してユニークをとる
set2unique <- function(s){
	if(length(s)==1){
		return(s)
	}else{
		Subs<-outer(s,s,FUN="set_is_equal")
		#diag(Subs)<-FALSE
		Subs[upper.tri(Subs)] <- FALSE
		ret <- apply(Subs,1,sum)
		return(list(s = s[which(ret==1)],id = ret))

	}

}
# n > 5 は重すぎる(ので、ほとんど役に立たないのだが…)
n <- 4
# n=1で初期設定
c.list <- list()
c.list[[1]] <- list(as.set(1L))
cnt.list <- 2
# 複体を一つずつ納めて行く
# 複体作成にあたってnの値を第1列に、
# 作成にあたって「親」とした複体のID(行番号)を第2列に格納する
sedai.oya <- matrix(c(1,0),byrow=TRUE,ncol=2)
# n=2からループ
for(i in 2:n){
	# ひとつ前の世代の複体のIDを取り出す
	pre.sedai <- which(sedai.oya[,1] == i-1)
	# 取り出した複体を一つずつ処理
	for(j in 1:length(pre.sedai)){
		tmp <- c.list[[pre.sedai[j]]]
		#print(tmp)
		# 複体に属する全単体を列挙
		tmp.set <- complex2set(tmp)
		# 全単体のすべてについて、新規ノードと関係を持たせるか
		# について総当たり
		n.elem <- length(tmp.set)
		cnt <- rep(0,n.elem)
		cnt[1] <- 1
		tmp.list <- list()
		for(k in 1:(2^n.elem-1)){
			this.set <- list()
			elem.cnt <- 1
			for(l in tmp.set){
				#print("---")
				#print(l)
				if(cnt[elem.cnt] == 0){
					this.set[[elem.cnt]] <- l
				}else{
					#print(l+i)
					this.set[[elem.cnt]] <- l + i
				}
				elem.cnt <- elem.cnt + 1
			}
			cnt[1] <- cnt[1]+1
			for(l in 1:(n.elem-1)){
				if(cnt[l] == 2){
					cnt[l] <- 0
					cnt[l+1] <- cnt[l+1] + 1
				}
			}
			#print(this.set)
			tmp.list[[k]] <- set2complex(this.set)
		}
		# できた複体には(たくさんの)重複があるのでそれを除去(ユニークをとって)
		# 登録する
		tmp.list2 <- set2unique(tmp.list)
		for(k in 1:length(tmp.list2$s)){
			c.list[[cnt.list]] <- tmp.list2$s[[k]]
			sedai.oya <- rbind(sedai.oya,c(i,pre.sedai[tmp.list2$id[j]]))
			cnt.list <- cnt.list + 1
		}
		
	}
}

# 世代ごとの複体数を数え上げる
table(sedai.oya[,1])