surveyR: surveyR: Get things done with LimeSurvey!

Documented in Apply_Carousel_5_Write_in_Questions

#' 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 Array_Question_List A data.table with the top questions and subquestions that should be transformed into the carousel format- it should also have a "left_prompt" and a "right_prompt" column to define the instructions under the buttons!
#' @param Top_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
#' @param Freetext_Questions A data.table with the "freetext" questions that are not in the group with the respective array question, and that name the things to be evaluated- should be a top as well as the subquestions
#' @export
#' @examples \dontrun{
#' Apply_Carousel_5_Write_in_Questions(Array_Question_List, Top_Question_List)
#' }
#'
Apply_Carousel_5_Write_in_Questions <- function(Array_Question_List, Top_Question_List, Freetext_Questions){

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


  # Prep the freetext questions:
  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_codes := paste0("{",freetext_names, ".shown}")]
  Freetext_Prepared[, freetext_answer_array := paste0(' "{',freetext_names,'}"',".length == 0")]
  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 = ","), "];")

  # Prepare the Top_Question_List
  # rename the Top_Question_List columns:
  Top_Question_List <- setDT(Top_Question_List)%>%
    setnames(old = c("title", "qid"), new = c("Text_Title", "Text_qid"), skip_absent = TRUE)
  # subset columns, this is all we need:
  Top_Question_List <- Top_Question_List[, .(gid,Text_Title,Text_qid, left_prompt, right_prompt)]





  # Prepare the Array_QUestion_List
  # Match the parents to the subquestions
  Parent_Questions <- copy(Array_Question_List)[parent_qid == "0", .(qid, title, question, gid)]
  Parent_Questions <- Parent_Questions[, top_question := cleanFun(question)]
  # left_prompt and right_prompt need to be in the table that gets passed to the function:
  Top_Question_List <- merge(Top_Question_List, Parent_Questions[, .(gid, top_question)], by = "gid", all.x = TRUE)
  Parent_Questions <- Parent_Questions[, -c("question", "gid")]
  setnames(Parent_Questions, old = c("qid", "title"), new = c("parent_qid", "parent_title"))
  Sub_Questions <- copy(Array_Question_List)[parent_qid != "0"]
  Prepared_Array_Questions <- merge(Parent_Questions, Sub_Questions, by = "parent_qid", all = TRUE)
  # Prepared_Array_Questions <- Prepared_Array_Questions[, question := paste0("{",parent_title, "_", title, ".shown}")]
  Prepared_Array_Questions <- merge(Prepared_Array_Questions, Freetext_Prepared[, .(question_order, freetext_codes, num_question_order)], by = "question_order", all.x = TRUE)%>%
    setorderv(cols = c("num_question_order"))
  Array_Question_List <- Prepared_Array_Questions

  Array_Question_List <- setDT(Array_Question_List)%>%
    setorderv(cols = c("parent_qid", "title"))
  # Add row ids per parent id
  Array_Question_List[, row := rowid(parent_qid)]
  Array_Question_List[, rowId := paste0("row", row)]

  # For the answer numbers
  Array_Question_List[, ':=' (
    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
  Array_Question_List[, ':=' (
    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:
    arrayansw1 = paste0("$('#",answ1,"').click(function () {",'\n',
                        " $( '#answer", sid,'X',gid,'X',parent_qid,title,'-',"1' ).prop('checked', true);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw2 = paste0("$('#",answ2,"').click(function () {",'\n',
                        " $( '#answer", sid,'X',gid,'X',parent_qid,title,'-',"2' ).prop('checked', true);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw3 = paste0("$('#",answ3,"').click(function () {",'\n',
                        " $( '#answer", sid,'X',gid,'X',parent_qid,title,'-',"3' ).prop('checked', true);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw4 = paste0("$('#",answ4,"').click(function () {",'\n',
                        " $( '#answer", sid,'X',gid,'X',parent_qid,title,'-',"4' ).prop('checked', true);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n'),
    arrayansw5 = paste0("$('#",answ5,"').click(function () {",'\n',
                        " $( '#answer", sid,'X',gid,'X',parent_qid,title,'-',"5' ).prop('checked', true);",'\n',
                        "$('#movenextbtn, #movesubmitbtn').show();",'\n',
                        "});",'\n')
  )]


  Answers_Melted <- melt.data.table(Array_Question_List[,.(qid,parent_qid,arrayansw1,arrayansw2,arrayansw3,arrayansw4,arrayansw5)],id.vars = c("qid", "parent_qid"))%>%
    setorderv(cols = c("parent_qid", "qid"))
  #-------------------------------------------------------
  # Setting up the "Employer Specifics" Driver questions:
  Top_Question_List <- Top_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')]

  Top_Question_List <- Top_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">1 = ',left_prompt,' || 5 = ',right_prompt,'</p>','\n\n',
                                                                             '<p id="textProgress">0 completed</p>','\n',
                                                                             '<label for="file">Progress:</label> <progress id="progressBar" max="100" value="0"></progress></div>','\n',
                                                                             # Last closing div
                                                                             '</div>','\n',
                                                                             '<script type="text/javascript" charset="utf-8">','\n',
                                                                             # Create an array to see if the answers are full:
                                                                             "// 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 Recommendations');",'\n',
                                                                             "});",'\n\n',
                                                                             # Do the document ready thing:
                                                                             '$(document).ready(function() {','\n'
                                                                             #JS Randomizer (not to be used here!)
                                                                             # '$(document).ready(function() {','\n',
                                                                             # 'var elements = $(".random");','\n',
                                                                             # 'var elementsInnerHtmls = [];','\n',
                                                                             # 'var numberOfElements = elements.length;','\n\n',
                                                                             # 'for( var i = 0 ; i < numberOfElements ; i++){','\n',
                                                                             # 'elementsInnerHtmls.push(elements[i].innerHTML);}','\n\n',
                                                                             # 'var checkedIndexes = [];','\n',
                                                                             # 'for( var i = 0 ; i < numberOfElements ; i++){','\n',
                                                                             # 'var randomIndex = Math.floor(Math.random()*numberOfElements) % numberOfElements;','\n',
                                                                             # 'while(checkedIndexes[randomIndex] != undefined){','\n',
                                                                             # 'randomIndex = Math.floor(Math.random()*numberOfElements) % numberOfElements;}','\n',
                                                                             # 'checkedIndexes[randomIndex] = true;','\n',
                                                                             # 'elements[i].innerHTML = elementsInnerHtmls[randomIndex];}','\n\n'
  )]


  Top_Question_List <- Top_Question_List[, EmployerSpecificsEnd := 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',
                                                                          # 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)+" completed of "+(totalItems-1);','\n',
                                                                          "});",'\n','\n',
                                                                          # 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',
                                                                          # 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(Array_Question_List, by = "parent_qid"), Top_Question_List, by = "gid", all.x = TRUE)

  Finished_Array_Question_List <- data.table(parent_qid = paste(1:length(Unique_Parent_IDs)), question = paste(1:length(Unique_Parent_IDs)))
  j <- 1
  set_question_properties_result <- list()


  for(i in Unique_Parent_IDs$Text_qid){

    # This part is only if you want to store the results in a data.table:
    # Finished_Array_Question_List[j]$parent_qid <- paste0(i)
    # Finished_Array_Question_List[j]$question <- paste(EmployerSpecificsTop, paste(Array_Question_List[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 = i
                                                   ))
    # Injects the html/javascript into the question
    get_question_properties_current["question"] <-  paste(Top_Question_List[Text_qid == i]$EmployerSpecificsTop, paste(Array_Question_List[parent_qid == paste0(Unique_Parent_IDs[Text_qid == i]$parent_qid)]$carouseldiv1, collapse = ""), Top_Question_List[Text_qid == i]$EmployerSpecificsMiddle, paste(Answers_Melted[parent_qid == paste0(Unique_Parent_IDs[Text_qid == i]$parent_qid)]$value, collapse = ""), Top_Question_List[Text_qid == i]$EmployerSpecificsEnd, sep = "\n\n", collapse = "")


    # uploads the question
    set_question_properties_result[paste0(i)] <-  call_limer(method = "set_question_properties",
                                                             params = list(iQuestionID = i,
                                                                           aQuestionData = get_question_properties_current
                                                             ))

    j <- j+1
  }

} # end Apply_Carousel Function