Altmetrics demo application for 2:am conference 8.10.2015

global.R

library(dplyr)
library(shiny)
library(shinydashboard)
library(ggvis)
library(DT)
library(dygraphs)
library(xts)
library(sunburstR)
library(networkD3)
library(rCharts)

# http://ttso.shinyapps.io/2amconf

################################################
#
# Read in cleaned ImpactStory data,
# logged since Dec 2014
#
#################################################

issstats <- read.csv(file = "isstats.csv", stringsAsFactors = F)
issstats$Date <- as.Date(issstats$Date)

################################################
#
# Read in cleaned and prepared Altmetric.com data 
# returned by the API query
# to all DOI's now in our CRIS 
#
################################################

# Data for charts and DT datatable
dataForCharts <- read.table(file = "dataforcharts.csv", sep = ";", header = TRUE, stringsAsFactors = FALSE)


# Data for sunburst
datafreq <- read.table(file = "datafreq.csv", sep = ";", header = TRUE, stringsAsFactors = FALSE)

# Data for network graph
nodes <- read.csv("aaltonodes.csv")
links <- read.csv("aaltolinks.csv")

#######################
#
# Function for filling
# gaps in dygraph
#
#######################

# http://stackoverflow.com/questions/7735647/replacing-nas-with-latest-non-na-value
repeat.before = function(x) {   # repeats the last non NA value. Keeps leading NA
  ind = which(!is.na(x))        # get positions of nonmissing values
  if(is.na(x[1]))               # if it begins with a missing, add the 
    ind = c(1,ind)              # first position to the indices
  rep(x[ind], times = diff(     # repeat the values at these indices
    c(ind, length(x) + 1) ))    # diffing the indices + length yields how often 
}                               # they need to be repeated

####################
#
# Help variables
#
####################

metrics <- sort(c("Altmetric", "Mendeley", "Twitter", "Facebook", "GPlus", "CiteULike", "Readers", "Posts", "Accounts", "Feeds", "Delicious",
             "Videos", "Reddit", "News Outlets", "Wikipedia", "LinkedIn", "StackExchange", "Forums", "Research Forums"))


schools <- c("ARTS", "BIZ", "CHEM", "ELEC", "ENG", "SCI")

sample_dataforcharts.csv

"Type";"Year";"Title";"Journal";"Altmetric";"AltmetricURL";"Mendeley";"CiteULike";"Readers";"Unit";"Dept";"School";"GPlus";"Facebook";"Posts";"Twitter";"Accounts";"Feeds";"Videos";"Delicious";"Reddit";"Forums";"StackExchange";"Research forums";"News Outlets";"keys";"Title10"
"Article";2013;"Attention and memory for newspaper advertisements: Effects of ad-editorial congruency and location";"APPLIED COGNITIVE PSYCHOLOGY";2;"http://www.altmetric.com/details.php?citation_id=1302496";18;0;9;"Center for Knowledge and Innovation Research";"Center for Knowledge and Innovation Research (CKIR)";"BIZ";0;0;4;4;4;0;0;0;0;0;0;0;0;1;"Attention  (2013)"
"Article";2011;"Optical Interference Lithography Using Azobenzene-Functionalized Polymers for Micro- and Nanopatterning of Silicon";"ADVANCED MATERIALS";1;"http://www.altmetric.com/details.php?citation_id=240542";30;2;32;"Teknillisen fysiikan laitoksen yhteiset";"Department of Applied Physics";"SCI";0;0;1;1;1;0;0;0;0;0;0;0;0;2;"Optical In (2011)"
"Article";2012;"Rebounding droplet-droplet collisions on superhydrophobic surfaces: from the phenomenon to droplet logic";"ADVANCED MATERIALS";67;"http://www.altmetric.com/details.php?citation_id=934178";33;0;33;"Teknillisen fysiikan laitoksen yhteiset";"Department of Applied Physics";"SCI";3;1;38;20;33;4;2;0;1;0;0;0;2;3;"Rebounding (2012)"
"Article";2012;"Photoalignment and Surface-Relief-Grating Formation are Efficiently Combined in Low-Molecular-Weight Halogen-Bonded Complexes";"ADVANCED MATERIALS";7;"http://www.altmetric.com/details.php?citation_id=1521259";13;0;13;"Teknillisen fysiikan laitoksen yhteiset";"Department of Applied Physics";"SCI";0;0;1;0;1;0;0;0;0;0;0;0;1;4;"Photoalign (2012)"
"Article";2013;"Hydration and Dynamic State of Nanoconfined Polymer Layers Govern Toughness in Nacre-mimetic Nanocomposites";"ADVANCED MATERIALS";1;"http://www.altmetric.com/details.php?citation_id=1665655";13;0;13;"Teknillisen fysiikan laitoksen yhteiset";"Department of Applied Physics";"SCI";0;1;2;1;2;0;0;0;0;0;0;0;0;5;"Hydration  (2013)"
"Article";2013;"Polymer Stabilization Enhances the Orientational Optical Nonlinearity of Oligothiophene-Doped Nematic Liquid Crystals";"ADVANCED OPTICAL MATERIALS";1;"http://www.altmetric.com/details.php?citation_id=1754992";1;0;1;"Teknillisen fysiikan laitoksen yhteiset";"Department of Applied Physics";"SCI";0;0;1;1;1;0;0;0;0;0;0;0;0;6;"Polymer St (2013)"
"Article";2011;"Genetic Engineering of Biomimetic Nanocomposites: Diblock Proteins, Graphene, and Nanofibrillated Cellulose";"ANGEWANDTE CHEMIE";13;"http://www.altmetric.com/details.php?citation_id=206772";63;1;64;"Teknillisen fysiikan laitoksen yhteiset";"Department of Applied Physics";"SCI";0;0;5;3;4;1;0;0;0;0;0;0;0;7;"Genetic En (2011)"
"Article";2011;"Concept-based document classification using wikipedia and value function";"Journal of the American Society for Information Science and Technology";1;"http://www.altmetric.com/details.php?citation_id=386405";10;0;10;"Inf and Service Economy/Common";"Department of Information and Service Economy";"BIZ";0;0;1;1;1;0;0;0;0;0;0;0;0;8;"Concept-ba (2011)"
"Article";2012;"Corporate responsibility and identity: from a stakeholder to an awareness approach";"BUSINESS STRATEGY AND THE ENVIRONMENT";1;"http://www.altmetric.com/details.php?citation_id=496951";32;0;32;"Management Studies/Common";"Department of Management Studies";"BIZ";0;0;1;1;1;0;0;0;0;0;0;0;0;9;"Corporate  (2012)"
"Article";2012;"Direct computation of critical equilibrium states for spatial beams and frame";"INTERNATIONAL JOURNAL FOR NUMERICAL METHODS IN ENGINEERING";1;"http://www.altmetric.com/details.php?citation_id=193486";1;1;2;"Department common, T206";"Department of Civil and Structural Engineering";"ENG";0;0;2;2;2;0;0;0;0;0;0;0;0;18;"Direct com (2012)"
"Article";2011;"An arrayed nanoantenna for broadband light emission and detection";"PHYSICA STATUS SOLIDI: RAPID RESEARCH LETTERS";1;"http://www.altmetric.com/details.php?citation_id=192253";32;0;32;"Radio science and technology";"Department of Radio Science and Engineering";"ELEC";0;0;1;1;1;0;0;0;0;0;0;0;0;19;"An arrayed (2011)"
"Article";2013;"The managed prosumer: evolving knowledge strategies in the design of information infrastructures";"INFORMATION COMMUNICATION AND SOCIETY";4;"http://www.altmetric.com/details.php?citation_id=1710647";17;0;17;"Muotoilun laitoksen yhteiset";"Department of Design";"ARTS";0;0;1;4;4;0;0;0;0;0;0;0;0;176;"The manage (2013)"
"Article";2013;"Ageing together: Steps towards evolutionary co-design in everyday practices";"CODESIGN: INTERNATIONAL JOURNAL OF COCREATION IN DESIGN AND THE ARTS";1;"http://www.altmetric.com/details.php?citation_id=2363859";35;0;35;"Viestinnän laitoksen yhteiset";"Viestinnän laitos";"BIZ";0;0;1;1;1;0;0;0;0;0;0;0;0;180;"Ageing tog (2013)"
"Article";2013;"Chiral-Selective Growth of Single-Walled Carbon Nanotubes on Lattice-Mismatched Epitaxial Cobalt Nanoparticles";"SCIENTIFIC REPORTS";36;"http://www.altmetric.com/details.php?citation_id=1422116";43;0;43;"Department common, T101";"Department of Biotechnology and Chemical Technology";"CHEM";0;1;14;9;14;1;0;0;0;0;0;0;3;138;"Chiral-Sel (2013)"
"Article";2011;"Electrostatic self-assembly of virus-polymer complexes";"JOURNAL OF MATERIALS CHEMISTRY";6;"http://www.altmetric.com/details.php?citation_id=1227682";17;0;17;"Teknillisen fysiikan laitoksen yhteiset";"Department of Applied Physics";"SCI";0;0;1;0;1;1;0;0;0;0;0;0;0;140;"Electrosta (2011)"

server.R

function(input, output, session) {
  
  
  # When School is selected, filter and draw its data to a ggivs chart.
  # If 'All' as School is selected, return all original data.
  selectedSchoolData <- reactive({
    
    if ( input$school == 'All' ) 
      return(dataForCharts)

     dataForCharts %>%
        filter(School %in% input$school) 
  })
  
  
  
  # When School is selected, populate selection with its items for drawing with NVD3
  observe(
    updateSelectizeInput(session, 
                         inputId = 'items', 
                         choices = if ( input$school == 'All' ) dataForCharts$Title  else  selectedSchoolData()$Title 
    )
  )
  
  
  
  
  # When items are selected, filter School data with them
  itemsData <- reactive({
    
     if( is.null(input$items) ){
       return(NULL)
     }

    isolate(selectedSchoolData()[selectedSchoolData()$Title %in% input$items, ])
    
    })
  

  
  # NVD3
  output$chart <- renderChart({
    
    validate(
      need(!is.null(itemsData()), "Please select some items")
    )
    
    dataC <- itemsData() 
    
    datatomelt <- dataC %>%
      mutate(id = Title10) %>%
      select(-Type, -Title, -Title10, -Journal, -Dept, -School, -Unit, -keys, -Year, -AltmetricURL)
    
    dataM <- reshape2::melt(datatomelt, id.vars = "id")
    nplot <- nPlot(value ~ id, data = dataM, 
                   group = "variable", type = "multiBarChart")
    nplot$set(dom="chart")
    return(nplot)
    
  })
  
  
  
  
 
  # GGVIS
  ggvisdata <- reactive({
    
    show_title <- function(x=NULL) {
      if(is.null(x)) return(NULL)
      key <- x["keys"][[1]]
      selectedSchoolData()$Title[key]
    } 
    
    xvar_name <- input$xc 
    yvar_name <- input$yc
    
    xc <- prop("x", as.symbol(input$xc))
    yc <- prop("y", as.symbol(input$yc))
    
    df <- selectedSchoolData()
    
    df$keys <- seq_along(df[,1])
    
    df %>%
      ggvis(x = xc, 
            y = yc, 
            key := ~keys, 
            fill = ~School, 
            opacity := 0.80,
            size.hover := 200) %>%
      layer_points() %>%
      add_axis("x", title = xvar_name) %>%
      add_axis("y", title = yvar_name, title_offset = 50) %>% 
      set_options(width = "100%", height = "500px") %>%
      add_tooltip(show_title)
  })
  ggvisdata %>% bind_shiny("gv")
  

  
  # Some ValueBoxes showing few top metrics in this School
  output$nrofitemswithmetrics <- renderValueBox({
    valueBox(
      "Items with metrics", 
      nrow(selectedSchoolData()), 
      icon = icon("calculator"),
      color = "yellow"
    )
  })
  
  output$maxaltmetrics <- renderValueBox({
    valueBox(
      "Top Altmetric score", 
      max(selectedSchoolData()$Altmetric), 
      icon = icon("spinner"),
      color = "green",
      href = selectedSchoolData()[selectedSchoolData()$Altmetric == max(selectedSchoolData()$Altmetric), "AltmetricURL"][1]
    )
  })
  
  output$maxgplus <- renderValueBox({
    valueBox(
      "Top Google+ score", 
      max(selectedSchoolData()$GPlus), 
      icon = icon("google-plus"),
      color = "teal",
      href = selectedSchoolData()[selectedSchoolData()$GPlus == max(selectedSchoolData()$GPlus), "AltmetricURL"][1]
    )
  })

  output$maxfb <- renderValueBox({
    valueBox(
      "Top Facebook score", 
      max(selectedSchoolData()$Facebook), 
      icon = icon("facebook-f"),
      color = "light-blue",
      href = selectedSchoolData()[selectedSchoolData()$Facebook == max(selectedSchoolData()$Facebook), "AltmetricURL"][1]
    )
  })
  
  output$maxwikipedia <- renderValueBox({
    valueBox(
      "Top Wikipedia score", 
      max(selectedSchoolData()$Wikipedia), 
      icon = icon("wikipedia-w"),
      color = "fuchsia",
      href = selectedSchoolData()[selectedSchoolData()$Wikipedia == max(selectedSchoolData()$Wikipedia), "AltmetricURL"][1]
    )
  })
  
  
  
  
  # Sunburst
  output$sunburst <- renderSunburst({
    sunburst(datafreq, count=TRUE)
  })
  
  
  
  # Download sunburst to a standalone HTML page
  output$downloadSun <- downloadHandler(
    filename = "sunburst.html", contentType = "text/plain", 
    content = function(file) {
      out <- sunburst(datafreq)
      htmlwidgets::saveWidget(out, file)
    })
  
  
  # Network
  output$force <- renderForceNetwork({
    forceNetwork(Links = links, Nodes = nodes,
                 Source = "Source", Target = "Target",
                 Value = "Value", NodeID = "Name",
                 Group = "Group", opacity = 0.8, zoom = T)
  })
  
  
  

  # Datatable
   output$datatable <- DT::renderDataTable({
    
    dtrows <- selectedSchoolData()
    
    totable <- dtrows %>%
      select(-keys, -Title10)

    
    for (i in 1:nrow(totable)) {
      url <- substr(totable$AltmetricURL[i], 47, nchar(totable$AltmetricURL[i]))
      doUrl <- paste0("<a href='", totable[i, c("AltmetricURL")], "'>", url, "</a>")
      totable[i, c("AltmetricURL")] <- doUrl
    } 
    totable
    }, escape = FALSE, options = list(scrollX = T)
)
  
  
   
  
  # Impactstory
  iss <- reactive({
    issstats %>%
      filter(tolower(Title) == unlist(strsplit(input$istitle, "] "))[2])
  })
  
  
  
  output$dygraph <- renderDygraph({
    
    if( nrow(iss()) == 0 ) return() 
    
    iss_spread <- iss() %>% 
      select(Action, Count, Date) %>%
      tidyr::spread(Action, Count) %>%
      lapply(., repeat.before)
  
    # Separate Date+Action combinations
    issList <- lapply(seq(from=2, to=length(iss_spread)), function(i) c(iss_spread[1],iss_spread[i]))
    
    # Make xts objects from these
    xsList <- lapply(issList, function(x) xts(data.frame(x, stringsAsFactors = F), order.by = x$Date))
    
    # Bind columns
    all.xts <- do.call("cbind", xsList)
    
    dygraph(all.xts) %>%
      dyAxis("x", drawGrid = FALSE) %>%
      dyAxis("y", label = "Count") %>%
      dyOptions(colors = RColorBrewer::brewer.pal(3, "Set2")) %>%
      dyLegend(show = "onmouseover", width = 400, showZeroValues = FALSE, hideOnMouseOut = TRUE) %>%
      dyOptions(stepPlot = TRUE,
                strokeWidth = 2)
  
  })

  
  
  # Impactstory link
  output$item <- renderUI({
    
    if ( nrow(iss()) == 0 ) return(NULL)
    
    p("Current item is: ", iss()[1, 'Title'], "see at ")
    url <- paste0("http://impactstory.org/AaltoUniversity/product/", iss()[1, 'ID'])
    t <- iss()[1, 'Title']
    a(t, class="web", href=url)
    })
  
  
}

ui.R

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Altmetric.com", tabName = "altmetric", icon = icon("dashboard")),
    menuSubItem("Sunburst", tabName = "sun", icon = icon("angle-double-right"), selected = NULL),
    menuSubItem("Data", tabName = "data", icon = icon("angle-double-right"), selected = NULL),
    menuSubItem("Organization", tabName = "org", icon = icon("angle-double-right"), selected = NULL),
    menuSubItem("Pivot", href = "https://ttso.shinyapps.io/acrisaltmetricspivot", icon = icon("angle-double-right"), selected = NULL),
    menuItem("Impactstory", tabName = "is", icon = icon("dashboard")),
    selectInput(inputId = "school", 
                label = "School", 
                choices = c("All", schools),
                multiple = FALSE,
                selected = "All"),
    selectInput("xc", "Horizontal axis", as.list(metrics), selected = "Twitter"),
    selectInput("yc", "Vertical axis", as.list(metrics), selected = "Mendeley")
  )
)


body <- dashboardBody(
  
  
  # https://github.com/timelyportfolio/sunburstR/issues/3
  tags$head(
    tags$style(type = "text/css", "#sunburst { width: 500px; height: 500px; position: relative; }"),
    tags$style(type = "text/css", ".small-box p { font-size: 15px; }")
    ),

  tabItems(
    
    tabItem("altmetric",
            fluidRow(
              column(
                width = 8,
                box(title = "Scatterplot by School",
                    status = "success",
                    solidHeader = TRUE,
                    width = "100%",
                    height = "600px",
                    ggvisOutput("gv"))
              ),
              column(
                width = 4,
                valueBoxOutput("nrofitemswithmetrics", width = "100%"),
                valueBoxOutput("maxaltmetrics", width = "100%"),
                valueBoxOutput("maxgplus", width = "100%"),
                valueBoxOutput("maxfb", width = "100%"),
                valueBoxOutput("maxwikipedia", width = "100%"))
            ),
            fluidRow(
                box(title = "Select max 2 items",
                  width = 4,
                  height = "300px",
                  selectizeInput(inputId = 'items', label = 'Items', choices = NULL, options = list(maxItems = 2))
                  ),
                box(title = "Barchart",
                  status = "success",
                  solidHeader = TRUE,
                  width =  8,
                  height = "600px",
                  showOutput("chart", "nvd3"),
                  HTML('<style>.rChart {width: 100%; height: 400px}</style>'))
                )
    ),
    
    tabItem("data",
            fluidRow(
              box(title = "Table",
                  status = "info",
                  solidHeader = TRUE,
                  width = 12,
                  height = "600px",
                  DT::dataTableOutput("datatable", 
                                      width = "100%",
                                      height = "600px"))
              )
    ),
    
    
    tabItem("is",
            fluidRow(
              box(title = "Collection",
                  status = "warning",
                  solidHeader = TRUE,
                  width = 6,
                  height = "200px",
                  selectizeInput(
                    inputId = "istitle", 
                    label = "Select item",
                    width = "100%",
                    choices = c("", sort(tolower(unique(paste0(issstats$Type, " ", issstats$Title))))),
                    options = list(maxItems = 1)
                    ),
                    uiOutput("item")
                  )
              ),
            fluidRow(
              box(title = "Weekly statistics",
                  status = "warning",
                  solidHeader = TRUE,
                  width = 12,
                  heigth = "400px",
                  dygraphOutput("dygraph", width = "100%", height = "400px"))
            )
    ),
    
    tabItem("org",
            fluidRow(
              column(
                width = 12,
                box(title = "Units by School",
                    status = "info",
                    solidHeader = TRUE,
                    width = "100%",
                    height = "600px",
                    forceNetworkOutput("force", width = "100%", height = "500px"))
              )
            )
    ),
    tabItem("sun",
            fluidRow(
              column(
                width = 6,
                box(title = "Altmetric.com data by unit",
                    status = "info",
                    solidHeader = TRUE,
                    width = "100%",
                    height = "600px",
                    sunburstOutput("sunburst", width = "100%", height = "500px")),
                    downloadButton('downloadSun', 'Download')
              )
            )
    )
  ))


dashboardPage(
  dashboardHeader(title = "Altmetrics",
                  titleWidth = "500"),
  sidebar,
  body,
  skin = "black"
)