r - 如何在 R 中生成 fsqca 分析的解表？

Question

我使用 R 中的 QCA 包进行了 fsqca 分析。我有简约、中间解决方案和真值表。我想生成一个解决方案表，如下所示：

信用：https ://www.researchgate.net/figure/Complex-solutions-of-the-FsQCA-method_tbl5_285573445

更多示例：谷歌图片搜索

你会怎么做？

这是一个代码示例：

 # Test of conditions and their negations
  QCAfit(fuzzy_data[,2:8], fuzzy_data$AdoptionFuz, necessity = TRUE, names(fuzzy_data[, 2:8]))

  ## sufficiency analysis
  #Creation of the truth table
  TT <- truthTable(fuzzy_data, outcome = "AdoptionFuz",
                   conditions = c("Benefit_EfficiencyFuz", "Benefit_MKGFuz", "Benefit_MarketFuz", 
                                  "Barrier_TechnicsFuz", "Barrier_ConstraintOfferFuz", "Barrier_SuppliersFuz"),
                   incl.cut = 0.9,
                   n.cut = 3,
                   show.cases = TRUE,
                   complete = FALSE,
                   sort.by = c("incl", "n"))

  
  # parsimonious solution
  sol_ps <- minimize(TT, details = TRUE, include ="?")

  
  #intermediary solution
  sol_is <- minimize(TT, details = TRUE, show.cases = TRUE, include = "?", 
                     dir.exp = c("1", "-", "1", "0", "0", "-"))

标签： r

Answer 1

应用此方法： Ragin、CC & Fiss、Peer。（2008 年）。净效应分析与配置分析：实证论证。重新设计社会调查：模糊集及其他。190-212。

"get_parsimonious_solutions" <- function(solution)
{
  sols <- character()
  for (solution in solution$solution)
    for (item in solution)
      sols <- append(sols, item)
    
    unique(sols)
}

"get_all_intermediary_solutions" <- function(intermediate_qca)
{
  sols <- character()
  for (solution in intermediate_qca$i.sol)
    for (item in solution$solution)
      sols <- append(sols, item)
    
    unique(sols)
}

"get_core_conditions" <-
  function(complete_solution, current_solution)
  {
    # RaginFiss2008
    
    core_conditions <- character()
    # get all possible core solutions
    core_solutions <- get_parsimonious_solutions(complete_solution)
    
    # the current solution is a complete solution, get the conditions
    complete_conditions <- get_conditions(current_solution)
    
    # for each core solutions
    for (core_solution in core_solutions)
    {
      # get core conditions
      core_conditions <- get_conditions(core_solution)
      
      # for each condition
      count <- 0
      for (core_condition in core_conditions)
      {
        # count found in complete condition
        if (core_condition %in% complete_conditions)
        {
          count <- count + 1
        }
      }
      
      # if all conditions found, return those core conditions
      if (count == length(core_conditions))
      {
        return(core_conditions)
      }
    }
    
    # if no core solution found it's a problem!
    errorCondition("No core solution found matching this solution")
  }

"get_conditions" <- function(solution)
{
  # RaginFiss2008
  
  unlist(strsplit(solution, "*", fixed = TRUE))
}

"is_negative_condition" <- function(condition)
{
  startsWith(condition, "~")
}

"get_absolute_condition" <- function(condition)
{
  if (is_negative_condition(condition))
  {
    substring(condition, 2)
  }
}

"make_solution_table" <- function(intermediate_qca)
{
  # RaginFiss2008
  
  # for all complete solutions
  complete_solutions <-
    get_all_intermediary_solutions(intermediate_qca)
  
  # prepare result df: rows are solutions
  header <- intermediate_qca[["tt"]][["options"]][["conditions"]]
  header <-
    append(header, c("Raw coverage", "Unique coverage", "Consistency"))
  solution_table <-
    as.data.frame(matrix(
      ,
      ncol = length(header),
      nrow = length(complete_solutions)
    ))
  names(solution_table) <- header
  row.names(solution_table) <- complete_solutions
  
  # process each complete solution item (can be more than 1)
  for (complete_solution_item in intermediate_qca$i.sol)
  {
    # for each item, process all the solutions
    for (i in 1:length(complete_solution_item$solution[[1]]))
    {
      solution <- complete_solution_item$solution[[1]][i]
      
      # find corresponding parsimonious core solution and its conditions
      core_conditions <-
        get_core_conditions(intermediate_qca, solution)
      
      # for all conditions
      for (condition in get_conditions(solution))
      {
        #print(condition)
        #print(is_negative_condition(condition))
        #print(condition %in% core_conditions)
        # X if neg core
        if ((is_negative_condition(condition)) &&
            (condition %in% core_conditions))
        {
          solution_table[solution, get_absolute_condition(condition)] <- "X"
        }
        # x if neg peripheral
        else if (is_negative_condition(condition))
        {
          solution_table[solution, get_absolute_condition(condition)] <- "x"
        }
        # O if core
        else if (condition %in% core_conditions)
        {
          solution_table[solution, condition] <- "O"
        }
        # o if peripheral
        else
        {
          solution_table[solution, condition] <- "o"
        }
        # (stays empty otherwise)
      }
      
      # add measures
      solution_table[solution, "Raw coverage"] <-
        complete_solution_item[["IC"]][["incl.cov"]][["covS"]][i]
      solution_table[solution, "Unique coverage"] <-
        complete_solution_item[["IC"]][["incl.cov"]][["covU"]][i]
      solution_table[solution, "Consistency"] <-
        complete_solution_item[["IC"]][["incl.cov"]][["inclS"]][i]
    }
  }
  
  # clean solution table, replace NA by empty strings
  solution_table[is.na(solution_table)] <- ""
  
  solution_table
}