#' Filter data for a specific session.
#'
#' This function is used to filter whitelist entries (users), session events
#' and slide transsionts for a specific ASQ session.
#' @param session the session to filter for
#' @param whitelistentries a data.frame with all the whitelistentries
#' @param sessionevents a data.frame with the all the sessionevents
#' @param slide_transitions a data.frame with the all the slide transitions
#' @return A \code{list} that contains the \code{sessionevents}, \code{slide_transitions},
#' \code{slide_transitions_with_ex} (slide transitions with exercises),
#' \code{slide_transitions_without_ex} (slide transitions without exercises) and the \code{users}
#' for the specified session
#' @export
#' @examples
#' session <- data.frame(id = c("s1"))
#' session[,1] <- factor(session[,1], levels=c("s1", "s2"))
#'
#' whitelistentries = data.frame(
#' id = c("wl1", "wl2", "wl3", "wl4", "wl5"),
#' session = c("s1", "s2", "s1", "s1", "s2"),
#' screenName = c("Fernscar Pirate", "Glazebard Dolphin", "Deepmouse Wolverine", "Planetpegasus Eater", "Crazyfalcon Runner"),
#' role = c("presenter", "presenter", "viewer", "viewer", "viewer")
#' )
#'
#' sessionevents = data.frame(
#' session = c("s1", "s1", "s2"),
#' type = c("type1", "type2", "type1")
#' )
#'
#' slidetransitions = data.frame(
#' session = c("s1", "s1", "s1", "s2", "s2"),
#' slide = c("slide1", "slide2", "slide3", "slide1", "slide2"),
#' hasExercise = c(TRUE, FALSE, TRUE, TRUE, FALSE)
#' )
#'
#' filter_data_for_session(session, whitelistentries, sessionevents, slidetransitions)
filter_data_for_session <- function(session, whitelistentries, sessionevents, slide_transitions){
# get only the sessionevents for the specific session
sid <- session$id
sessionevents_one_session <- sessionevents %>% filter(session==sid)
slide_transitions <- slide_transitions %>% filter(session==sid) %>% collect()
slide_transitions_with_ex <- slide_transitions[which(slide_transitions$hasExercise == TRUE),]
slide_transitions_without_ex <- slide_transitions[which(slide_transitions$hasExercise == FALSE),]
# get users of session
users <- whitelistentries %>% filter(session==sid, role=="viewer") %>% collect()
list("sessionevents" = sessionevents_one_session,
"slide_transitions" = slide_transitions,
"slide_transitions_with_ex" = slide_transitions_with_ex,
"slide_transitions_without_ex" = slide_transitions_without_ex,
"users" = users)
}
#' Get a vector with the oids of the questions from the
#' JSON stringified `questions` field of a slideshow
#' document
#'
#' @param questions A JSON stringified string of the array of questions of a slideshow
#' @return A vector of question oids
#' @export
extract_questions_from_slideshow_questions_field <- function (questions){
slide = ''
questions = fromJSON(questions)
questions$`$oid`
}
#' Get the slide that contains a question with a specific id
#'
#' Goes through the associated slideshow and retrieves the name (HTML id)
#' of the slide that contains the question with the specified id.
#' @param slideshow slideshow that contains the question
#' @param qid the question id
#' @return the name of the slide
#' @export
find_slide_which_contains_question <- function(slideshow, qid){
qps <- NA
slide <- NA
qps <- fromJSON(slideshow$questionsPerSlide[1])
yapply(qps, function(l){
if(qid %in% l){
slide <<- NAMES
}
})
slide
}
#' Gets `n` non exercise slide transitions before the `question.slide`
#' plus the question.slide transition
#'
#' It searches for the longest slide transition for `question.slide` and then
#' it tries to find `n` consecutive slide transitions that don't contain
#' an exercise. It will return all the non-exercise slide transitions it
#' could find (up to `n`) plus the question.slide transition.
#' @param slide.transitions a data.frame with the available slide.transitions that contain `question.slide`
#' @param session the session where the `question.slide` belongs
#' @param question.slide the name of the slide that contains the question of interest
#' @param n the number of consecutive non-exercise slides to search for
#' @return a data.frame with the n+1 slide transitions
#' @export
get_n_non_exercise_slides_before_question <- function(
slide.transitions, session, question.slide, n = 3){
# first we find the slide that contains are question
# and has the greatest duration
longest.transition <- slide.transitions %>%
filter(session == session$id,
slide == question.slide) %>%
mutate(dur = (time_end - time_start)) %>%
filter(dur == max(dur)) %>%
select(-dur)
# then we find the last slide that had a question before our question
last.slide.with.ex <- slide.transitions %>%
filter(session == session$id,
hasExercise == TRUE,
time_start < longest.transition$time_start,
time_end < longest.transition$time_start) %>%
arrange(time_end) %>%
filter(time_end == max(time_end))
# if we don't have a previous slide with exercise we can go up to the start of the session
time.end.of.last.slide.with.exercise <- ifelse(nrow(last.slide.with.ex)==1, last.slide.with.ex$time_end, session$startDate )
# get n slides without exercises before our slide together with our slide
n.plus.one.slide.transitions <- slide.transitions %>%
filter(session == session$id,
hasExercise == FALSE,
time_start > time.end.of.last.slide.with.exercise,
time_end <= longest.transition$time_start) %>%
arrange(time_end) %>%
top_n(n, time_end) %>%
bind_rows(longest.transition)
n.plus.one.slide.transitions
}
check_na_null_0length <- function(val){
# get name of val when it was passed as an arg
var_name <- deparse(substitute(val))
if(anyNA(val)) stop("argument ", var_name, " is NA")
if(is.null(val)) stop("argument ", var_name, " is NULL")
if(length(val)==0) stop("argument ", var_name, " has 0 length")
}
yapply <- function(X,FUN, ...) {
index <- seq(length.out=length(X))
namesX <- names(X)
if(is.null(namesX))
namesX <- rep(NA,length(X))
FUN <- match.fun(FUN)
fnames <- names(formals(FUN))
if( ! "INDEX" %in% fnames ){
formals(FUN) <- append( formals(FUN), alist(INDEX=) )
}
if( ! "NAMES" %in% fnames ){
formals(FUN) <- append( formals(FUN), alist(NAMES=) )
}
mapply(FUN,X,INDEX=index, NAMES=namesX,MoreArgs=list(...))
}
#' Get the questions for a specific session id
#'
#' Goes through the associated slideshow, finds the questions ids and retrieves
#' the questions
#' @param session The session for which to get questions
#' @param slideshows slideshows to search for the matching slideshow
#' @param questions questions to search
#' @return A data.frame with the found questions
#' @export
get_questions_for_session <- function(session, slideshows, questions){
# find slideshow at the same time
sl <- slideshows %>%
filter(id == session$slides[1])
# create data.frame with questions
sq.df <- data.frame(slideshow=character(),
question=character())
sl %>%
rowwise() %>%
do({
question <- extract_questions_from_slideshow_questions_field(.$questions)
if(is.character(question)){
slideshow <- rep(.$id, length(question))
sq.df <<- sq.df %>% bind_rows(data.frame(slideshow, question)) %>% collect()
}
}) %>%
ungroup()
# add slide name
qins.df <- sq.df %>%
inner_join(questions, by=c("question" ="id") ) %>%
rowwise() %>%
mutate(slide = find_slide_which_contains_question(sl, question)) %>%
ungroup()
qins.df
}
#' Get the questions for a specific session id
#'
#' Goes through the associated slideshow, finds the questions ids and retrieves
#' the questions
#' @param questions questions to add startDate to
#' @param session The session to use to scan for \code{question-activated} events
#' @param sessionevents events that contain the \code{question-activated} events
#' @return A \code{data.frame} with the session and question id and the \code{startDate} field
#' @export
add_startdate_to_questions_for_session <- function(questions, session, sessionevents){
# find all events for question activated and add a question field
# with the id of the question
sid <- session$id
start_times <-sessionevents %>%
filter(session == sid, type == 'question-activated') %>%
select(id, session, data, time) %>%
rowwise() %>%
mutate(question= fromJSON(data)$question$`$oid`) %>%
ungroup() %>%
# pick only the first activation event for each question
group_by(question) %>%
slice(which.min(time)) %>%
# filter(time == min(time))%>% this allows ties of min values
left_join(questions, by='question') %>%
select(session, question, startDate = time)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.