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("<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: merged Gerrit-Change-Id: I294b0bbf46dc333c8aa48158f8acf47bb7b46718 Gerrit-PatchSet: 1 Gerrit-Project: analytics/wmde/WDCM-Semantics-Dashboard Gerrit-Branch: master Gerrit-Owner: GoranSMilovanovic <goran.milovanovic_...@wikimedia.de> Gerrit-Reviewer: GoranSMilovanovic <goran.milovanovic_...@wikimedia.de> Gerrit-Reviewer: jenkins-bot <> _______________________________________________ MediaWiki-commits mailing list MediaWiki-commits@lists.wikimedia.org https://lists.wikimedia.org/mailman/listinfo/mediawiki-commits