[MediaWiki-commits] [Gerrit] analytics...WDCM-Semantics-Dashboard[master]: Semantics Dashboard 17 Dec 2017
GoranSMilovanovic has submitted this change and it was merged. (
https://gerrit.wikimedia.org/r/398694 )
Change subject: Semantics Dashboard 17 Dec 2017
..
Semantics Dashboard 17 Dec 2017
Change-Id: I294b0bbf46dc333c8aa48158f8acf47bb7b46718
---
M server.R
M ui.R
2 files changed, 52 insertions(+), 22 deletions(-)
Approvals:
GoranSMilovanovic: Looks good to me, approved
jenkins-bot: Verified
diff --git a/server.R b/server.R
index 6954581..fcc3215 100644
--- a/server.R
+++ b/server.R
@@ -4,7 +4,7 @@
### ---
### --- Setup
-rm(list = ls())
+
###
### --- general
library(shiny)
@@ -92,7 +92,7 @@
dbDisconnect(con)
### --- Fetch local files
-setwd('/home/goransm/WMDE/WDCM/WDCM_SemanticsDashboard/data/')
+setwd('/srv/shiny-server/WDCM_SemanticsDashboard/data/')
### --- fetch projecttopic tables
lF <- list.files()
@@ -133,6 +133,14 @@
fixed = T)[[1]][4]
})
+### --- Fetch update info
+setwd('/srv/shiny-server/WDCM_SemanticsDashboard/update/')
+update <- read.csv('toLabsReport.csv',
+ header = T,
+ check.names = F,
+ stringsAsFactors = F,
+ row.names = 1)
+
### - Determine Constants
# - determine Projects
projects <- wdcmProject$Project
@@ -159,6 +167,16 @@
### --- shinyServer
shinyServer(function(input, output, session) {
+
+ ### --- output: updateInfo
+ output$updateInfo <- renderText({
+date <- update$timeStamp[dim(update)[1]]
+date <- strsplit(as.character(date), split = " ", fixed = T)[[1]][1]
+date <- strsplit(date, split = "-", fixed = T)
+date[[1]][2] <- month.name[as.numeric(date[[1]][2])]
+date <- paste(unlist(date), collapse = " ")
+return(paste("Last update: ", date, "", sep =
""))
+ })
### --
### --- TAB: tabPanel Semantic Models
@@ -215,7 +233,7 @@
sC <- gsub(" ", "", input$selectCategory, fixed = T)
sTable <- itemTopicTables[which(grepl(sC, itemTopicTables, fixed = T))]
cTopic <- tolower(gsub(" ", "", input$selectCategoryTopic))
- if (!length(cTopic) == 0) {
+ if (!(length(cTopic) == 0)) {
### -- Connect
con <- dbConnect(MySQL(),
host = "tools.labsdb",
@@ -274,8 +292,8 @@
if (!is.null(itemTopic())) {
# - normalization: Luce's choice axiom
- itemNames <- itemTopic()$eu_label
- root <- select(itemTopic(), starts_with('topic'))
+ itemNames <- itemTopic()$eu_entity_id
+ root <- dplyr::select(itemTopic(), starts_with('topic'))
root <- as.matrix(parDist(as.matrix(root), method = "euclidean"))
rownames(root) <- itemNames
colnames(root) <- itemNames
@@ -299,6 +317,9 @@
nodes$id[which(nodes$label %in% x)]
})
conceptsStruct$arrows <- rep("to", length(conceptsStruct$to))
+ nodes$label <- sapply(nodes$label, function(x) {
+itemTopic()$eu_label[itemTopic()$eu_entity_id == x]
+ })
visNetwork(nodes = nodes,
edges = conceptsStruct,
width = "100%",
@@ -376,7 +397,7 @@
if (!is.null(input$selectProject)) {
wUnzip <- which(names(unzip_projectTypes) %in% input$selectProject)
if (length(wUnzip > 0)) {
-selectedProjects <- unname(do.call(c, unzip_projectTypes[wUnzip]))
+selectedProjects <- unname(do.call('c', unzip_projectTypes[wUnzip]))
}
wSel <- which(projects %in% input$selectProject)
if (length(wSel > 0)) {
@@ -407,7 +428,6 @@
starts_with('topic'))
catName <- gsub("([[:lower:]])([[:upper:]])", "\\1 \\2",
names(projectTopic)[cCategory])
# - FIX THIS:
- catName <- gsub("Workof Art", "Work of Art", catName, fixed = T)
cProj$Category <- catName
cProj <- cProj %>%
select(Topic, Probability, Category) %>%
@@ -423,7 +443,10 @@
projList <- as.data.frame(rbindlist(projList[wEl]))
# - factor projList$Topic:
projList$Topic <- str_to_title(gsub("([[:alpha:]]+)", "\\1 ",
projList$Topic))
- projList$Topic <- factor(projList$Topic, levels = unique(projList$Topic))
+ topicLevels <- unique(projList$Topic)
+ topicLevelsOrd <- as.numeric(str_extract(topicLevels, "[[:digit:]]+"))
+ topicLevels <- topicLevels[order(topicLevelsOrd)]
+ projList$Topic <- factor(projList$Topic, levels = topicLevels)
# - visualize w. ggplot2
ggplot(projList,
aes(x = Topic,
diff --git a/ui.R b/ui.R
index 6ddb88d..0f75409 100644
--- a/ui.R
+++ b/ui.R
@@ -25,20 +25,27 @@
# - fluidRow Title
fluidRow(
- column(width = 12,
- h2('WDCM Semantics Dashboard'),
- HTML('Wikidata
[MediaWiki-commits] [Gerrit] analytics...WDCM-Semantics-Dashboard[master]: Semantics Dashboard 17 Dec 2017
GoranSMilovanovic has uploaded a new change for review. (
https://gerrit.wikimedia.org/r/398694 )
Change subject: Semantics Dashboard 17 Dec 2017
..
Semantics Dashboard 17 Dec 2017
Change-Id: I294b0bbf46dc333c8aa48158f8acf47bb7b46718
---
M server.R
M ui.R
2 files changed, 52 insertions(+), 22 deletions(-)
git pull
ssh://gerrit.wikimedia.org:29418/analytics/wmde/WDCM-Semantics-Dashboard
refs/changes/94/398694/1
diff --git a/server.R b/server.R
index 6954581..fcc3215 100644
--- a/server.R
+++ b/server.R
@@ -4,7 +4,7 @@
### ---
### --- Setup
-rm(list = ls())
+
###
### --- general
library(shiny)
@@ -92,7 +92,7 @@
dbDisconnect(con)
### --- Fetch local files
-setwd('/home/goransm/WMDE/WDCM/WDCM_SemanticsDashboard/data/')
+setwd('/srv/shiny-server/WDCM_SemanticsDashboard/data/')
### --- fetch projecttopic tables
lF <- list.files()
@@ -133,6 +133,14 @@
fixed = T)[[1]][4]
})
+### --- Fetch update info
+setwd('/srv/shiny-server/WDCM_SemanticsDashboard/update/')
+update <- read.csv('toLabsReport.csv',
+ header = T,
+ check.names = F,
+ stringsAsFactors = F,
+ row.names = 1)
+
### - Determine Constants
# - determine Projects
projects <- wdcmProject$Project
@@ -159,6 +167,16 @@
### --- shinyServer
shinyServer(function(input, output, session) {
+
+ ### --- output: updateInfo
+ output$updateInfo <- renderText({
+date <- update$timeStamp[dim(update)[1]]
+date <- strsplit(as.character(date), split = " ", fixed = T)[[1]][1]
+date <- strsplit(date, split = "-", fixed = T)
+date[[1]][2] <- month.name[as.numeric(date[[1]][2])]
+date <- paste(unlist(date), collapse = " ")
+return(paste("Last update: ", date, "", sep =
""))
+ })
### --
### --- TAB: tabPanel Semantic Models
@@ -215,7 +233,7 @@
sC <- gsub(" ", "", input$selectCategory, fixed = T)
sTable <- itemTopicTables[which(grepl(sC, itemTopicTables, fixed = T))]
cTopic <- tolower(gsub(" ", "", input$selectCategoryTopic))
- if (!length(cTopic) == 0) {
+ if (!(length(cTopic) == 0)) {
### -- Connect
con <- dbConnect(MySQL(),
host = "tools.labsdb",
@@ -274,8 +292,8 @@
if (!is.null(itemTopic())) {
# - normalization: Luce's choice axiom
- itemNames <- itemTopic()$eu_label
- root <- select(itemTopic(), starts_with('topic'))
+ itemNames <- itemTopic()$eu_entity_id
+ root <- dplyr::select(itemTopic(), starts_with('topic'))
root <- as.matrix(parDist(as.matrix(root), method = "euclidean"))
rownames(root) <- itemNames
colnames(root) <- itemNames
@@ -299,6 +317,9 @@
nodes$id[which(nodes$label %in% x)]
})
conceptsStruct$arrows <- rep("to", length(conceptsStruct$to))
+ nodes$label <- sapply(nodes$label, function(x) {
+itemTopic()$eu_label[itemTopic()$eu_entity_id == x]
+ })
visNetwork(nodes = nodes,
edges = conceptsStruct,
width = "100%",
@@ -376,7 +397,7 @@
if (!is.null(input$selectProject)) {
wUnzip <- which(names(unzip_projectTypes) %in% input$selectProject)
if (length(wUnzip > 0)) {
-selectedProjects <- unname(do.call(c, unzip_projectTypes[wUnzip]))
+selectedProjects <- unname(do.call('c', unzip_projectTypes[wUnzip]))
}
wSel <- which(projects %in% input$selectProject)
if (length(wSel > 0)) {
@@ -407,7 +428,6 @@
starts_with('topic'))
catName <- gsub("([[:lower:]])([[:upper:]])", "\\1 \\2",
names(projectTopic)[cCategory])
# - FIX THIS:
- catName <- gsub("Workof Art", "Work of Art", catName, fixed = T)
cProj$Category <- catName
cProj <- cProj %>%
select(Topic, Probability, Category) %>%
@@ -423,7 +443,10 @@
projList <- as.data.frame(rbindlist(projList[wEl]))
# - factor projList$Topic:
projList$Topic <- str_to_title(gsub("([[:alpha:]]+)", "\\1 ",
projList$Topic))
- projList$Topic <- factor(projList$Topic, levels = unique(projList$Topic))
+ topicLevels <- unique(projList$Topic)
+ topicLevelsOrd <- as.numeric(str_extract(topicLevels, "[[:digit:]]+"))
+ topicLevels <- topicLevels[order(topicLevelsOrd)]
+ projList$Topic <- factor(projList$Topic, levels = topicLevels)
# - visualize w. ggplot2
ggplot(projList,
aes(x = Topic,
diff --git a/ui.R b/ui.R
index 6ddb88d..0f75409 100644
--- a/ui.R
+++ b/ui.R
@@ -25,20 +25,27 @@
# - fluidRow Title
fluidRow(
- column(width = 12,
- h2('WDCM Semantics Dashboard'),
-
