# R/intersectExp.R In nenaoana/SetMethods: Functions for Set-Theoretic Multi-Method Research and Advanced QCA

#### Documented in intersectExp

```intersectExp <- function (expression1, expression2)
{
tl <- gsub('\\s', '', expression1)
tl <- unlist(strsplit(tl, '\\+'))
el <- gsub('\\s', '', expression2)
el <- unlist(strsplit(el, '\\+'))
comb <- c()
for (i in 1:length(tl)){
for (j in 1:length(el)){
comb <- c(comb, paste(tl[i], el[j], sep = "*"))
}
}

combl <- strsplit(comb, '\\*')

for (k in 1:length(combl))
{
combuni <- unique(unlist(combl[k]))
t_neg<-character(0)
t_pre<-character(0)
if(length(grep("~",combuni)) > 0){
t_neg<-combuni[grep("~",combuni)]
t_neg<-gsub('\\~', '', t_neg)
t_neg<-unlist(t_neg)
t_pre<-combuni[!combuni %in% combuni[grep("~",combuni)]]
if (!all(is.na(match(t_pre,t_neg)))) {combl[k] <- NA}
else {combl[k] <- paste(combuni, collapse = '*')}
}
else {combl[k] <- paste(combuni, collapse = '*')}
}
combf <- (unique(unlist(combl)))
combf <- combf[!is.na(combf)]
combfl <- strsplit(combf, '\\*')

for (l in 1:length(combfl)) {
for (m in 1:length(combfl)) {
if (all(combfl[[l]] %in% combfl[[m]])) { # here wrong, need to check if vector is subset of another vector
if (length(unlist(combfl[[l]])) >= length(unlist(combfl[[m]])))
{combfl[[l]] <- combfl[[m]]}
else {combfl[[m]] <- combfl[[l]]}
}
}}

combff <- unique(combfl)

for (i in 1: length(combff)){
for (j in 1: length(combff)){
if (length(setdiff(combff[[i]], combff[[j]])) == 1 &
length(setdiff(combff[[j]], combff[[i]])) == 1)
{
if (gsub('\\~', '', setdiff(combff[[i]], combff[[j]]))
== gsub('\\~', '', setdiff(combff[[j]], combff[[i]])))
{
if (length(grep("~", setdiff(combff[[i]], combff[[j]])))==1) {
combff[[j]] <- combff[[j]][!combff[[j]] %in% c(gsub('\\~', '', setdiff(combff[[i]], combff[[j]])),
gsub('\\~', '', setdiff(combff[[j]], combff[[i]])))]
combff[[i]] <- combff[[j]]
}
else{
combff[[i]] <- combff[[i]][!combff[[i]] %in% c(gsub('\\~', '', setdiff(combff[[i]], combff[[j]])),
gsub('\\~', '', setdiff(combff[[j]], combff[[i]])))]
combff[[j]] <- combff[[i]]
}
}
}
}
}

combff <- unique(combff)
combff <- sapply(combff, function(x) paste(x, collapse = "*"))
combff <- paste(combff, collapse = " + ")
return(combff)
}
```
nenaoana/SetMethods documentation built on Dec. 1, 2018, 5:08 p.m.