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("<p align=right>Last update: <i>", date, "</i></p>", 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('<font size="3"><b>Wikidata Concepts
Monitor</b></font>')
-
- )
- ), # - fluidRow Title END
-
- # - fluidRow Logo
- fluidRow(
- column(width = 12,
- img(src = 'Wikidata-logo-en.png',
- align = "left")
- )
- ), # - fluidRow END
+ column(width = 5,
+ fluidRow(
+ column(width = 3,
+ img(src = 'Wikidata-logo-en.png',
+ align = "left")
+ ),
+ column(width = 1),
+ column(width = 8,
+ h1('WDCM Semantics Dashboard'),
+ HTML('<font size="5"><b>Wikidata Concepts
Monitor</b></font>')
+ )
+ )
+ ),
+ column(width = 7,
+ br(),
+ HTML('<p align="right"><b>Interactive visualizations of
Wikidata use by other Wikimedia projects.</b></p>'),
+ HTML('<p align="right"><b><a href =
"https://www.wikidata.org/wiki/Wikidata:Wikidata_Concepts_Monitor";
target="_blank">Visit the WDCM wiki page</a></b></p>'),
+ HTML('<p align="right"><b>Did you spot a bug, a missing
label, or wrong data? <a href =
"https://www.wikidata.org/wiki/Wikidata:Wikidata_Concepts_Monitor/UserFeedback";
target="_blank">Give us feedback here</a></b></p>'),
+ htmlOutput('updateInfo')
+ )
+ ), # - fluidRow Title END
# - hr()
fluidRow(
--
To view, visit https://gerrit.wikimedia.org/r/398694
To unsubscribe, visit https://gerrit.wikimedia.org/r/settings
Gerrit-MessageType: newchange
Gerrit-Change-Id: I294b0bbf46dc333c8aa48158f8acf47bb7b46718
Gerrit-PatchSet: 1
Gerrit-Project: analytics/wmde/WDCM-Semantics-Dashboard
Gerrit-Branch: master
Gerrit-Owner: GoranSMilovanovic <goran.milovanovic_...@wikimedia.de>
_______________________________________________
MediaWiki-commits mailing list
MediaWiki-commits@lists.wikimedia.org
https://lists.wikimedia.org/mailman/listinfo/mediawiki-commits
