2023-09-20 16:16:47 +02:00
#' Creating log events from raw log files.
#'
#' Creating event logs from a data frame of raw log files from a
#' Multi-Touch-Table at the IWM.
#'
#' @param data Data frame of raw log files created with `parse_logfiles()`.
#' See `?parse_logfiles` for more details.
2023-09-21 16:47:23 +02:00
#' @param xmlpath Path to folder where XML definitions of artworks live.
2023-10-22 15:13:11 +02:00
#' @param case_cutoff Number in seconds how long time interval between
#' different cases should be.
#' @param rm_nochange_moves Logical. Should move events that record no
#' change, meaning distance and rotationDegree are 0 and scaleSize is 1, be
#' removed. Default is TRUE.
2023-09-20 16:16:47 +02:00
#' @return Data frame.
#' @export
#' @examples
#' # tbd
2023-10-22 15:13:11 +02:00
create_eventlogs <- function ( data , xmlpath , case_cutoff = 20 , rm_nochange_moves = TRUE ) {
2023-09-20 16:16:47 +02:00
2023-09-21 16:47:23 +02:00
if ( ! lubridate :: is.POSIXt ( data $ date ) ) {
2023-10-15 10:55:12 +02:00
cat ( " ########## Converting variable `date` to POSIXct ##########" , " \n" )
2023-09-21 16:47:23 +02:00
data $ date <- as.POSIXct ( data $ date )
}
2023-09-20 16:16:47 +02:00
data $ glossar <- ifelse ( data $ artwork == " glossar" , 1 , 0 )
2023-10-22 16:52:46 +02:00
2023-09-20 16:16:47 +02:00
# Remove irrelevant events
dat <- subset ( data , ! ( data $ event %in% c ( " Start Application" ,
" Show Application" ) ) )
2023-09-21 16:47:23 +02:00
artworks <- unique ( stats :: na.omit ( dat $ artwork ) )
2023-09-22 16:00:57 +02:00
2023-09-25 11:29:35 +02:00
# Create glossar dictionary ##############################################
2023-09-22 16:00:57 +02:00
if ( " glossar" %in% artworks ) {
2023-09-25 11:29:35 +02:00
cat ( " \n########## Creating glossar dictionary ##########" , " \n" )
2023-09-22 16:00:57 +02:00
artworks <- artworks [artworks != " glossar" ]
glossar_files <- unique ( subset ( dat , dat $ artwork == " glossar" ) $ popup )
glossar_dict <- create_glossardict ( artworks , glossar_files , xmlpath = xmlpath )
} else {
glossar_dict <- NULL
}
2023-09-21 16:47:23 +02:00
2023-09-20 16:16:47 +02:00
# Add trace variable #####################################################
2023-09-21 16:47:23 +02:00
cat ( " \n########## Adding trace variable... ##########" , " \n" )
dat1 <- add_trace ( dat , glossar_dict )
2023-09-20 16:16:47 +02:00
# Close events
2023-09-22 16:00:57 +02:00
cat ( " \n\n########## Closing events... ##########" , " \n" )
2023-10-22 15:13:11 +02:00
c1 <- close_events ( dat1 , " move" , rm_nochange_moves = rm_nochange_moves )
2023-09-20 16:16:47 +02:00
cat ( " ## --> move events closed." , " \n" )
2023-10-22 15:13:11 +02:00
c2 <- close_events ( dat1 , " flipCard" , rm_nochange_moves = rm_nochange_moves )
2023-09-20 16:16:47 +02:00
cat ( " ## --> flipCard events closed." , " \n" )
2023-10-22 15:13:11 +02:00
c3 <- close_events ( dat1 , " openTopic" , rm_nochange_moves = rm_nochange_moves )
2023-09-20 16:16:47 +02:00
cat ( " ## --> openTopic events closed." , " \n" )
2023-10-22 15:13:11 +02:00
c4 <- close_events ( dat1 , " openPopup" , rm_nochange_moves = rm_nochange_moves )
2023-09-20 16:16:47 +02:00
cat ( " ## --> openPopup events closed." , " \n" )
dat2 <- rbind ( c1 , c2 , c3 , c4 )
2023-10-22 16:52:46 +02:00
2023-10-22 15:13:11 +02:00
dat2 <- dat2 [order ( dat2 $ fileId.start , dat2 $ date.start , dat2 $ timeMs.start ) , ]
2023-09-20 16:16:47 +02:00
# Remove all events that do not have a `date.start`
2023-10-22 15:13:11 +02:00
# d1 <- nrow(dat2)
# dat2 <- dat2[!is.na(dat2$date.start), ]
# d2 <- nrow(dat2)
# if(d1 > d2) {
# warning(paste0(d1-d2, " lines that do not contain a start event have been removed. This can happen when events span over more than one log file.\n"))
# }
2023-09-20 16:16:47 +02:00
2023-10-22 15:13:11 +02:00
# rownames(dat2) <- NULL
2023-09-20 16:16:47 +02:00
# Add case variable ######################################################
2023-09-21 16:47:23 +02:00
cat ( " \n########## Adding case and eventId variables... ##########" , " \n\n" )
2023-10-22 15:13:11 +02:00
dat3 <- add_case ( dat2 , cutoff = case_cutoff )
2023-10-22 16:52:46 +02:00
2023-09-20 16:16:47 +02:00
# Add event ID ###########################################################
dat3 $ eventId <- seq_len ( nrow ( dat3 ) )
2023-10-22 15:13:11 +02:00
dat3 <- dat3 [ , c ( " folder" , " eventId" , " case" , " trace" , " glossar" ,
" event" , " artwork" , " fileId.start" , " fileId.stop" ,
2023-09-20 16:16:47 +02:00
" date.start" , " date.stop" , " timeMs.start" ,
" timeMs.stop" , " duration" , " topicNumber" , " popup" ,
2023-10-22 15:13:11 +02:00
" x.start" , " y.start" , " x.stop" , " y.stop" , " distance" ,
" scale.start" , " scale.stop" , " scaleSize" ,
" rotation.start" , " rotation.stop" , " rotationDegree" ) ]
2023-09-20 16:16:47 +02:00
# Add trace for move events ##############################################
2023-09-21 16:47:23 +02:00
cat ( " \n\n########## Adding trace variable for move events... ##########" , " \n" )
2023-09-20 16:16:47 +02:00
dat4 <- add_trace_moves ( dat3 )
2023-10-22 15:13:11 +02:00
2023-10-22 16:52:46 +02:00
# Remove fragmented traces ###############################################
tab <- xtabs ( ~ trace + 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 $ trace %in% fragments , ]
# TODO: Should be tested more thouroughly on complete data set
dat5
2023-09-20 16:16:47 +02:00
}