###############################
## Data Loader for VisualOPIE.
###############################
# TODO: Split off visualisations from data loading.
source("global.R")
source("utility.R")
source('widgets/shiny-directory-input/directoryInput.R')
source("dashboard.R")
########################################
## Main Data Loader for desktop package
########################################
dataLoader <- function(input, output, session) {
#' Server function to handle operations instigated by the load button
#'
#' @param input - Shiny inputs.
#' @param output - Shiny outputs.
#' @param session - Shiny session.
# Run folder selection
folderSelect(input, output, session)
# Parse and visualise when load button hit.
observeEvent(input$loadButton, {
# print("*** START ***")
# main_start <- Sys.time()
# Check if loading from OPIE -> append OPIE's log path.
if(input$loadOpts == 2) {
if(Sys.info()['sysname'] == "Windows") {
logPath <<- paste(logPath, OPIE_DEFAULT_LOGS_WIN, sep = "")
} else {
logPath <<- paste(logPath, OPIE_DEFAULT_LOGS, sep = "")
}
}
# Get a list of all folders, including root path selected by user (or OPIE's log folder)
folderList <- c()
if(!is.null(logPath)) {
folderList <- list.dirs(path = logPath, full.names = TRUE, recursive = FALSE)
folderList <- grep(folderList, pattern = "/Unity|/ExternalAssets", inv = TRUE, value = TRUE)
folderList <- c(folderList, logPath)
}
# Initialise tables.
# Emtpy list of faciliator logs as data tables
facilRawTbls <- list(NULL, NULL)
# Vector of paths to logs from robot separated into types
logsFromRobot <- c()
# Table of memory game data
memoryGameTbl <<- NULL
# Table for main logs
mainLogsTbl <<- NULL
# Get logs for parsing.
# Individual facilitator logs as data tables in a list
logsFromFacilitator <- facilLogs(input, output, session, folderList)
# Vector of paths to all robot logs by type
logsFromRobot <- robotLogs(folderList)
if(length(logsFromFacilitator) == 0) {
showUINotification("No facilitator logs found.", msgType = "error")
} else {
# bind individual tables together, with session marker.
facilRawTbls <- facilTable(logsFromFacilitator)
}
if(length(logsFromRobot$memory) == 0) {
showUINotification("No robot logs found.", msgType = "error")
} else {
# form robot log data tables
memoryGameTbl <<- memoryLogs(logsFromRobot)
mainLogsTbl <<- mainTable(logsFromRobot)
}
# Basic log statistics
numLogs <- length(logsFromFacilitator) + sum(lengths(logsFromRobot)) - length(logsFromRobot$rejected)
infoDialogue(input, output, session, numLogs)
# Number of Profiles
if(!is.null(memoryGameTbl)) {
userCount <- nrow(mainLogsTbl %>% group_by(name) %>% summarise(n_distinct(name)))
numUsersDialogue(input, output, session, userCount)
langCount <- nrow(memoryGameTbl %>% group_by(language) %>% summarise(n_distinct(name)))
numLangDialogue(input, output, session, langCount)
}
# Update Activity Count + Plot the associated pie chart
callModule(activity_stats_update, "activity", data = logsFromRobot)
# Start all visualisations (see function in this script - 'dataLoader.R')
vizData = list(facilRawTbls[[1]], facilRawTbls[[2]], memoryGameTbl, mainLogsTbl)
start_visualisation(vizData)
# main_end <- Sys.time()
# print(paste0("TOTAL TIME:", main_end - main_start))
# print("*** END ***")
}
)
}
folderSelect <- function(input, output, session) {
#' Select a device or folder and store selected path to logPath global.
#' Assumes default is 'home'.
#'
#' @param input - Shiny inputs.
#' @param output - Shiny outputs.
#' @param session - Shiny session.
observeEvent(
ignoreNULL = TRUE,
eventExpr = {
input$directory
},
handlerExpr = {
if (input$directory > 0) {
# condition prevents handler execution on initial app launch
# launch the directory selection dialog with initial path read from the widget
path = choose.dir(default = readDirectoryInput(session, 'directory'))
# update the widget value
updateDirectoryInput(session, 'directory', value = tail(path, n = 1))
logPath <<- tail(path, n = 1)
}
}
)
}
##############################
## Log Retrieval from folders
##############################
facilLogs <- function(input, output, session, folderList) {
#' Get all log filenames with full path, excluding audio files.
#' Searches all folders including the selected root folder.
#'
#' @param input - Shiny inputs
#' @param output - Shiny outputs
#' @param session - Current Shiny session
#' @param folderList - List of folders to look through
# Search folders for facilitator logs and get log names
logNames <- NULL
folderLogs <- NULL
for(i in 1:length(folderList)) {
# Facilitator logs are .txt files (other logs don't have a file ext)
tempLogNames <- grep(list.files(path = folderList[i], full.names = FALSE), pattern = "*.txt", value = T)
tempLogs <- grep(list.files(path = folderList[i], full.names = TRUE), pattern = "*.txt", value = T)
# We don't want the main profile log, nor app Config.
tempLogNames <- grep(tempLogNames, pattern = "_main|Config", value = T, inv = T)
tempLogs <- grep(tempLogs, pattern = "_main|Config", value = T, inv = T)
# Compile names
tempLogNames <- sub("_log.*", "", tempLogNames)
logNames <- c(logNames, tempLogNames)
# Compile logs
folderLogs <- c(folderLogs, tempLogs)
}
# Remove duplicates
allLogs <- c()
if(length(logNames) > 0) {
duplicates = duplicated(logNames)
for(i in 1:length(folderLogs)) {
if(duplicates[i] == FALSE) {
allLogs <- c(allLogs, folderLogs[i])
}
}
} else {
allLogs <- folderLogs
}
# Names of log files for session marker
logNames <- unique(logNames)
# Combine logs into one data table, logs == list(data, data, ...), data == data.table
logs <- lapply(allLogs, fread, sep = "\t")
# Account for time per log and append
if(length(logs) > 0) {
logs <- time_continuity(logs)
for(id in 1:length(logs)) {
logs[[id]] <- logs[[id]] %>%
mutate(session = logNames[id]) %>%
mutate(duration=c(diff(time),0)) %>%
mutate(dur_min=duration/60)
}
}
return(logs)
}
robotLogs <- function(folderList) {
#' Gather robot logs and divide up by type.
#'
#' @param folderList - list of folders to search through, including selected root.
#' @return Vector of logs divided into activities.
logs <- c()
# Search folders for logs
for(i in 1:length(folderList)) {
tempLogs <- grep(list.files(path = folderList[i], full.names = TRUE), pattern = "*.wav$", value = T, inv = T)
tempLogs <- grep(tempLogs, pattern = "_log", value = T)
logs <- c(logs, tempLogs)
}
# Game log data setup
mylist.names <- c("memory", "repetition", "story", "main", "rejected")
gamelogs <- vector("list", length(mylist.names))
names(gamelogs) <- mylist.names
# Compile valid log paths into gamelogs
if(length(logs) > 0) {
for(id in 1:length(logs)) {
txt <- tolower(read_file(logs[[id]]))
if(grepl("activity : memory game", txt, fixed = TRUE)) {
gamelogs$memory <- c(gamelogs$memory, logs[[id]])
} else if (grepl("activity : word repetition", txt, fixed = TRUE)) {
gamelogs$repetition <- c(gamelogs$repetition, logs[[id]])
} else if (grepl("activity : story", txt, fixed = TRUE)) {
gamelogs$story <- c(gamelogs$story, logs[[id]])
} else if (grepl("main", logs[[id]], fixed = TRUE)) {
gamelogs$main <- c(gamelogs$main, logs[[id]])
} else {
gamelogs$rejected <- c(gamelogs$rejected, logs[[id]])
}
}
}
return(gamelogs)
}
########################
## Data table builders
########################
facilTable <- function(facilitatorLogs) {
#' Create data tables for developer processing from a list of all paths to facilitator logs.
#'
#' @param facilitatorLogs - list of facilitator logs as direct paths.
# Create general raw data dump of state information from facilitator.
stateData <<- rbindlist(facilitatorLogs)
stateData[, "min_child"] <- -1
stateData[, "max_child"] <- -1
setnames(stateData, c("time","state","num_children","score","notes", "session", "duration",
"dur_min", "min_child", "max_child"))
# Parsed raw data for main plotting
reducedData <<- collapsetbl(stateData)
reducedData <<- reducedData %>%
group_by(state) %>%
mutate(dur_min = duration/60) %>%
filter(duration <= (mean(duration)+2*sd(duration)) & duration >= (mean(duration)-2*sd(duration)) & duration >= 2.0)
tables <- list(stateData, reducedData)
return(tables)
}
collapsetbl <- function(dataTable) {
#' Creates a reduced table by grouping each state's contiguous block of entries into one entry
#'
#' @param dataTable - data table containing raw data from multiple logs concatenated together
#' @return a reduced data table with contiguous state-wise data collapsed into a single entry
X <- rle(dataTable$state)
Y <- cumsum(c(1, X$lengths[-length(X$lengths)]))
reduced <- dataTable[Y]
for(id in 1:length(Y)) {
tempDurations <- dataTable$duration[Y[id]:(Y[id] + (X$lengths[id] - 1))]
tempChildren <- dataTable$num_children[Y[id]:(Y[id] + (X$lengths[id] - 1))]
reduced[id] <- reduced[id] %>%
mutate(duration = sum(tempDurations), max_child = max(tempChildren), min_child = min(tempChildren))
}
return(reduced)
}
memoryLogs <- function (logs) {
#' Builds the data table consisting of all memory game logs with valid data entries.
#' Logs without a level played are excluded.
#'
#' @param logs - vector of paths to each memory game log file.
#' @return data table of memory game information.
memlist.names <- c("name", "language", "level", "correct", "incorrect", "session")
memlog <- vector("list", length(memlist.names))
names(memlog) <- memlist.names
for(id in 1:length(logs$memory)) {
txt <- tolower(readLines(logs$memory[id]))
len <- length(search_phrase("level", txt))
if(len > 0) {
memlog$level <- c(memlog$level, search_phrase("level", txt))
memlog$correct <- c(memlog$correct, search_phrase("^correct", txt))
memlog$incorrect <- c(memlog$incorrect, search_phrase("^incorrect", txt))
memlog$name <- c(memlog$name, rep(search_phrase("name", txt), each = len))
memlog$language <- c(memlog$language, rep(search_phrase("language", txt), each = len))
memlog$session <- c(memlog$session, rep(sub("_log", "", basename(logs$memory[id])), each=len))
}
}
memTbl <- data.table(memlog$name, memlog$language, memlog$level, memlog$correct, memlog$incorrect, memlog$session) %>%
setNames(c("name", "language", "level", "correct", "incorrect", "session"))
# Format table to remove unneeded information.
memTbl <- memTbl %>%
mutate(score = as.numeric(sub(".*scored ", "", level))) %>%
mutate(level = sub(".*level ", "", level)) %>%
mutate(level = as.numeric(sub("\ :(.*)", "", level))) %>%
mutate(name = sub(".*: ", "", name)) %>%
mutate(correct = sub(".*: ", "", correct)) %>%
mutate(incorrect = sub(".*: ", "", incorrect)) %>%
mutate(language = sub(".*: ", "", language))
# Order the logs by language
memTbl <- memTbl[order(memTbl$language, memTbl$level),]
return(memTbl)
}
mainTable <- function(logs) {
#' Builds the data table consisting of all main profile logs for each player detected.
#'
#' @param logs - vector of paths to each log to parse.
#' @return data table of information from main logs.
mainTbl <- NULL
mainList.names <- c("name", "type", "value", "times", "session")
mainlog <- vector("list", length(mainList.names))
names(mainlog) <- mainList.names
for(id in 1:length(logs$main)) {
txt <- tolower(readLines(logs$main[id]))
# Get index for headings within main logs
langid <- search_phrase("languages used:", txt, index = 1)
actid <- search_phrase("games played", txt, index = 1)
endid <- search_phrase("-----------", txt, index = 1)
# Get information within headings
langs <- txt[(langid+1):(actid-1)]
langs <- langs[langs != ""]
acts <- txt[(actid+1):(endid-1)]
acts <- acts[acts != ""]
# Parse information to be added to data table
for (lid in 1:length(langs)) {
mainlog$name <- c(mainlog$name, sub(".*: ", "", search_phrase("student", txt)))
mainlog$type <- c(mainlog$type, "language")
mainlog$value <- c(mainlog$value, sub("\t.*", "", langs[lid]))
mainlog$times <- c(mainlog$times, sub("(.*)\t", "", langs[lid]))
mainlog$session <- c(mainlog$session, sub("_log.txt", "", basename(logs$main[id])))
}
for (aid in 1:length(acts)) {
mainlog$name <- c(mainlog$name, sub(".*: ", "", search_phrase("student", txt)))
mainlog$type <- c(mainlog$type, "activity")
mainlog$value <- c(mainlog$value, sub("\t.*", "", acts[aid]))
mainlog$times <- c(mainlog$times, sub("(.*)\t", "", acts[aid]))
mainlog$session <- c(mainlog$session, sub("_log.txt", "", basename(logs$main[id])))
}
mainTbl <- data.table(mainlog$name, mainlog$type, mainlog$value, as.numeric(mainlog$times), mainlog$session) %>%
setNames(c("name", "type", "value", "times", "session"))
}
return(mainTbl)
}
##########################################
## Subsidiary statistics for logs loaded.
##########################################
infoDialogue <- function(input, output, session, numLogs) {
#' Output info box for logs
#'
#' @param input - Shiny inputs.
#' @param output - Shiny outputs.
#' @param session - Shiny session.
#' @param numLogs - the number of logs loaded.
output$logsLoadedBox <- renderInfoBox({
infoBox(
tags$b("Logs Loaded"), numLogs, icon = icon("table"), color = "green"
)
})
}
numUsersDialogue <- function(input, output, session, numUsers) {
#' Updates the general number of users information box post data loading.
#'
#' @param input - Shiny inputs.
#' @param output - Shiny outputs.
#' @param session - Shiny session.
#' @param numUsers - the number of users (numeric)
output$numUserBox <- renderInfoBox({
infoBox(
tags$b("Number of Profiles"), numUsers, icon = icon("users"), color = "green"
)
})
}
numLangDialogue <- function(input, output, session, numLangs) {
#' Updates the number of languages information box post data loading.
#'
#' @param input - Shiny inputs.
#' @param output - Shiny outputs.
#' @param session - Shiny session.
#' @param numUsers - the number of users (numeric)
output$numLanguages <- renderInfoBox({
infoBox(
tags$b("Number of Languages"), numLangs, icon = icon("users"), color = "green"
)
})
}
##################
## Visualisations
##################
start_visualisation <- function(data) {
#' Start visualisations, after data logs processed.
#' This is also where we ensure whether plots can or cannot be loaded.
#'
#' @param data - a list of data tables derived from loaded logs.
if(!is.null(data[[1]]) & !is.null(data[[2]])) {
# Raw data tables
callModule(raw_data_table, "raw", data = data[[1]])
callModule(raw_reduced_table, "raw", data = data[[2]])
# Dashboard Visualisations
callModule(dash_activity_duration_plot, "dashboard", data = data[[2]])
callModule(dash_activity_ratio_plot, "dashboard", data = data[[2]])
callModule(dash_activity_comparison, "dashboard", data = data[[2]])
callModule(dash_box_child_plot, "dashboard", data = data[[2]])
callModule(dash_child, "dashboard", data = data[[1]])
# Activity Visuliations
# Note, activity pie charts for percentage of activities as a ratio is done as count is updated at data load.
callModule(activity_tbl, "activity", data = data[[2]])
callModule(plot_activity_time, "activity", data = data[[2]])
# Success
showUINotification("Facilitator logs visualised!")
}
if(!is.null(data[[3]])) {
# Raw memory game data table
callModule(raw_memory_table, "raw", data = data[[3]])
# Language Visualisations
callModule(lang_table_viz, "language", data = data[[3]])
callModule(lang_stack_viz, "language", data = data[[3]])
callModule(lang_words_plot, "language", data = data[[3]])
callModule(plotWord, "language", data = data[[3]])
# Update stack visualiser
callModule(update_stack_bars, "language")
callModule(update_word_bar, "language")
# Activity Language Visualisations
callModule(plot_avg_words, "activity", data = data[[3]])
callModule(plot_word_level_scatter, "activity", data = data[[3]])
# User Page - update selector
# callModule(update_user_selector, "user", data = data[[3]])
# User Page - Visualisers
callModule(plot_user_language_stats, "user", data = data[[4]])
callModule(plot_user_activity_stats, "user", data = data[[4]])
# User Page Update, update the selector first (Default - have all users selected)
callModule(update_user_selector, "user", data = data[[4]])
callModule(update_user_stats, "user", data = data[[4]])
# Success
showUINotification("Robot logs visualised!")
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.