R/report.R

Defines functions Generate_Response_Profile

Documented in Generate_Response_Profile

#' Generate_Response_Profile: Track the variables from your survey
#'
#' This function takes a survey list (either raw or filtered) and returns a data.table that has the number of responses gathered for the questions and answer codes provided in the "Demographic_Variables_Answers" parameter.
#' Can use, for example, an excel sheet with the question codes, question texts, answer codes, and answer texts to give you a full picture of how many responses you have for each
#' @param Survey_List This is a survey list: this is a list containing the downloaded data from the survey for a multiple-part survey.
#' @param Variables_Answers table that specifies four columns: variable_to_tally- the Limesurvey code for the variable that you want to tally (count) responses for, variable_text, answer_code, answer_text. I generally read in a csv that has four columns: "variable_to_tally"- this is the limesurvey question code that we'd like to track, "variable_text"- the question text for this variable, "answer_code"- the answer codes for this question, and "answer_text"- the answer text corresponding to the answer code. This means that each variable has one row per answer code.
#' @return a table with the corresponding counts for each question/response pair (a data.table that shows how many responses for each of the demographic questions were gathered (from the completes))
#' @keywords Tracking
#' @export
#' @examples
#' Demographic_Profile_Cint <- Generate_Response_Profile(Filtered_Surveys_Cint, Demographic_Variables_Answers_ProjectX)

Generate_Response_Profile <- function(Survey_List, Variables_Answers){
  # Variables_Answers is the csv list of the variables that we want to select and count

  Unique_Demographic_Questions <- unique(Variables_Answers, by = c("variable_to_tally"))
  Unique_Demographic_Answers <- unique(Variables_Answers[, .(variable_to_tally,answer_code,answer_text)])



  Result <- list()

  for(j in 1:length(Survey_List)){

    Survey_List_Part <- Survey_List[[j]]

    if(c("complete") %in% colnames(Survey_List_Part)){
      Survey_List_Part <- Survey_List_Part[complete == 1]
    }

    cols <- colnames(Survey_List_Part)%in%Variables_Answers$variable_to_tally
    Relevant_Columns <- Survey_List_Part[, ..cols]

    if(length(Relevant_Columns)==0) next

    innerResult <- list()

    for(i in 1:length(Relevant_Columns)){

      innerResult[[i]] <- Relevant_Columns%>%
        group_by(across(i))%>%
        summarise(Counts = n(),
                  Survey_Part = j)%>%
        setDT()

    }
    # add the inner result to the total results list
    Result <- append(Result, innerResult)
  }

  # Get rid of empty lists
  Result <- Result[lengths(Result) != 0]

  # Melt each data.table in the list
  for(i in 1:length(Result)){
    Result[[i]] <- data.table::melt(Result[[i]], id.vars = c("Survey_Part", "Counts"))
  }


  Real_Result <- rbindlist(Result)

  # Get total counts
  Demographic_Profile_Grouped <- Real_Result%>%
    group_by(Survey_Part, variable)%>%
    summarise(
      Totals = sum(Counts)
    )

  # Merge total counts
  Real_Result <- merge(Real_Result, Demographic_Profile_Grouped, by = c("Survey_Part", "variable"), all.x = TRUE)
  Real_Result[, Percentages := (Counts/Totals)*100]

  # Merge Variable text
  Real_Result <- merge(Real_Result, Unique_Demographic_Questions[, .(variable_to_tally,variable_text)], by.x = "variable", by.y = "variable_to_tally", all.x = TRUE)
  # Merge answer text
  Real_Result <- merge(Real_Result, Unique_Demographic_Answers[, .(variable_to_tally,answer_code,answer_text)], by.x = c("value","variable"), by.y = c("answer_code","variable_to_tally"), all.x = TRUE)

  setnames(Real_Result, old = c("value", "variable"), new = c("answer_code", "variable_code"), skip_absent = TRUE)
  setcolorder(Real_Result, neworder = c("Survey_Part","variable_code", "variable_text", "answer_code", "answer_text", "Counts", "Totals", "Percentages"))

  setorderv(Real_Result, cols = c("Survey_Part", "variable_code", "answer_code"))

  return(Real_Result)

}
bpresentati/surveyR documentation built on March 19, 2022, 3:40 a.m.