R/Carousel_3_Modified_Progress.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 is for yes/no/no answer type questions (3 buttons)
#'
#' This takes two data.tables- a table of array subquestions that includes the qid, gid, parent_qid, relevance (those with zero for relevance will not have a slider entry), 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. The Progress part means that this version shows the user's progress through the list of questions.
#' @param Array_Question_List A data.table with the subquestions that should be transformed into the carousel format
#' @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
#' @export
#' @examples \dontrun{
#' Apply_Carousel_3_Modified_Progress(Array_Question_List, Top_Question_List)
#' }
#'
Apply_Carousel_3_Modified_Progress <- function(Array_Question_List, Top_Question_List){

  # 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)]


  # Prepare the Array_QUestion_List
  Array_Question_List <- setDT(Array_Question_List)

  Array_Question_List <- Array_Question_List[relevance != "0"]%>%
    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")
  )]

  # 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">','\n','<div class="carouseldiv1">','<span style="font-size:200%;">',question,'</span>','</div>','\n',
                                 '<a class="btn btn-success btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ1,
                                 '" role="button" type="button">Yes</a>','\n',
                                 '<a class="btn btn-danger btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ2,
                                 '" role="button" type="button">No</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ3,
                                 '" role="button" type="button">Skip</a>','\n',
                                 '</div>','\n'),
                          # Alternative 2: for all the following cases it's "item random"
                          paste0('<div class="item random">','\n','<div class="carouseldiv1">','<span style="font-size:200%;">',question,'</span>','</div>','\n',
                                 '<a class="btn btn-success btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ1,
                                 '" role="button" type="button">Yes</a>','\n',
                                 '<a class="btn btn-danger btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ2,
                                 '" role="button" type="button">No</a>','\n',
                                 '<a class="btn btn-warning btn-lg" data-slide="next" href="#carousel-example-generic2" id="',
                                 answ3,
                                 '" role="button" type="button">Skip</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')
  )]


  Answers_Melted <- melt.data.table(Array_Question_List[,.(qid,parent_qid,arrayansw1,arrayansw2,arrayansw3)],id.vars = c("qid", "parent_qid"))%>%
    setorderv(cols = c("parent_qid", "qid"))
  #-------------------------------------------------------
  # Setting up the "Employer Specifics" Driver questions:
  EmployerSpecificsTop <- paste0('<h1 class="qtxt orange"><b>Would you recommend this employer to family or friends?</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')

  EmployerSpecificsMiddle <- paste0('\n\n\n',
                                    '<div class="item">','\n',
                                    # Here you could add information to the final card. I've left this card blank and the next load will happen as it is shown
                                    '<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"></p>','\n\n',
                                    # This is for the progress bar:
                                    '<p id="textProgress">0 completed</p>','\n',
                                    '<label for="file">Progress:</label> <progress id="progressBar" max="100" value="0"></progress>','\n',
                                    '</div>','\n',
                                    #Change the next button text:
                                    '<script type="text/javascript" charset="utf-8">','\n',
                                    "$(document).on('ready pjax:scriptcomplete',function(){",'\n',
                                    "$('#ls-button-submit').text('Submit Recommendations');",'\n',
                                    "});",'\n\n',
                                    #JS part (randomizer):
                                    '$(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'
  )

  EmployerSpecificsEnd <- paste0('\n\n',
                                 # Function to count the cards and hit the submit button when they are done:
                                 "$('#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',
                                 # Stuff to update the progress 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',
                                 '});','\n',
                                 # Function to click the "next" button
                                 "function isVisible(){",'\n',
                                 'document.getElementById("ls-button-submit").click();','\n',
                                 "}",'\n',
                                 # # Here is a currently unused function to hide the timer stuff, should you need a timer:
                                 # 'window.onload = countDown;','\n',
                                 # 'var sec = 15;','\n',
                                 # 'function countDown() {','\n',
                                 # '  if (sec <= 1) {','\n',
                                 # "    document.getElementsByClassName('timer_header')[0].style.visibility = 'hidden';",'\n',
                                 # # These are an alternatiive
                                 # "//document.getElementsByClassName('ls-timer-content ls-timer-message ls-no-js-hidden alert alert-danger')[0].style.visibility = 'hidden';",'\n',
                                 # "//  document.getElementsByClassName('ls-timer-content ls-timer-countdown ls-no-js-hidden alert alert-info')[0].style.visibility = 'hidden';",'\n',
                                 # '}','\n',
                                 # '  sec -= 1;','\n',
                                 # '  window.setTimeout(countDown, 1000);','\n',
                                 # '}','\n',
                                 '</script>','\n',
                                 '<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(EmployerSpecificsTop, paste(Array_Question_List[parent_qid == paste0(Unique_Parent_IDs[Text_qid == i]$parent_qid)]$carouseldiv1, collapse = ""), EmployerSpecificsMiddle, paste(Answers_Melted[parent_qid == paste0(Unique_Parent_IDs[Text_qid == i]$parent_qid)]$value, collapse = ""), 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