R/qdc.R

In aiorazabala/qmethod: Analysis of Subjective Perspectives Using Q Methodology

qdc <- function(dataset, nfactors, zsc, sed) {
  zsc <- as.data.frame(zsc)
  sed <- as.data.frame(sed)
  if (sum(is.na(colSums(zsc)))>0) warning("Q analysis: Comparisons for distinguishing and consensus statements exclude the factor(s) for which there were no flags.")
  if (sum(is.na(colSums(zsc)))>0 & !is.na(sum(zsc[,nfactors]))) stop("In addition, the factor without flags is not the last one. The distinguishing and consensus analysis cannot continue. You may run the full analysis manually: cor(db), then extraction and rotation, and qzscores(), skipping qdc().")
    # Exclude the factor that has no flags
    nfactors <- nfactors-sum(is.na(colSums(zsc))>0)
    if (nfactors==1) {
    qdc.res <- "Q analysis: Only one factor selected. No distinguishing and consensus statements will be calculated."
    warning(qdc.res)
  } else {
    # Distinguishing and consensus statements
    # create data frame
    comparisons <- combn(nfactors, 2, simplify=F)
    comp <- vector()
    for (i in 1:length(comparisons)) {
      comp <- append(comp, paste("f", comparisons[[i]], collapse="_", sep=""), after = length(comp))
    }
    qdc1 <- data.frame(matrix(data=as.numeric(NA), ncol=length(comp), nrow=nrow(dataset), dimnames=list(row.names(dataset), comp)))
    # differences in zsc between factors
    for (n in 1:length(comp)) {
      first <-  colnames(zsc)[grep(paste0("f", comparisons[[n]][1], "$"), 
                                colnames(zsc))]
      second <- colnames(zsc)[grep(paste0("f", comparisons[[n]][2], "$"), 
                                colnames(zsc))]
      qdc1[n] <- zsc[,first] - zsc[,second]
    }
    qdc2 <- as.data.frame(qdc1)
    # significant differences
    for (n in 1:length(comp)) {
      # find the threshold for the pair of factors
      sed <- data.frame(sed)
      first <-  names(sed)[grep(paste0("f", comparisons[[n]][1], "$"), 
                                names(sed))]
      second <- names(sed)[grep(paste0("f", comparisons[[n]][2], "$"), 
                                names(sed))]
      sedth.000001 <- sed[first, second]*4.8916 # t-test values obtainable from qnorm(p = 0.000001) %>% round(4) (fix as per issue #362 on github)
      sedth.001 <- sed[first, second]*3.291
      sedth.01 <- sed[first, second]*2.576
      sedth.05 <- sed[first, second]*1.960 # differences are significant when > 2.58*SED for p < .01, or the same value rounded upwards (Brown, 1980, pp.245)
      qdc2[which(abs(qdc1[[n]]) <= sedth.05), n] <- ""
      qdc2[which(abs(qdc1[[n]]) >  sedth.05), n] <- "*"
      qdc2[which(abs(qdc1[[n]]) >  sedth.01), n] <- "**"
      qdc2[which(abs(qdc1[[n]]) >  sedth.001), n] <- "***"
      qdc2[which(abs(qdc1[[n]]) >  sedth.000001), n] <- "6*"
    }
    names(qdc2) <- paste0("sig_",names(qdc2))
    qdc2$dist.and.cons <- as.character(apply(qdc2, 1, function(x) sum(x!="")==0))
    qdc2[which(qdc2$dist.and.cons == T), "dist.and.cons"] <- "Consensus"
    if (nfactors == 2) {
      qdc2[which(qdc2$dist.and.cons != "Consensus"), "dist.and.cons"] <- "Distinguishing"
    }
    if (nfactors > 2) {
      qdc2[which(qdc2$dist.and.cons != "Consensus"), "dist.and.cons"] <- ""
      for (i in 1:nfactors) {
        varsin  <- names(qdc2)[grep(i, names(qdc2))]
        varsout <- names(qdc2)[-grep(i, names(qdc2))]
        varsout <- varsout[-which(varsout=="dist.and.cons")]
        for (s in 1:nrow(qdc2)) {
          if (sum(qdc2[s, varsin] != "") == length(varsin) & sum(qdc2[s, varsout] != "") == 0) qdc2[s, "dist.and.cons"] <- paste0("Distinguishes f",i, " only") else if (sum(qdc2[s, c(varsin, varsout)] != "") == length(qdc1)) qdc2[s, "dist.and.cons"] <- "Distinguishes all" else if (sum(qdc2[s, varsin] != "") == length(varsin) & sum(qdc2[s, varsout] != "") != 0 & sum(qdc2[s, c(varsin, varsout)] != "") != length(qdc1)) qdc2[s, "dist.and.cons"] <- paste0(qdc2[s, "dist.and.cons"], "Distinguishes f",i, " ", collapse="")
        }
        #The above loop assigns these values in the column dist.and.cons, according to the following rules:
        # -- "Distinguishes f* only" when the differences of f* with all other factors are significant, AND all other differences are not.
        # -- "Distinguishes all" when all differences are significant.
        # -- "Distinguishes f*" when the differences of f* and all other factors are significant, AND some (but not all) of the other differences are significant.
        # -- "" leaves empty those which do not fullfil any of the above conditions, i.e. are not consensus neither are clearly distinguishing any factor.
      }
    }
    qdc.res <- cbind(qdc1, qdc2)
    ord <- rep(1:length(qdc1), each=2)
    ord[which(1:(length(qdc1)*2) %% 2 == 0)] <- ord[which(1:(length(qdc1)*2) %% 2 == 0)] + length(qdc1)
    qdc.res <- qdc.res[c(length(qdc.res), ord)]
  }
  return(qdc.res)
}