R/mtt
R/mtt
0
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Some cosmetic changes

Browse Source
This commit is contained in:
Nora Wickelmaier 2024-03-06 18:41:53 +01:00
parent 83fbcc0f3d
commit 1c803ba81f
3 changed files with 21 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
R/add_case.R
View File

@ -1,7 +1,4 @@
###########################################################################
# Add case variable
add_case <- function(data, cutoff = 20) {
# TODO: What is the best choice for the cutoff here?
@ -9,13 +6,6 @@ add_case <- function(data, cutoff = 20) {
dat_split <- split(data, ~ path)
time_minmax <- function(subdata) {
subdata$min_time <- min(subdata$date.start)
subdata$max_time <- ifelse(all(is.na(subdata$date.stop)), NA,
max(subdata$date.stop, na.rm = TRUE))
subdata
}
dat_list <- pbapply::pblapply(dat_split, time_minmax)
dat_minmax <- dplyr::bind_rows(dat_list)
@ -36,3 +26,14 @@ add_case <- function(data, cutoff = 20) {
data
}
###########################################################################
time_minmax <- function(subdata) {
subdata$min_time <- min(subdata$date.start)
if (all(is.na(subdata$date.stop))) {
subdata$max_time <- NA
} else {
subdata$max_time <- max(subdata$date.stop, na.rm = TRUE)
}
subdata
}

5
R/add_path.R
View File

@ -130,9 +130,6 @@ add_path <- function(data, xmlpath, glossar) {
}
###########################################################################
# Add path for moves
add_path_moves <- function(data, cutoff) {
pbapply::pboptions(style = 3, char = "=")
@ -151,7 +148,7 @@ add_path_moves <- function(data, cutoff) {
out
}
###########################################################################
add_path_subdata <- function(subdata, cutoff) {
index_flipCard <- which(subdata$event == "flipCard")
current_item <- unique(subdata$item)

29
R/create_eventlogs.R
View File

@ -81,31 +81,19 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
# Remove moves where stop is before start (3)
dat4 <- dat4[dat4$fIdDiff >= 0 | is.na(dat4$fIdDiff), ]
dat4$duration[which(dat4$fIdDiff > 0)] <-
dat4$fIdDiff[which(dat4$fIdDiff > 0)] * 600000 -
dat4$timeMs.start[which(dat4$fIdDiff > 0)] +
# Overwrite timeMs.stop with corrected values
dat4$timeMs.stop[which(dat4$fIdDiff > 0)] <-
dat4$fIdDiff[which(dat4$fIdDiff > 0)] * 600000 +
dat4$timeMs.stop[which(dat4$fIdDiff > 0)]
dat4$duration[which(dat4$fIdDiff > 0)] <-
dat4$timeMs.stop[which(dat4$fIdDiff > 0)] -
dat4$timeMs.start[which(dat4$fIdDiff > 0)]
dat4$fIdNum.start <- NULL
dat4$fIdNum.stop <- NULL
dat4$fIdDiff <- NULL
# Remove fragmented paths ###############################################
# tab <- stats::xtabs( ~ path + event, dat4)
# fragments <- NULL
# for (i in seq_len(nrow(tab))) {
# if (tab[i, "openPopup"] != 0 & tab[i, "flipCard"] == 0) {
# fragments <- c(fragments, rownames(tab)[i])
# } else if (tab[i, "openTopic"] != 0 & tab[i, "flipCard"] == 0) {
# fragments <- c(fragments, rownames(tab)[i])
# } else if (tab[i, "openPopup"] != 0 & tab[i, "openTopic"] == 0) {
# fragments <- c(fragments, rownames(tab)[i])
# }
# }
# dat5 <- dat4[!dat4$path %in% fragments, ]
# TODO: Decide if I want this or not - are all these log errors?
dat5 <- dat4
if (glossar) {
@ -128,7 +116,8 @@ create_eventlogs <- function(data, xmlpath = NULL, case_cutoff = 20,
}
dat7 <- dat7[order(dat7$fileId.start, dat7$date.start, dat7$timeMs.start), ]
if (save) save(dat, dat1, dat2, dat3, dat4, dat5, dat7, file = "results/tmp_intermediate-df.RData")
if (save) save(dat, dat1, dat2, dat3, dat4, dat5, dat7,
file = "results/tmp_intermediate-df.RData")
dat7
}