Moved files for project 8o8m out of repossitory
This commit is contained in:
parent
e8aac63504
commit
ae7e580749
@ -1,37 +0,0 @@
|
|||||||
# setwd("C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/code")
|
|
||||||
|
|
||||||
#library(mtt)
|
|
||||||
devtools::load_all("../../../../software/mtt")
|
|
||||||
|
|
||||||
now <- format(Sys.time(), "%Y-%m-%d_%H-%M-%S")
|
|
||||||
|
|
||||||
folders <- dir("../data/8o8m/LogFiles/")
|
|
||||||
#folders <- "Berlin"
|
|
||||||
|
|
||||||
# parse raw log files
|
|
||||||
datraw <- parse_logfiles(folders, path = "../data/8o8m/LogFiles/")
|
|
||||||
#artworks <- unique(na.omit(datraw$artwork))
|
|
||||||
|
|
||||||
# export data
|
|
||||||
write.table(datraw, paste0("results/8o8m/raw_logfiles_", now, ".csv"),
|
|
||||||
sep = ";", row.names = FALSE)
|
|
||||||
|
|
||||||
#datraw[is.na(datraw$artwork), ]
|
|
||||||
datraw <- datraw[!is.na(datraw$artwork), ]
|
|
||||||
# TODO: Why is this happening?
|
|
||||||
|
|
||||||
# convert to log events
|
|
||||||
datlogs <- create_eventlogs(datraw, xmlpath = "../data/8o8m/Content8o8m/")
|
|
||||||
|
|
||||||
artworks <- unique(datlogs$artwork)
|
|
||||||
|
|
||||||
|
|
||||||
topics <- extract_topics(artworks, xmlfiles = paste0(artworks, "_en.xml"),
|
|
||||||
xmlpath = "../data/8o8m/Content8o8m/")
|
|
||||||
# TODO: What is wrong with the German XML files that the topics are
|
|
||||||
# extracted like this? (It works fine for the English versions...)
|
|
||||||
|
|
||||||
# export data
|
|
||||||
write.table(datlogs, paste0("results/8o8m/event_logfiles_", now, ".csv"),
|
|
||||||
sep = ";", row.names = FALSE)
|
|
||||||
|
|
@ -1,125 +0,0 @@
|
|||||||
# setwd("C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/code/")
|
|
||||||
|
|
||||||
library(lattice)
|
|
||||||
devtools::load_all("../../../../software/mtt")
|
|
||||||
library(ggplot2)
|
|
||||||
|
|
||||||
# Read data
|
|
||||||
datlogs <- read.table("results/8o8m/event_logfiles_2023-09-22_18-54-49.csv",
|
|
||||||
sep = ";", header = TRUE)
|
|
||||||
datlogs$date <- as.Date(datlogs$date.start)
|
|
||||||
datlogs$date.start <- as.POSIXct(datlogs$date.start)
|
|
||||||
datlogs$date.stop <- as.POSIXct(datlogs$date.stop)
|
|
||||||
datlogs$artwork <- sprintf("%02d", datlogs$artwork)
|
|
||||||
|
|
||||||
### Which artwork gets touched most often?
|
|
||||||
|
|
||||||
counts_artwork <- table(datlogs$artwork)
|
|
||||||
|
|
||||||
artworks <- unique(datlogs$artwork)
|
|
||||||
datart <- extract_artworks(artworks,
|
|
||||||
paste0(artworks, "_de.xml"),
|
|
||||||
"../data/8o8m/Content8o8m/")
|
|
||||||
datart <- datart[order(datart$artwork), ]
|
|
||||||
names(counts_artwork) <- datart$title
|
|
||||||
|
|
||||||
#pdf("../figures/counts_artwork_8o8m.pdf", width = 20, height = 10, pointsize = 10)
|
|
||||||
#par(mai = c(3, .6, .1, .1))
|
|
||||||
tmp <- barplot(counts_artwork, las = 2, ylim = c(0, 90000), border = "white")
|
|
||||||
text(tmp, counts_artwork + 1500, c(datart$artwork))
|
|
||||||
#dev.off()
|
|
||||||
|
|
||||||
# more interesting per museum in this case...
|
|
||||||
counts_artwork <- aggregate(trace ~ artwork + folder, datlogs, length)
|
|
||||||
pdf("../figures/counts_artwork_8o8m.pdf", width = 20, height = 6, pointsize = 10)
|
|
||||||
barchart(trace ~ artwork | folder, counts_artwork, ylab = "", layout = c(5, 1),
|
|
||||||
border = "transparent", col = "#0072B2")
|
|
||||||
dev.off()
|
|
||||||
|
|
||||||
|
|
||||||
### Dwell times/duration
|
|
||||||
set.seed(1033)
|
|
||||||
|
|
||||||
pdf("../figures/duration_8o8m.pdf", width = 20, height = 6, pointsize = 10)
|
|
||||||
bwplot(I(duration/1000/60) ~ as.factor(event) | folder,
|
|
||||||
datlogs[sample(nrow(datlogs), 100000), ], ylab = "Duration in min")
|
|
||||||
dev.off()
|
|
||||||
|
|
||||||
set.seed(1033)
|
|
||||||
|
|
||||||
pdf("../figures/duration_8o8m_artworks.pdf", width = 20, height = 10, pointsize = 10)
|
|
||||||
bwplot(I(duration/1000/60) ~ as.factor(event) | artwork + folder,
|
|
||||||
datlogs[sample(nrow(datlogs), 100000), ], ylab = "Duration in min")
|
|
||||||
dev.off()
|
|
||||||
|
|
||||||
### Are there certain areas of the table that are touched most often?
|
|
||||||
|
|
||||||
# heatmap
|
|
||||||
|
|
||||||
dattrim <- datlogs[datlogs$x.start < 3840 &
|
|
||||||
datlogs$x.start > 0 &
|
|
||||||
datlogs$y.start < 2160 &
|
|
||||||
datlogs$y.start > 0 &
|
|
||||||
datlogs$x.stop < 3840 &
|
|
||||||
datlogs$x.stop > 0 &
|
|
||||||
datlogs$y.stop < 2160 &
|
|
||||||
datlogs$y.stop > 0, ]
|
|
||||||
|
|
||||||
cuts <- 100 # 200, 100, 70, ...
|
|
||||||
|
|
||||||
# start
|
|
||||||
dattrim$x.start.cat <- cut(dattrim$x.start, cuts)
|
|
||||||
dattrim$y.start.cat <- cut(dattrim$y.start, cuts)
|
|
||||||
|
|
||||||
tab.start <- xtabs( ~ x.start.cat + y.start.cat, dattrim)
|
|
||||||
colnames(tab.start) <- NULL
|
|
||||||
rownames(tab.start) <- NULL
|
|
||||||
|
|
||||||
pdf("../figures/heatmap_start_8o8m.pdf", width = 5, height = 5, pointsize = 10)
|
|
||||||
heatmap(tab.start, Rowv = NA, Colv = NA)
|
|
||||||
dev.off()
|
|
||||||
|
|
||||||
# stop
|
|
||||||
dattrim$x.stop.cat <- cut(dattrim$x.stop, cuts)
|
|
||||||
dattrim$y.stop.cat <- cut(dattrim$y.stop, cuts)
|
|
||||||
tab.stop <- xtabs( ~ x.stop.cat + y.stop.cat, dattrim)
|
|
||||||
colnames(tab.stop) <- NULL
|
|
||||||
rownames(tab.stop) <- NULL
|
|
||||||
|
|
||||||
pdf("../figures/heatmap_stop_8o8m.pdf", width = 5, height = 5, pointsize = 10)
|
|
||||||
heatmap(tab.stop, Rowv = NA, Colv = NA)
|
|
||||||
dev.off()
|
|
||||||
|
|
||||||
### How many visitors per day
|
|
||||||
|
|
||||||
# Cases per day
|
|
||||||
datcase <- aggregate(case ~ date + folder, datlogs, function(x) length(unique(x)))
|
|
||||||
|
|
||||||
pdf("../figures/cases_per_day_8o8m.pdf", width = 20, height = 6, pointsize = 10)
|
|
||||||
barchart(case ~ date | folder, datcase, horizontal = F,
|
|
||||||
scales = list(x = list(rot = 90, at = seq(1, 122, 10)), y = list(rot = 90)),
|
|
||||||
border = "transparent", col = "#0072B2")
|
|
||||||
dev.off()
|
|
||||||
|
|
||||||
|
|
||||||
### Other stuff
|
|
||||||
|
|
||||||
## weird behavior of timeMs
|
|
||||||
|
|
||||||
pdf("../figures/timeMs_8o8m.pdf", width = 9, height = 6, pointsize = 10)
|
|
||||||
bwplot(timeMs.start ~ as.factor(fileId), datlogs[1:2000,], xlab = "",
|
|
||||||
scales = list(x = list(rot = 90), y = list(rot = 90)))
|
|
||||||
dev.off()
|
|
||||||
|
|
||||||
## x,y-coordinates out of range
|
|
||||||
|
|
||||||
set.seed(1522)
|
|
||||||
|
|
||||||
pdf("../figures/xycoord_8o8m.pdf", width = 5, height = 5, pointsize = 10)
|
|
||||||
par(mai = c(.6, .6, .1, .1), mgp = c(2.4, 1, 0))
|
|
||||||
plot(y.start ~ x.start, datlogs[sample(nrow(datlogs), 10000), ])
|
|
||||||
abline(v = c(0, 3840), h = c(0, 2160), col = "#0072B2", lwd = 2)
|
|
||||||
legend("bottomleft", "Random sample of 10,000", bg = "white")
|
|
||||||
legend("topleft", "4K-Display: 3840 x 2160", bg = "white")
|
|
||||||
dev.off()
|
|
||||||
|
|
@ -1,50 +0,0 @@
|
|||||||
# setwd("C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/code")
|
|
||||||
|
|
||||||
# TODO: Write an Rmd file this way and render at the end? Then put it in a
|
|
||||||
# function, so everybody can do it???
|
|
||||||
devtools::load_all("../../../../software/mtt")
|
|
||||||
|
|
||||||
fname <- "../museums/overview_artworks_8o8m.tex"
|
|
||||||
if (file.exists(fname)) file.remove(fname)
|
|
||||||
|
|
||||||
path <- "C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/data/8o8m/Content8o8m"
|
|
||||||
artworks <- dir(path = path)
|
|
||||||
|
|
||||||
dat <- extract_artworks(artworks, xmlfiles = paste0(artworks, "_de.xml"), xmlpath = path)
|
|
||||||
|
|
||||||
fout <- file(fname, "a") # open in append mode
|
|
||||||
|
|
||||||
writeLines("\\documentclass[a4paper,12pt]{article}", fout)
|
|
||||||
writeLines("\\usepackage{graphicx}", fout)
|
|
||||||
writeLines("\\usepackage[margin = 2cm]{geometry}", fout)
|
|
||||||
writeLines("\\author{Nora Wickelmaier}", fout)
|
|
||||||
writeLines("\\title{Overview of Artworks from 8 Objects 8 Museums (8o8m)}", fout)
|
|
||||||
writeLines("\\date{\\today}", fout)
|
|
||||||
writeLines("\\begin{document}", fout)
|
|
||||||
writeLines("\\maketitle", fout)
|
|
||||||
#writeLines("\\newpage", fout)
|
|
||||||
|
|
||||||
for (artwork in dat$artwork) {
|
|
||||||
|
|
||||||
writeLines(paste0("\\section*{Artwork Number ", artwork, "}"), fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
writeLines("\\noindent", fout)
|
|
||||||
writeLines(paste0("Artist: ", dat[dat$artwork == artwork, "artist"]), fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
writeLines("\\noindent", fout)
|
|
||||||
writeLines(paste0("Title: ", dat[dat$artwork == artwork, "title"]), fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
|
|
||||||
writeLines("\\begin{center}", fout)
|
|
||||||
art_path <- paste(path, artwork, artwork, sep = "/")
|
|
||||||
writeLines(paste0("\\includegraphics[width = 12cm]{", art_path, "}"), fout)
|
|
||||||
writeLines("\\end{center}", fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
writeLines("\\noindent", fout)
|
|
||||||
writeLines(paste0("Info: ", dat[dat$artwork == artwork, "misc"]), fout)
|
|
||||||
writeLines("\\newpage", fout)
|
|
||||||
}
|
|
||||||
|
|
||||||
writeLines("\\end{document}", fout)
|
|
||||||
close(fout)
|
|
||||||
|
|
@ -1,50 +0,0 @@
|
|||||||
# setwd("C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/code")
|
|
||||||
|
|
||||||
devtools::load_all("../../../../software/mtt")
|
|
||||||
|
|
||||||
fname <- "../museums/overview_artworks_haum.tex"
|
|
||||||
if (file.exists(fname)) file.remove(fname)
|
|
||||||
|
|
||||||
xmlpath <- "C:/Users/nwickelmaier/Nextcloud/Documents/MDS/2023ss/60100_master_thesis/data/haum/ContentEyevisit/eyevisit_cards_light"
|
|
||||||
artworks <- dir(path = xmlpath)
|
|
||||||
artworks <- artworks[artworks != "glossar"]
|
|
||||||
|
|
||||||
dat <- extract_artworks(artworks, xmlfiles = paste0(artworks, ".xml"),
|
|
||||||
xmlpath = xmlpath)
|
|
||||||
|
|
||||||
fout <- file(fname, "a") # open in append mode
|
|
||||||
|
|
||||||
writeLines("\\documentclass[a4paper,12pt]{article}", fout)
|
|
||||||
writeLines("\\usepackage{graphicx}", fout)
|
|
||||||
writeLines("\\usepackage[margin = 2cm]{geometry}", fout)
|
|
||||||
writeLines("\\author{Nora Wickelmaier}", fout)
|
|
||||||
writeLines("\\title{Overview of Artworks from MTT in HAUM}", fout)
|
|
||||||
writeLines("\\date{\\today}", fout)
|
|
||||||
writeLines("\\begin{document}", fout)
|
|
||||||
writeLines("\\maketitle", fout)
|
|
||||||
#writeLines("\\newpage", fout)
|
|
||||||
|
|
||||||
for (artwork in dat$artwork) {
|
|
||||||
|
|
||||||
writeLines(paste0("\\section*{Artwork Number ", artwork, "}"), fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
writeLines("\\noindent", fout)
|
|
||||||
writeLines(paste0("Artist: ", dat[dat$artwork == artwork, "artist"]), fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
writeLines("\\noindent", fout)
|
|
||||||
writeLines(paste0("Title: ", dat[dat$artwork == artwork, "title"]), fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
|
|
||||||
writeLines("\\begin{center}", fout)
|
|
||||||
art_path <- paste(xmlpath, artwork, artwork, sep = "/")
|
|
||||||
writeLines(paste0("\\includegraphics[width = 12cm]{", art_path, "}"), fout)
|
|
||||||
writeLines("\\end{center}", fout)
|
|
||||||
writeLines("", fout)
|
|
||||||
writeLines("\\noindent", fout)
|
|
||||||
writeLines(paste0("Info: ", dat[dat$artwork == artwork, "misc"]), fout)
|
|
||||||
writeLines("\\newpage", fout)
|
|
||||||
}
|
|
||||||
|
|
||||||
writeLines("\\end{document}", fout)
|
|
||||||
close(fout)
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user