R/Carousel_3_Modified.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.
#' @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_Modified(Array_Question_List, Top_Question_List)
#' }
#'
Apply_Carousel_3_Modified <- 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-secondary 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-secondary 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',
                                    '<div class="carouseldivend">','</div>','\n',
                                    '</div>','\n\n',
                                    '<p class="txtmini">Please evaluate at least 10</p>','\n',
                                    '</div>','\n',
                                    '<script type="text/javascript" charset="utf-8">','\n',
                                    "$(document).on('ready pjax:scriptcomplete',function(){",'\n',
                                    "$('#ls-button-submit').text('Submit Recommendations');",'\n',
                                    "});",'\n\n',
                                    '$(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',
                                 "$('#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',
                                 "});",'\n','\n',
                                 '});','\n',
                                 "function isVisible(){",'\n',
                                 'document.getElementById("ls-button-submit").click();','\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