out <- list (
c("SD1:LUSH", "SD1:FIELD", "SD23:SWITCH", "SD32:TRUMPET", "SD44:CANCEL", "SD384:FR563FR563", "SD567:TREK") ,
c("SD12:PAINTING", "SD42:CRAYON", "SD183:WIRE", "SD340:DUST", "SD345:FOX", "SD345:HOLE", "SD315:MONEY31", "SD387:SPRING", "SD387:ROLL"),
c("SD455:TOMATO", "SD39:MATURE"))
### Create a data.table Bloc with one column with original groups and the other with the separated ids
d <- list( c("SD1:LUSH", "SD44:CANCEL", "SD384:FR563", "SD32:TRUMPET"), c("SD23:SWITCH", "SD1:LUSH", "SD567:TREK"), c("SD42:CRAYON", "SD345:FOX", "SD183:WIRE"), c("SD345:HOLE", "SD340:DUST", "SD387:ROLL"), c("SD455:TOMATO", "SD39:MATURE"), c("SD12:PAINTING", "SD315:MONEY31", "SD387:SPRING"), c("SD32:TRUMPET", "SD1:FIELD"))
d2 <- lapply(d, function(x) sapply(strsplit(x, ":"), "[", 1))
d <- lapply(d, paste0, collapse=", ")
d2 <- lapply(d2, paste0, collapse=", ")
d <- as.data.frame(as.matrix(lapply(d, paste0, collapse=", ")))
d2 <- as.data.frame(as.matrix(lapply(d2, paste0, collapse=", ")))
d <- as.data.frame(cbind(d,d2))
colnames(d) <- c("sdw", "sd")
d$sd <- as.character(d$sd)
d$sdw <- as.character(d$sdw)
require(data.table)
Bloc <- data.table( d , key = "sd" )
### Fetch all the ids along with the corresponding data in Bloc
Bloc <- Bloc[ , list( ID = unlist( strsplit( sd , "," ) ) ) , by = list(sdw, sd) ]
Bloc$ID <- gsub("^\\s+|\\s+$", "", Bloc$ID)
Bloc <- data.table( Bloc , key = "ID" )
### Loop to merge the vectors having ids intersecting between them
Bloc <- as.data.frame(Bloc)
M <- nrow(Bloc)
#create blankd data.frame
G <- data.frame(matrix(ncol=3), stringsAsFactors=FALSE)
G[,1:3] <- as.character(G[,1:3])
#G <- data.frame(sdw=character(), sd=character(), ID= character())
colnames(G) <- c("sdw", "sd", "ID")
N <- M
mch <- as.data.frame(Bloc)
#Loop to sequentially fill data.frame
for (i in 1:M) {
# test if ID already in previous groups
if(Bloc[i,"ID"] %in% G$ID == FALSE) {
# convert element to vector to check for intersect
tm <- strsplit(x=Bloc[i, "sd"], split=", ")
mch$t <- numeric(length=M)
}
for (j in 1:N){
#if intersect exists apply code as 1 mch$t column
ff <- strsplit(x=mch[j, "sd"], split=", ")[[1]]
dd <- intersect (tm[[1]], ff)
if (identical(dd, character(0))== FALSE) mch[j,"t"] = 1
}
submch <- subset(mch, t == 1 )
ID <- submch$ID
Group1 <- sort((unlist(strsplit(paste0(submch$sdw, collapse=","), ","))))
Group1 <- unique(gsub(" ","", Group1))
sdw <- rep(paste0(Group1, collapse=", "), nrow(submch))
Group2 <- sort((unlist(strsplit(paste0(submch$sd, collapse=","), ","))))
Group2 <- unique(gsub(" ","", Group2))
sd <- rep(paste0(Group2, collapse=", "), nrow(submch))
G1 <- cbind(sdw, sd, ID)
G1 <- unique(G1)
G <- rbind(G, G1)
mch$t <- NULL
}
G <- unique(G)
G2 <- data.table(G, key="ID")
G2 <- G2[, list(sdw = paste0(sort(unique(unlist(strsplit(sdw, split=", ")))), collapse=", "),
sd = paste0(sort(unique(unlist(strsplit(sd, split=", ")))), collapse=", ")) , by = "ID"]
G2 <- data.table( G2, key=c("sd", "sdw"))
G2 <- unique(G2)
### Get the output as data.table
Bloc <- G2[-1,]
Bloc$ID <- NULL
### Repeat the above loop until no more intersects are left
repeat
{
N1 <- nrow(Bloc)
Bloc <- Bloc[ , list( ID = unlist( strsplit( sd , "," ) ) ) , by = list(sdw, sd) ]
Bloc$ID <- gsub("^\\s+|\\s+$", "", Bloc$ID)
Bloc <- data.table( Bloc , key = "ID" )
Bloc <- as.data.frame(Bloc)
M <- nrow(Bloc)
#create blankd data.frame
G <- data.frame(matrix(ncol=3), stringsAsFactors=FALSE)
G[,1:3] <- as.character(G[,1:3])
#G <- data.frame(sdw=character(), sd=character(), ID= character())
colnames(G) <- c("sdw", "sd", "ID")
N <- M
mch <- as.data.frame(Bloc)
#Loop to sequentially fill data.frame
for (i in 1:M) {
# test if ID already in previous groups
if(Bloc[i,"ID"] %in% G$ID == FALSE) {
# convert element to vector to check for intersect
tm <- strsplit(x=Bloc[i, "sd"], split=", ")
mch$t <- numeric(length=M)
}
for (j in 1:N){
#check if intersect exists and code accordingly
ff <- strsplit(x=mch[j, "sd"], split=", ")[[1]]
dd <- intersect (tm[[1]], ff)
if (identical(dd, character(0))== FALSE) mch[j,"t"] = 1
}
submch <- subset(mch, t == 1 )
ID <- submch$ID
Group1 <- sort((unlist(strsplit(paste0(submch$sdw, collapse=","), ","))))
Group1 <- unique(gsub(" ","", Group1))
sdw <- rep(paste0(Group1, collapse=", "), nrow(submch))
Group2 <- sort((unlist(strsplit(paste0(submch$sd, collapse=","), ","))))
Group2 <- unique(gsub(" ","", Group2))
sd <- rep(paste0(Group2, collapse=", "), nrow(submch))
G1 <- cbind(sdw, sd, ID)
G1 <- unique(G1)
G <- rbind(G, G1)
mch$t <- NULL
}
G <- unique(G)
G2 <- data.table(G, key="ID")
G2 <- G2[, list(sdw = paste0(sort(unique(unlist(strsplit(sdw, split=", ")))), collapse=", "),
sd = paste0(sort(unique(unlist(strsplit(sd, split=", ")))), collapse=", ")) , by = "ID"]
G2 <- data.table( G2, key=c("sd", "sdw"))
G2 <- unique(G2)
Bloc <- G2[-1,]
Bloc$ID <- NULL
N2 <- nrow(Bloc)
if (N1 == N2)
break
}
### Output
Bloc$sdw
