##################################################################################
##                                                                              ##
##  Title  : QCA and robust sufficiency                                         ##
##           Auxiliary functions (to be sourced in the replication script)      ##
##  Authors: Michael Baumgartner                                                ##
##  Version: 01/02/2021                                                         ##
##                                                                              ##
##################################################################################




# Introduce random noise into a data set. 
bring_theNoise <- function(cleandata, incomp.data, no.replace, add=FALSE, bias=NULL){
  if (add){
    
    a <- cleandata
    b <- some(incomp.data, no.replace, replace = FALSE, prob=bias)
    Noisedata <- rbind(a, b)
    
  } else {
    
    a <- cleandata[sample(nrow(cleandata), nrow(cleandata)-no.replace, replace = FALSE),]
    b <- some(incomp.data, no.replace, replace = FALSE, prob=bias)
    Noisedata <- rbind(a, b)
  }
  return(Noisedata)
}


negTOlow <- function(x){
   out <- str_replace_all(x, "~[A-Z]", tolower)
   out <- str_replace_all(out , "~", "")
   out
}

lowTOneg <- function(x){
  out <- str_replace_all(x, "a", "~A")
  out <- str_replace_all(out, "b", "~B")
  out <- str_replace_all(out, "b", "~B")
  out <- str_replace_all(out, "c", "~C")
  out <- str_replace_all(out, "d", "~D")
  out <- str_replace_all(out, "e", "~E")
  out <- str_replace_all(out, "f", "~F")
  out <- str_replace_all(out, "g", "~G")
  out
}


# Checks whether the score lists of LR and CNA contain identical models
contains.id.models <- function(x,y){
  if((is.null(x)&&!is.null(y)) || (is.null(y)&&!is.null(x)) ){
  out <- FALSE
  } else if((is.null(x)&&is.null(y))){
  out <- TRUE
  names(out) <- "empty"
  } else {
  t <- expand.grid(x,y,stringsAsFactors = FALSE)
  score <- vector("list", nrow(t))
  for(i in 1:nrow(t)){
    score[[i]] <- identical.model(t[i,1], t[i,2])
    if(score[[i]]==TRUE){
      names(score[[i]]) <-t[i,2]} 
  }
  out <- unlist(score)
  }
  return(out)
}

# Checks whether the score lists of LR and CNA contain models related by the submodel relation
contains.sub.models <- function(x,y){
  if((is.null(x)&&!is.null(y)) || (is.null(y)&&!is.null(x)) ){
  out <- FALSE
  } else if((is.null(x)&&is.null(y))){
  out <- TRUE
  names(out) <- "empty"
  } else {
  t <- expand.grid(x,y,stringsAsFactors = FALSE)
  score <- vector("list", nrow(t))
  for(i in 1:nrow(t)){
    score[[i]] <- as.vector(is.submodel(t[i,1],t[i,2])||is.submodel(t[i,2],t[i,1]))
    if(score[[i]]==TRUE){
      names(score[[i]]) <-paste0(t[i,1],",",t[i,2])} 
  }
  out <- unlist(score)
  }
  return(out)
}

# Check for a disjunct in a solution whether it is an RS-condition, meaning whether it is strictly sufficient for the outcome 
# in ideal data.
rs.check <- function(dis, delta.id){
  out <-  lapply(dis, function(t) suppressMessages(t[condTbl(t,  delta.id)$consistency==1]))
  out
}


mrs.check <- function(rs, delta.id, outcome){
   aut.min <- lapply(rs, function(t) t[which(cna:::getComplexity(t)==1)])
   not.aut.min <- lapply(rs, function(t) t[which(cna:::getComplexity(t)>1)])
   x <- lapply(not.aut.min, function(t) cna:::lhs(t))  
   x <- lapply(x, function(t) str_split(t,"[*]")) 
   x <- lapply(x, function(t) lapply(t, function(r) do.call("c", lapply((seq_along(r)-1)[-which((seq_along(r)-1)==0)], function(i) combn(r, i, FUN = list)))))
   x <- lapply(x,function(t) lapply(t, function(s) lapply(s,function(r)paste(r,collapse =  "*")))  )
   x <- lapply(x,function(t) lapply(t, function(s) lapply(s,function(r)paste0(r,"->",outcome))))
   x <- lapply(x,function(t) lapply(t, function(s) unlist(s)))
   check.delta <- lapply(x, function(t) lapply(t, function(s) suppressMessages(condTbl(s,delta.id))))
   check.delta <- lapply(check.delta, function(t) lapply(t, function(s) s[which(s$consistency==1),]))
   result <- lapply(check.delta, function(t) lapply(t,function(s) nrow(s)>0))
   result <- lapply(result, function(r) unlist(r))
   out <- mapply(function(r,t) subset(r, t==FALSE) ,r=not.aut.min, t=result,SIMPLIFY = FALSE) 
   out <- mapply(function(r,t) if(length(r)>0){c(r,t)}else{t}, r=aut.min, t=out,SIMPLIFY = FALSE)
   out
}

getCond <- cna:::getCond