18/08/10 15:19:15.44 Hlm8Oe3x.net
combnを使って改訂
# all permutations
ones=t(combn(10,3))
indx2ten <- function(x){
y=numeric(10)
y[x[1]]=1
y[x[2]]=1
y[x[3]]=1
return(y)
}
perm=NULL
for(i in 1:nrow(ones)) perm=rbind(perm,indx2ten(ones[i,]))
# ababab|bababa
rm_ababab <- function(v){
if(length(v)<6) return(v)
for(i in 1:5)
if(all(v[i:(i+5)]==c(0,1,0,1,0,1))|all(v[i:(i+5)]==c(1,0,1,0,1,0))){
return(v[-i:-(i+5)])
}
return(v)
}
# aa|bb
rm_aa <- function(v){ # remove 1st two aa or bb
if(length(v)<2) return(v)
n=length(v)
for(i in 1:(n-1))
if(all(v[i:(i+1)]==c(0,0))|all(v[i:(i+1)]==c(1,1))){
return(v[-i:-(i+1)])
}
return(v)
}
rm_aaR <- function(v){ # recursively remove aa or bb while checking abababa or bababa
if(length(v)==6){
if(all(v==c(1,0,1,0,1,0))|all(v==c(0,1,0,1,0,1))) return(c(0,0))
}
if(length(v)==2) return(v)
else{
v1=rm_aa(v)
Recall(v1)
}
}
res=apply(perm,1,rm_aaR)
res=t(res)
sum(res[,1]==0 & res[,2]==0)
idx=which(res[,1]==0 & res[,2]==0)
Ans=perm[idx,]
AB=Ans+1
rownames(AB)=NULL
.ab=c('a','b')
indx2char <- function(x,ab=.ab){
n=length(x)
re=NULL
for(i in 1:n) re[i]=ab[x[i]]
re
}
print(t(apply(AB,1,indx2char)),quote = FALSE)