R/Carousel_5_Write_in_Questions_Array_Writer.R

In bpresentati/surveyR: surveyR: Get things done with LimeSurvey!

#' Batch apply the carousel presentation style to a list of questions belonging to various groups
#'
#' This takes two data.tables- a table of array subquestions that includes the qid, gid, parent_qid, and title, and a table that contains the empty questions (with "title", "gid", and "qid") that are within the arrays group which should receive the html injection- and applies the carousel javascript/html format to them.
#' This version is different from the "unmodified" version in that it automatically clicks the Limesurvey "Next" button when the respondent has answered all of the questions.
#' @param Huge_Free_Text_List A data.table with the top questions and subquestions that should be transformed into the carousel format
#' @param Text_Question_List A data.table with the "TEXT" questions that are in the group with the respective array question, and that should "receive" the html/javascript payload- it should also have a "left_prompt" and a "right_prompt" column to define the instructions under the buttons!
#' "gid"                                   "Text_Title"                            "Text_qid"
#' "left_prompt"                           "right_prompt"                          "separator"
#' "top_question"                          "language"                              "progress_bar_start" - what should the text be before first question answered?
#' "submit_button_text"                    "progress_text"                         "set_mandatory"  - should next button be disabled until all questions answered?
#' "progress_bar" - should there be a progress bar?
#' @param Freetext_Questions A data.table with the "freetext" questions that are not in the group with the respective array question, and that names the things to be evaluated- should be a top as well as the subquestions
#' @export
#' @examples \dontrun{
#' Apply_Carousel_5_Write_in_Questions_Array_Writer(Huge_Free_Text_List, Text_Question_List, Freetext_Questions)
#' }
#'
Apply_Carousel_5_Write_in_Questions_Array_Writer <- function(Huge_Free_Text_List, Text_Question_List, Freetext_Questions){

  cleanFun <- function(htmlString) {
    return(gsub("<.*?>", "", htmlString))
  }

  Text_Question_List <- setDT(Text_Question_List)
  if(!("progress_bar_start" %in% names(Text_Question_List))){
    Text_Question_List[, progress_bar_start := "0 completed"]
  }
  if(!("submit_button_text" %in% names(Text_Question_List))){
    Text_Question_List[, submit_button_text := "Submit Recommendations"]
  }
  if(!("progress_text" %in% names(Text_Question_List))){
    Text_Question_List[, progress_text := "completed of"]
  }
  if(!("set_mandatory" %in% names(Text_Question_List))){
    Text_Question_List[, set_mandatory := FALSE]
  }
  if(!("progress_bar" %in% names(Text_Question_List))){
    Text_Question_List[, progress_bar := FALSE]
  }
  if(!("left_prompt" %in% names(Text_Question_List))){
    Text_Question_List[, left_prompt := ""]
  }
  if(!("right_prompt" %in% names(Text_Question_List))){
    Text_Question_List[, right_prompt := ""]
  }
  if(!("separator" %in% names(Text_Question_List))){
    Text_Question_List[, separator := ""]
  }
  if(!("top_question" %in% names(Text_Question_List))){
    Text_Question_List[, top_question := "Please evaluate the following:"]
  }

  # Prepare the Text_Question_List
  # rename the Text_Question_List columns:
  Text_Question_List <- setDT(Text_Question_List)%>%
    setnames(old = c("title", "qid"), new = c("Text_Title", "Text_qid"), skip_absent = TRUE)
  # subset columns, this is all we need:
  if("language" %in% names(Text_Question_List)){
    Text_Question_List <- Text_Question_List[, .(gid,Text_Title,Text_qid, left_prompt, right_prompt, separator, top_question, language, progress_bar_start, submit_button_text, progress_text, set_mandatory, progress_bar)]
  }else{
    Text_Question_List <- Text_Question_List[, .(gid,Text_Title,Text_qid, left_prompt, right_prompt, separator, top_question, progress_bar_start, submit_button_text, progress_text, set_mandatory, progress_bar)]
  }
  Text_Question_List[, dummy := 1]

  # Prepare the Huge Free Text Questions:
  Huge_Free_Text_List <- setDT(Huge_Free_Text_List)%>%
    setnames(old = c("title", "qid", "sid"), new = c("Storage_Title", "Storage_qid", "Storage_sid"), skip_absent = TRUE)
  # subset columns, this is all we need:
  Huge_Free_Text_List <- Huge_Free_Text_List[, .(gid, Storage_Title, Storage_qid, Storage_sid)]%>%
    unique(by = "gid")

  # Prep the freetext questions:
  Freetext_Questions <- setDT(Freetext_Questions)
  Freetext_Questions <- Freetext_Questions[, .(qid, title, parent_qid, question_order)]
  Freetext_Questions <- unique(Freetext_Questions, by = "qid")
  Freetext_Top <- copy(Freetext_Questions)[parent_qid == "0", parent_title := title]
  Freetext_Subs <- copy(Freetext_Questions)[parent_qid != "0"]
  Freetext_Prepared <- merge(Freetext_Subs, Freetext_Top[, .(qid, parent_title)], by.x = "parent_qid", by.y = "qid", all.x = TRUE)
  Freetext_Prepared[, freetext_names := paste0(parent_title, "_", title)]
  Freetext_Prepared[, freetext_answerCodes := paste0(parent_title, ".", title, ".")]
  Freetext_Prepared[, freetext_codes := paste0("{",freetext_names, ".shown}")]
  Freetext_Prepared[, freetext_answer_array := paste0(' `{',freetext_names,'}`',".length == 0")]
  Freetext_Prepared[, dummy := 1]
  Freetext_Prepared[, num_question_order := as.numeric(question_order)]%>%
    setorderv(cols = c("num_question_order"))
  # This we need to inject into the javascript part
  answeredQuestionsArray <- paste0("var answeredQuestions=[", paste0(Freetext_Prepared$freetext_answer_array, collapse = ","), "];")

  if("language" %in% names(Text_Question_List)){
    # Merge with the Question list to have a basis:
    Questions <- merge(Text_Question_List, Freetext_Prepared, by = c("dummy"), all.x = TRUE, allow.cartesian = TRUE)%>%
      # Merge with the Huge Free Text
      merge(Huge_Free_Text_List, by = c("gid"), all.x = TRUE, allow.cartesian = TRUE)%>%
      setorderv(cols = c("language", "gid"))
    # Add row ids per parent id
    Questions[, row := rowid(Text_qid, language)]
    Questions[, rowId := paste0("row", row)]
  }else{
    # Merge with the Question list to have a basis:
    Questions <- merge(Text_Question_List, Freetext_Prepared, by = c("dummy"), all.x = TRUE, allow.cartesian = TRUE)%>%
      # Merge with the Huge Free Text
      merge(Huge_Free_Text_List, by = c("gid"), all.x = TRUE, allow.cartesian = TRUE)%>%
      setorderv(cols = "gid")
    # Add row ids per parent id
    Questions[, row := rowid(Text_qid)]
    Questions[, rowId := paste0("row", row)]
  }


  # For the answer numbers
  Questions[, ':=' (
    answ1 = paste0(rowId,"answ1"),
    answ2 = paste0(rowId,"answ2"),
    answ3 = paste0(rowId,"answ3"),
    answ4 = paste0(rowId,"answ4"),
    answ5 = paste0(rowId,"answ5")
  )]

  # For the carouseldiv1 type objects, and the answers to be placed in the array question
  Questions[, ':=' (
    carouseldiv1 = ifelse(row == 1,
                          # Alternative 1: for the first case the class is "item active random"
                          paste0('<div class="item active random" id="',"carousel-",row,'">','\n','<div class="carouseldiv1">','<span style="font-size:200%;">',freetext_codes,'</span>','</div>','\n',
                                 '<a class="btn btn-danger btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ1,
                                 '" role="button" type="button">1</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ2,
                                 '" role="button" type="button">2</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ3,
                                 '" role="button" type="button">3</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ4,
                                 '" role="button" type="button">4</a>','\n',
                                 '<a class="btn btn-success btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ5,
                                 '" role="button" type="button">5</a>','\n',
                                 '</div>','\n'),
                          # Alternative 2: for all the following cases it's "item random"
                          paste0('<div class="item random" id="',"carousel-",row,'">','\n','<div class="carouseldiv1">','<span style="font-size:200%;">',freetext_codes,'</span>','</div>','\n',
                                 '<a class="btn btn-danger btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ1,
                                 '" role="button" type="button">1</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ2,
                                 '" role="button" type="button">2</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ3,
                                 '" role="button" type="button">3</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ4,
                                 '" role="button" type="button">4</a>','\n',
                                 '<a class="btn btn-success btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ5,
                                 '" role="button" type="button">5</a>','\n',
                                 '</div>','\n')
    ),
    # These are for the part to dump the results into the array:
    # These are for the part to dump the results into the array:
    arrayansw1 = paste0("$('#",answ1,"').click(function () {",'\n',
                        "AnswerArray[",row-1,"] = '1-'+'", freetext_answerCodes, "';", '\n',
                        " $('#answer", Storage_sid,'X',gid,'X',Storage_qid,"').val(AnswerArray);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw2 = paste0("$('#",answ2,"').click(function () {",'\n',
                        "AnswerArray[",row-1,"] = '2-'+'", freetext_answerCodes, "';", '\n',
                        " $('#answer", Storage_sid,'X',gid,'X',Storage_qid,"').val(AnswerArray);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw3 = paste0("$('#",answ3,"').click(function () {",'\n',
                        "AnswerArray[",row-1,"] = '3-'+'", freetext_answerCodes, "';", '\n',
                        " $('#answer", Storage_sid,'X',gid,'X',Storage_qid,"').val(AnswerArray);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw4 = paste0("$('#",answ4,"').click(function () {",'\n',
                        "AnswerArray[",row-1,"] = '4-'+'", freetext_answerCodes, "';", '\n',
                        " $('#answer", Storage_sid,'X',gid,'X',Storage_qid,"').val(AnswerArray);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw5 = paste0("$('#",answ5,"').click(function () {",'\n',
                        "AnswerArray[",row-1,"] = '5-'+'", freetext_answerCodes, "';", '\n',
                        " $('#answer", Storage_sid,'X',gid,'X',Storage_qid,"').val(AnswerArray);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n')
  )]


  if("language" %in% names(Questions)){
    Answers_Melted <- melt.data.table(Questions[,.(Text_qid, title, language, arrayansw1,arrayansw2,arrayansw3,arrayansw4,arrayansw5)],id.vars = c("Text_qid", "title", "language"))%>%
      setorderv(cols = c("Text_qid", "title"))
  }else{
    Answers_Melted <- melt.data.table(Questions[,.(Text_qid, title, arrayansw1,arrayansw2,arrayansw3,arrayansw4,arrayansw5)],id.vars = c("Text_qid", "title"))%>%
      setorderv(cols = c("Text_qid", "title"))
  }
  #-------------------------------------------------------
  # Setting up the "Employer Specifics" Driver questions:
  Text_Question_List <- Text_Question_List[, EmployerSpecificsTop := paste0('<h1 class="qtxt orange"><b>',top_question,'</b></h1>','\n\n',
                                                                            '<div class="Explanation">','\n',
                                                                            '<br /></div>',
                                                                            '<div class="carousel slide" data-interval="false" data-ride="carousel" data-wrap="false" id="carousel-example-generic2"><!-- Wrapper for slides -->','\n',
                                                                            '<div class="carousel-inner" role="listbox">','\n')]

  Text_Question_List <- Text_Question_List[, EmployerSpecificsMiddle := paste0('\n\n\n',
                                                                               '<div class="item">','\n',
                                                                               '<div class="carouseldivend">','</div>','\n',
                                                                               '</div>','\n\n',
                                                                               # Within the txtmini class object you can write additional instructions. Here it is blank
                                                                               '<p class="txtmini">',left_prompt,separator,right_prompt,'</p>','\n\n')]

  Text_Question_List <- Text_Question_List[, EmployerSpecificsProgressBar_HTML := ifelse(progress_bar == TRUE, paste0('<p id="textProgress">',progress_bar_start,'</p>','\n',
                                                                                                                      '<label for="file">Progress:</label> <progress id="progressBar" max="100" value="0"></progress></div>','\n'),
                                                                                         paste0('\n'))]
  # Note: randomizer removed here! Now it's just this thing that gets rid of the empties!
  Text_Question_List <- Text_Question_List[, EmployerSpecificsRandomizer := paste0(
    # Last closing div
    '</div>','\n',
    '<script type="text/javascript" charset="utf-8">','\n',
    # Non Entry Removal Array Thing:
    "// Array with TRUE if the respective answer has no text in it",'\n\n',
    answeredQuestionsArray,'\n\n',
    'let itemId = "carousel-";','\n',
    "// For loop to remove unwanted items",'\n',
    "for (let i = 0; i < answeredQuestions.length; i++) {",'\n',
    ' newItemId = itemId.concat("", i+1);','\n',
    ' if(answeredQuestions[i]){','\n',
    ' var elem = document.getElementById(newItemId);','\n',
    ' elem.parentNode.removeChild(elem);','\n',
    "   }",'\n',
    "}",'\n\n',
    #Make the first thing active, whatever it is:
    '// Making the first of whichever items remain the active item:', '\n',
    "var $carousel = $('#carousel-example-generic2');", '\n',
    "var NextElement = $carousel.find('.item').first();", '\n',
    "NextElement.addClass('active');", '\n',
    # Change the next button text:
    "$(document).on('ready pjax:scriptcomplete',function(){",'\n',
    "$('#ls-button-submit').text('",submit_button_text,"');",'\n',
    "});",'\n\n',
    # Do the document ready thing:
    '$(document).ready(function() {','\n',
    'var AnswerArray = [];','\n'
  )]

  Text_Question_List <- Text_Question_List[, EmployerSpecificsSubmitButton_disable := ifelse(set_mandatory == TRUE, paste0('document.getElementById("ls-button-submit").disabled = true;','\n\n'), paste0('\n'))]

  Text_Question_List <- Text_Question_List[, EmployerSpecificsCarouselCounter := paste0('\n\n',
                                                                                        "$('#carousel-example-generic2').on('slide.bs.carousel', function (e) {",'\n',
                                                                                        "var active = $(e.target).find('.carousel-inner > .item.active');",'\n',
                                                                                        "var from = active.index();",'\n',
                                                                                        "var next = $(e.relatedTarget);",'\n',
                                                                                        "var to = next.index();",'\n',
                                                                                        "var totalItems = $('.item').length;",'\n',
                                                                                        "if(to+1 == totalItems){",'\n',
                                                                                        "isVisible();",'\n',
                                                                                        "}",'\n')]

  Text_Question_List <- Text_Question_List[, EmployerSpecificsProgressBar_JS := ifelse(progress_bar == TRUE, paste0(
    # Here's the stuff for the progress feedback bar:
    'document.getElementById("progressBar").setAttribute("max", totalItems);','\n',
    'document.getElementById("progressBar").setAttribute("value", to+1);','\n',
    'document.getElementById("textProgress").innerHTML = (to)+" ',progress_text,' "+(totalItems-1);','\n',
    "});",'\n','\n'),
    # Alternative (no progress bar)
    paste0("});",'\n','\n'))]

  Text_Question_List <- Text_Question_List[, EmployerSpecificsSubmit_Click := ifelse(set_mandatory == TRUE, paste0(
    # This is the document.ready end brackets:
    '});','\n',
    # This is the function to click on the submit button when the last card slides
    "function isVisible(){",'\n',
    'document.getElementById("ls-button-submit").disabled = false;','\n',
    'document.getElementById("ls-button-submit").click();','\n',
    "}",'\n',
    '</script>','\n'),
    paste0(
      # This is the document.ready end brackets:
      '});','\n',
      # This is the function to click on the submit button when the last card slides
      "function isVisible(){",'\n',
      'document.getElementById("ls-button-submit").click();','\n',
      "}",'\n',
      '</script>','\n'))]

  Text_Question_List <- Text_Question_List[, EmployerSpecificsEnd := paste0(
    # This is just for style- but the template trumps this anyway, so it won't show
    '<style type="text/css">html, body { height: 100%; }','\n',
    'body {','\n',
    'background: rgba(241,231,103,1);','\n',
    'background: -moz-linear-gradient(-45deg, rgba(241,231,103,1) 0%, rgba(252,70,104,1) 100%);','\n',
    'background: -webkit-gradient(left top, right bottom, color-stop(0%, rgba(241,231,103,1)), color-stop(100%, rgba(252,70,104,1)));','\n',
    'background: -webkit-linear-gradient(-45deg, rgba(241,231,103,1) 0%, rgba(252,70,104,1) 100%);','\n',
    'background: -o-linear-gradient(-45deg, rgba(241,231,103,1) 0%, rgba(252,70,104,1) 100%);','\n',
    'background: -ms-linear-gradient(-45deg, rgba(241,231,103,1) 0%, rgba(252,70,104,1) 100%);','\n',
    'background: linear-gradient(135deg, rgba(241,231,103,1) 0%, rgba(252,70,104,1) 100%);','\n',
    "filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#f1e767', endColorstr='#fc4668', GradientType=1 );}",'\n',
    '</style>','\n',
    '</div>','\n')]



  #-------------------------------------------------------
  # Per Parent_QID you take all of the entries, cat them, then upload them to the parent
  # Upload to LS
  options(lime_api = 'https://survey.statista-research.com/admin/remotecontrol')
  options(lime_username = Sys.getenv("Statista_LS_Username"))
  options(lime_password = Sys.getenv("Statista_LS_Password"))

  get_session_key()  # Log in

  Unique_Parent_IDs <- merge(unique(Huge_Free_Text_List, by = "Storage_qid"), Text_Question_List, by = "gid", all.x = TRUE)

  # This is to keep track of progress
  Unique_Text_Questions <- Text_Question_List
  Unique_Text_Questions[, language.update := character()]
  Unique_Text_Questions[, question.update := character()]


  for(i in 1:nrow(Unique_Text_Questions)){

    # This part is only if you want to store the results in a data.table:
    # Finished_Questions[j]$parent_qid <- paste0(i)
    # Finished_Questions[j]$question <- paste(EmployerSpecificsTop, paste(Questions[parent_qid == paste0(i)]$carouseldiv1, collapse = ""), EmployerSpecificsMiddle, paste(Answers_Melted[parent_qid == paste0(i)]$value, collapse = ""), EmployerSpecificsEnd, sep = "\n\n", collapse = "")

    # This part puts the results straight into the appropriate questions:
    get_question_properties_current <-  call_limer(method = "get_question_properties",
                                                   params = list(iQuestionID = Unique_Text_Questions[i]$Text_qid
                                                   ))
    # Injects the html/javascript into the question
    if("language" %in% names(Questions)){
      get_question_properties_current["question"] <-  paste(Unique_Text_Questions[i]$EmployerSpecificsTop,
                                                            paste0(Questions[Text_qid == Unique_Text_Questions[i]$Text_qid & language == Unique_Text_Questions[i]$language]$carouseldiv1, collapse = ""),
                                                            Unique_Text_Questions[i]$EmployerSpecificsMiddle,
                                                            Unique_Text_Questions[i]$EmployerSpecificsProgressBar_HTML,
                                                            Unique_Text_Questions[i]$EmployerSpecificsRandomizer,
                                                            paste(Answers_Melted[Text_qid == Unique_Text_Questions[i]$Text_qid & language == Unique_Text_Questions[i]$language]$value, collapse = ""),
                                                            Unique_Text_Questions[i]$EmployerSpecificsSubmitButton_disable,
                                                            Unique_Text_Questions[i]$EmployerSpecificsCarouselCounter,
                                                            Unique_Text_Questions[i]$EmployerSpecificsProgressBar_JS,
                                                            Unique_Text_Questions[i]$EmployerSpecificsSubmit_Click,
                                                            Unique_Text_Questions[i]$EmployerSpecificsEnd, sep = "\n\n", collapse = "")
    }else{
      get_question_properties_current["question"] <-  paste(Unique_Text_Questions[i]$EmployerSpecificsTop,
                                                            paste0(Questions[Text_qid == Unique_Text_Questions[i]$Text_qid]$carouseldiv1, collapse = ""),
                                                            Unique_Text_Questions[i]$EmployerSpecificsMiddle,
                                                            Unique_Text_Questions[i]$EmployerSpecificsProgressBar_HTML,
                                                            Unique_Text_Questions[i]$EmployerSpecificsRandomizer,
                                                            paste(Answers_Melted[Text_qid == Unique_Text_Questions[i]$Text_qid]$value, collapse = ""),
                                                            Unique_Text_Questions[i]$EmployerSpecificsSubmitButton_disable,
                                                            Unique_Text_Questions[i]$EmployerSpecificsCarouselCounter,
                                                            Unique_Text_Questions[i]$EmployerSpecificsProgressBar_JS,
                                                            Unique_Text_Questions[i]$EmployerSpecificsSubmit_Click,
                                                            Unique_Text_Questions[i]$EmployerSpecificsEnd, sep = "\n\n", collapse = "")
    }

    # Use the base language if there's either no language column, or if there's an NA in it
    if("language" %in% names(Text_Question_List)){
      target_language <- ifelse(!is.na(Unique_Text_Questions[i]$language), Unique_Text_Questions[i]$language, get_question_properties_current[["language"]])
    }else{
      target_language <- get_question_properties_current[["language"]]
    }

    # Just to track progress
    Unique_Text_Questions[i]$language.update <- target_language

    get_question_properties_current <- get_question_properties_current["question"]
    # uploads the question
    Unique_Text_Questions[i]$question.update <-  call_limer(method = "set_question_properties",
                                                            params = list(iQuestionID = Unique_Text_Questions[i]$Text_qid,
                                                                          aQuestionData = get_question_properties_current,
                                                                          sLanguage = target_language

                                                            ))

  }

  return(Unique_Text_Questions)

} # end Apply_Carousel Function