Untitled2.R

# if(!require(shiny)) install.packages("shiny", repos = "http://cran.us.r-project.org")
# if(!require(shinythemes)) install.packages("shinythemes", repos = "http://cran.us.r-project.org")
# if(!require(dplyr)) install.packages("dplyr", repos = "http://cran.us.r-project.org")
# if(!require(sna)) install.packages("sna", repos = "http://cran.us.r-project.org")
# if(!require(igraph)) install.packages("igraph", repos = "http://cran.us.r-project.org")
# if(!require(visNetwork)) install.packages("visNetwork", repos = "http://cran.us.r-project.org")
# if(!require(shinyWidgets)) install.packages("shinyWidgets", repos = "http://cran.us.r-project.org")
# if(!require(devtools)) install.packages("devtools", repos = "http://cran.us.r-project.org")
# if(!require(NobleDynamic)) devtools::install_github('knrg07/NobleDynamic')
# if(!require(networkDynamic)) install.packages("networkDynamic", repos = "http://cran.us.r-project.org")
# if(!require(ggplot2)) install.packages("ggplot2", repos = "http://cran.us.r-project.org")
# if(!require(ggiraph)) install.packages("ggiraph", repos = "http://cran.us.r-project.org")
# if(!require(leaflet)) install.packages("leaflet", repos = "http://cran.us.r-project.org")
library(shiny)
library(shinythemes)
library(dplyr)
library(sna)
library(igraph)
library(visNetwork)
library(shinyWidgets)
library(networkDynamic)
library(ggplot2)
library(ggiraph)
library(leaflet)
library(packcircles)
library(viridis)
library(scales)
library(dygraphs)
library(xts)

load('/Users/karlanohemi/Desktop/PROJECTS/R PACKAGES/NobleDynamic/data/rawData.rda')
load('/Users/karlanohemi/Desktop/PROJECTS/R PACKAGES/NobleDynamic/data/gantt.rda')
gantt <- gantt_data
don=xts( x=gantt[,-1], order.by=gantt$wk_date)
#don <- don
### IMPORT DATA ONLY ONE TIME
# data(rawData)
x <- as.data.frame(rawContacts)
vhf <- as.data.frame(vhf)
ok_base <- leaflet() %>% addProviderTiles(providers$Stamen.Toner) %>% setView(-97.14, 33.93, zoom = 10)
gantt <- gantt

## RUN 3 UNIQUE FUNCTIONS BEFOREHAND FOR QUICKER HANDLING
# FUNCTION 1 FOR SUBSETTING BASED ON DATES & SPATIAL-TEMPORAL DEFINITION INPUTS
subset_view <- function(data, start, end, distance, time){
  df <- data %>% filter(week_date >= start & week_date <= end & TIME_min <= time & distEuclid <= distance )
  return(df)}

# FUNCTION 2: SUBSEQUENT NODE DERIVATION
create_nodes <- function(data){
  no1b <- as.data.frame(table(data$KID_ref))
  no2b <- as.data.frame(table(data$KID_par))
  nodes <- full_join(no1b, no2b, by = "Var1")
  nodes <- as.data.frame(nodes[,1])
  colnames(nodes) <- 'KID'
  nodes$group <- gsub('[0-9]', '', nodes$KID)
  nodes$group[(nodes$group == "c")] <- "Cattle"
  nodes$group[(nodes$group == "p")] <- "Pigs"
  nodes$group[(nodes$group == "d")] <- "Deer"
  nodes <- merge(nodes, vhf, by = 'KID', all.x = T)
  nodes <- subset(nodes, select = c(KID, group, vertex.id))
  colnames(nodes) <- c('id', 'group', 'vertex.id')
  nodes$vertex.id <- as.integer(nodes$vertex.id)
  nodes$color <- ifelse(nodes$group == 'Cattle', '#458B00', ifelse(nodes$group == 'Pigs', '#FF6347', '#996633'))
  nodes <- as.data.frame(nodes)
  return(nodes)}

# FUNCTION 3: SUBSEQUENT EDGE DERIVATION
create_edges <- function(data){
  edges <- subset(data, select = c(KID_ref, KID_par, value))
  edges <- aggregate(edges$value, by = list(edges$KID_ref, edges$KID_par), FUN = sum)
  colnames(edges) <- c('from', 'to', 'value')
  edges <- as.data.frame(edges)
  edges$value <- as.integer(edges$value)
  edges$color <- '#CCCCCC'
  return(edges)}

# customization for descriptive plots
tooltip_css <- "background-opacity:0;font-size: 150%;font-style:strong;padding:10px;border-radius:10px 20px 10px 20px;"

# TESTING FUNCTIONS BELOW
# test <- subset_view(x, '2018-04-01', '2018-04-14', 10, 10)
# nodes <- create_nodes(test)
# edges<- create_edges(test)

ui <- bootstrapPage(
  navbarPage(theme = shinytheme('darkly'),
             collapsible = T, title = 'Noble Networks', id = 'nav',
             
             navbarMenu(title = 'Static Networks',
                        tabPanel('Static Graph', style = 'background-color:#005493',
                                 div(class='outer', align = 'right',
                                     tags$head(includeCSS('style/main.css')),
                                     visNetworkOutput("networkPlot",height = "100%", width = '100%'),
                                     
                                     absolutePanel(id = 'controls', class = 'panel panel-default',
                                                   top = 75, left = 10, width = 250, fixed = T,
                                                   draggable = T, height = '100%', style = 'color:black',
                                                   span(tags$i(h6('Short date intervals are recommended for static descriptives. See the Dynamic Network tab for time-series networks.'), align = 'left'), style = 'color:#941100'),
                                                   span(tags$strong(h4('Current Static View:'), align = 'left')),
                                                   h3(textOutput('tot_anim'), align = 'left'),
                                                   span(h4(textOutput('tot_cow'), align = 'right'), style = 'color:#458B00'),
                                                   span(h4(textOutput('tot_pig'), align = 'right'), style = 'color:#FF6347'),
                                                   span(h4(textOutput('tot_deer'), align = 'right'), style = 'color:#996633'),
                                                   tags$hr(),
                                                   span(tags$strong(h4('Modify Definitions:'), align = 'left')),
                                                   setSliderColor(c('#8A2252', '#00B3A3'), c(1,2)),
                                                   sliderInput('time_window', label = "Temporal Window (MINUTES):", value = 10, min = 1, max = 30),
                                                   sliderInput('distance_window', label = "Spatial Window (METERS):", value = 10, min = 1, max = 30),
                                                   tags$hr(),
                                                   tags$hr(),
                                                   dateRangeInput('date_range', label = 'Modify Date Range View:', start = '2018-04-01', end = '2018-04-14', min = '2017-08-20', max = '2020-05-03', format = 'yyyy-mm-dd', separator = '-', weekstart = 7, startview = 'month'),
                                                   actionButton('Update_Click', label = 'Update Network'))),
                                 
                                 absolutePanel(id = 'controls', class = 'panel panel-default',
                                               bottom = 5, right = 10, width = 225, fixed = F,
                                               draggable = T, height = '25%', style = 'color:black',
                                               
                                               h4('Graph Averages:', align = 'left'),
                                               span(tags$strong(h5(textOutput('avg_deg'), align = 'left'), style = 'color:#00B3A3')),
                                               span(tags$strong(h5(textOutput('avg_diam'), align = 'left'), style = 'color:#00B3A3')),
                                               span(tags$strong(h5(textOutput('avg_assort'), align = 'left'), style = 'color:#6B8D23')),
                                               span(tags$strong(h5(textOutput('avg_bet'), align = 'left'), style = 'color:#1A80B3')),
                                               span(tags$strong(h5(textOutput('avg_clos'), align = 'left'), style = 'color:#777788')))
                                 #  girafeOutput('Prop_bubbles'))
                        ),
                        
                        tabPanel(title = 'Centrality Measures', style = 'background-color:#005493',
                                 div(class='outer', align = 'right', tags$head(includeCSS('style/main.css')),
                                     sidebarLayout(
                                       sidebarPanel(
                                         htmlOutput('in_view')
                                       ),
                                       mainPanel(
                                         tabsetPanel(
                                           tabPanel('Degree', girafeOutput('deg_Plt')),
                                           tabPanel('Assortivity', girafeOutput('assort_Plt')),
                                           tabPanel('Betweenness', girafeOutput('bet_Plt')),
                                           tabPanel('Closeness', girafeOutput('clos_Plt'))
                                           
                                         ))))),
                        
                        tabPanel(title = 'Communities', style = 'background-color:#005493',
                                 div(class='outer', align = 'right',
                                     tags$head(includeCSS('style/main.css')),
                                     sidebarLayout(
                                       sidebarPanel(h3('TBD', align = 'left'),
                                                    radioButtons(inputId="PlotLayout", label="Plot Layout", choices=c("Auto","Random","Fruchterman Reingold","Kamada Kawai"), selected="Fruchterman Reingold")),
                                       mainPanel(
                                         tabsetPanel(
                                           tabPanel('TBD', plotOutput("graphPlot")),
                                           tabPanel('TBD'))))))),
             
             navbarMenu(title = 'Dynamic Networks',
                        
                        tabPanel('TBD', style = 'background-color:#005493',
                                 div(class = 'outer', align = 'right',
                                     tags$head(includeCSS('style/main.css')),
                                     sidebarPanel(
                                       h4('Something on the Left Panel'),
                                       h5('MORE on the Left Panel')
                                     ),
                                     mainPanel(
                                       tabsetPanel(
                                         tabPanel('TBD'),
                                         tabPanel('TBD'))))),
                        
                        tabPanel('TBD', style = 'background-color:#005493',
                                 div(class = 'outer', align = 'right',
                                     tags$head(includeCSS('style/main.css')),
                                     sidebarPanel(
                                       h4('More on the Left Panel'),
                                       h4('AND MORE on the Left Panel')),
                                     mainPanel(
                                       tabsetPanel(
                                         tabPanel('TBD'),
                                         tabPanel('TBD')))))),
             
             tabPanel('Study Area Map', style = 'background-color:#005493',
                      div(class='outer', align = 'right',
                          tags$head(includeCSS('style/main.css')),
                          leafletOutput("ok_map", height = "100%", width = '100%'),
                          
                          absolutePanel(id = 'controls', class = 'panel panel-default',
                                        top = 75, left = 10, width = 250, fixed = T,
                                        draggable = T, height = '100%', style = 'color:black',
                                        
                          ),
                          
                          absolutePanel(id = 'controls', class = 'panel panel-default',
                                        top = 75, right = 10, width = 250, fixed = T,
                                        draggable = T, height = '32%', style = 'color:black',
                                        span(tags$strong(h4(textOutput('tot_inter'),align = 'left'))),
                                        tags$hr(),
                                        span(h5(textOutput('cow_cow'),align = 'right'), style = 'color:#458B00'),
                                        span(h5(textOutput('pig_pig'),align = 'right'), style = 'color:#FF6347'),
                                        span(h5(textOutput('deer_deer'),align = 'right'), style = 'color:#996633'),
                                        span(h5(textOutput('cow_pig'),align = 'right'), style = 'color:#333333'),
                                        span(h5(textOutput('cow_deer'),align = 'right'), style = 'color:#333333'),
                                        span(h5(textOutput('pig_deer'),align = 'right'), style = 'color:#333333'))
                      )),
             
             tabPanel('Data Overview',
                      fluidRow(
                        box(
                          dygraphOutput('gantt', width = "100%", height = "400px"), width = 9 ),
                        box(textOutput('legendDivID'), title = 'Active:', collapsible = F, width = 3)
                      )
             )
  ))


server <- function(input, output) {
  makeReactiveBinding('newData')
  makeReactiveBinding('nodes')
  makeReactiveBinding('edges')
  makeReactiveBinding('deg')
  makeReactiveBinding('props')
  
  newData <- reactive({
    input$Update_Click
    isolate({subset_view(x, input$date_range[1], input$date_range[2], input$distance_window, input$time_window)})
  })
  
  edges <- reactive({
    input$Update_Click
    isolate({
      data <- newData()
      edges <- create_edges(data)})})
  
  nodes <- reactive({
    input$Update_Click
    isolate({
      data <- newData()
      nodes <- create_nodes(data)})})
  
  realTimeGraph <- reactive({
    nodes <- nodes()
    edges <- edges()
    g <- graph_from_data_frame(d = edges, vertices = nodes, directed = F)
  })
  
  
  plotGraph <- function(){
    g <- realTimeGraph()
    plotlayout <- switch(input$PlotLayout,
                         "Auto"=layout.auto(g),
                         "Random"=layout.random(g),
                         "Fruchterman Reingold"=layout.fruchterman.reingold(g),
                         "Kamada Kawai"=layout.kamada.kawai(g))
    V(g)$size = deg()*1.3
    V(g)$label <- ''
    clp <- cluster_optimal(g)
    par(bg = '#333333')
    plot(clp, g)
  }
  
  output$graphPlot <- renderPlot({suppressWarnings(plotGraph())})
  
  deg <- reactive({
    input$Update_Click
    isolate({
      edges <- edges()
      nodes <- nodes()
      net <- graph_from_data_frame(d = edges, vertices = nodes, directed = F)
      deg <- degree(net, mode = 'all')})
    return(deg*1.3)})
  
  #graph_stats <- reactive({
  #  input$Update_Click
  #  isolate({
  #    edges <- edges()
  #    nodes <- nodes()
  #    net <- graph_from_data_frame(d = edges, vertices = nodes, directed = F)
  #    diam_all <- diameter(net)
  #    dens_all <- igraph::graph.density(net)
  #    cent_all <- centr_degree(net, mode = 'all', loops = F)
  #    degr_all <- cent_all$centralization
  #    mean_dist_all <- mean_distance(net)
  #    assort_all <- assortativity_degree(net, directed = F)
  
  #    sub_cow <- subgraph(net, v = V(net)[group == 'Cattle'])
  #    sub_pig <- subgraph(net, v = V(net)[group == 'Pigs'])
  #    sub_deer <- subgraph(net, v = V(net)[group == 'Deer'])
  
  #    diam_cow <- diameter(sub_cow)
  #    dens_cow <- igraph::graph.density(sub_cow)
  #    cent_cow <- centr_degree(sub_cow, mode = 'all', loops = F)
  #    degr_cow <- cent_cow$centralization
  #    mean_dist_cow <- mean_distance(sub_cow)
  #    assort_cow <- assortativity_degree(sub_cow, directed = F)
  
  #    diam_pig <- diameter(sub_pig)
  #    dens_pig <- igraph::graph.density(sub_pig)
  #    cent_pig <- centr_degree(sub_pig, mode = 'all', loops = F)
  #    degr_pig <- cent_pig$centralization
  #    mean_dist_pig <- mean_distance(sub_pig)
  #    assort_pig <- assortativity_degree(sub_pig, directed = F)
  
  #    diam_deer <- diameter(sub_deer)
  #    dens_deer <- igraph::graph.density(sub_deer)
  #    cent_deer <- centr_degree(sub_deer, mode = 'all', loops = F)
  #    degr_deer <- cent_deer$centralization
  #    mean_dist_deer <- mean_distance(sub_deer)
  #    assort_deer <- assortativity_degree(sub_deer, directed = F)
  
  #    diam <- rbind(10, -1, diam_all, diam_cow, diam_deer, diam_pig)
  #    dens <- rbind(10, -1, dens_all, dens_cow, dens_deer, dens_pig)
  #    degr <- rbind(10, -1, degr_all, degr_cow, degr_deer, degr_pig)
  #    assort <- rbind(10, -1, assort_all, assort_cow, assort_deer, assort_pig)
  #    mean_dist <- rbind(10, -1, mean_dist_all, mean_dist_cow, mean_dist_deer, mean_dist_pig)
  
  #    graph_lev <- data.frame(Diameter = diam, Density = dens, Degree = degr, Mean_Distance = mean_dist, Asssortivity = assort)
  #    as.data.frame(graph_lev)
  #    })
  #  return(graph_lev)})
  
  vertex_stats <- reactive({
    input$Update_Click
    isolate({
      edges <- edges()
      nodes <- nodes()
      net <- graph_from_data_frame(d = edges, vertices = nodes, directed = F)
      nodes$degree <- degree(net, mode = 'all')
      nodes$assort <- assortativity(net, directed = F)
      nodes$between <- betweenness(net, v = V(net), directed = F)
      nodes$closeness <- closeness(net, v = V(net), mode = 'all')
      eigen <- eigen_centrality(net, directed = F)
      nodes$eigen <- eigen$vector
      nodes$count <- 1
      as.data.frame(nodes)})
    return(nodes)})
  
  output$deg_Plt <- renderGirafe({
    input$Update_Click
    isolate({
      df <- vertex_stats()
      gg_point <- ggplot(df, aes(x = as.factor(group), y = degree, tooltip = group, data_id = group, colour = group)) + geom_boxplot_interactive(fill = c('#458B00','#996633', '#FF6347')) + theme_dark()  + ylab("Vertex Degree Scores")+ xlab("Species") + scale_color_manual(values= c('#458B00','#996633', '#FF6347')) + theme(panel.background = element_blank(), panel.border = element_blank(), legend.position = "none", plot.background = element_rect(fill = "#333333"),axis.title.x = element_text(colour = "white"), axis.title.y = element_text(colour = "white") ,axis.text.x = element_text(colour = "white"), axis.text.y = element_text(colour = "#00B3A3")) + ylim(0, max(df$degree))
      girafe(ggobj = gg_point, options = list(opts_selection(type = 'single', only_shiny = F)))
    })})
  
  output$bet_Plt <- renderGirafe({
    input$Update_Click
    isolate({
      df <- vertex_stats()
      gg_point <- ggplot(df, aes(x = as.factor(group), y = between, tooltip = group, data_id = group, colour = group)) + geom_boxplot_interactive(fill = c('#458B00','#996633', '#FF6347')) + theme_dark()  + ylab("Vertex Betweenness Scores")+ xlab("Species") + scale_color_manual(values= c('#458B00','#996633', '#FF6347')) + theme(panel.background = element_blank(), panel.border = element_blank(), legend.position = "none", plot.background = element_rect(fill = "#333333"),axis.title.x = element_text(colour = "white"), axis.title.y = element_text(colour = "white"),axis.text.x = element_text(colour = "white"), axis.text.y = element_text(colour = "#1A80B3")) + ylim(0, max(df$between))
      girafe(ggobj = gg_point, options = list(opts_selection(type = 'single', only_shiny = F)))})})
  
  output$assort_Plt <- renderGirafe({
    input$Update_Click
    isolate({
      df <- vertex_stats()
      gg_point <- ggplot(df, aes(x = as.factor(group), y = assort, tooltip = group, data_id = group, colour = group)) + geom_boxplot_interactive(fill = c('#458B00','#996633', '#FF6347')) + theme_dark()  + ylab("Vertex Assortivity Degree")+ xlab("Species") + scale_color_manual(values= c('#458B00','#996633', '#FF6347')) + theme(panel.background = element_blank(), panel.border = element_blank(), legend.position = "none", plot.background = element_rect(fill = "#333333"),axis.title.x = element_text(colour = "white"), axis.title.y = element_text(colour = "white"),axis.text.x = element_text(colour = "white"), axis.text.y = element_text(colour = "#6B8D23")) + ylim(0, max(df$assort))
      girafe(ggobj = gg_point, options = list(opts_selection(type = 'single', only_shiny = F)))})})
  
  output$clos_Plt <- renderGirafe({
    input$Update_Click
    isolate({
      df <- vertex_stats()
      gg_point <- ggplot(df, aes(x = as.factor(group), y = closeness, tooltip = group, data_id = group, colour = group)) + geom_boxplot_interactive(fill = c('#458B00','#996633', '#FF6347')) + theme_dark()  + ylab("Vertex Closeness Values")+ xlab("Species") + scale_colour_manual(values= c('#458B00','#996633', '#FF6347')) + theme(panel.background = element_blank(), panel.border = element_blank(), legend.position = "none", plot.background = element_rect(fill = "#333333"), axis.title.x = element_text(colour = "white"), axis.title.y = element_text(colour = "white"),axis.text.x = element_text(colour = "white"), axis.text.y = element_text(colour = "#777788")) + ylim(0, max(df$closeness))
      girafe(ggobj = gg_point, options = list(opts_selection(type = 'single', only_shiny = T)), opts_tooltip(use_fill = F))})})
  
  # output$Prop_bubbles <- renderGirafe({
  #  input$Update_Click
  #  isolate({
  #    sub <- newData()
  #   sub <- aggregate(sub$value, by = list(sub$SPECIES_PAIRS), FUN = sum)
  #    colnames(sub) <- c('group', 'value')
  #    pack <- circleProgressiveLayout(sub$value, sizetype = 'area')
  #    sub <- cbind(sub, pack)
  #    sub$prop <- c(sub$value)/sum(sub$value)
  #    sub$prop <- label_percent()(sub$prop)
  #    sub$text <- paste("Interaction Type: ",sub$group, "\n", "Percentage:", sub$prop)
  #    dat.gg <- circleLayoutVertices(pack, npoints=50)
  #    p <-ggplot() +  geom_polygon_interactive(data = dat.gg, aes(x, y, group = id, fill=id, tooltip = sub$text[id], data_id = id), colour = "black", alpha = 0.6) +  scale_fill_viridis() + geom_text(data = sub, aes(x, y, label = group), size=2, color="black") + theme_void() + theme(legend.position="none", plot.margin=unit(c(0,0,0,0),"cm") ) +  coord_equal()
  #    girafe(ggobj = p, options = list(opts_selection(type = 'single', only_shiny = T)), opts_tooltip(use_fill = F))
  #    })
  # })
  
  props <- reactive({
    input$Update_Click
    isolate({
      ss <- newData()
      ss <- aggregate(ss$value, by = list(ss$SPECIES_PAIRS), FUN = sum)
      colnames(ss) <- c('Type', 'value')
      ss$Proportion <- c(ss$value)/sum(ss$value)
      ss$Proportion <- label_percent()(ss$Proportion)
      as.data.frame(ss)})
    return(ss)})
  
  output$cow_cow <- renderText({
    ss <- props()
    ss <- ss[which(ss$Type == 'Cattle-Cattle'),]
    if(nrow(ss) == 0){
      return(print('Cattle-Cattle: 0.0%'))
    }else{
      paste('Cattle-Cattle:', prettyNum(props()$Proportion[(props()$Type == 'Cattle-Cattle')]))}})
  
  output$pig_pig <- renderText({
    ss <- props()
    ss <- ss[which(ss$Type == 'Pig-Pig'),]
    if(nrow(ss) == 0){
      return(print('Pig-Pig: 0.0%'))
    }else{
      paste('Pig-Pig:', prettyNum(props()$Proportion[(props()$Type == 'Pig-Pig')]))}})
  
  output$deer_deer <- renderText({
    ss <- props()
    ss <- ss[which(ss$Type == 'Deer-Deer'),]
    if(nrow(ss) == 0){
      return(print('Deer-Deer: 0.0%'))
    }else{
      paste('Deer-Deer:', prettyNum(props()$Proportion[(props()$Type == 'Deer-Deer')]))}})
  
  output$cow_pig <- renderText({
    ss <- props()
    ss <- ss[which(ss$Type == 'Cattle-Pig'),]
    if(nrow(ss) == 0){
      return(print('Cattle-Pig: 0.0%'))
    }else{
      paste('Cattle-Pig:', prettyNum(props()$Proportion[(props()$Type == 'Cattle-Pig')]))}})
  
  output$cow_deer <- renderText({
    ss <- props()
    ss <- ss[which(ss$Type == 'Cattle-Deer'),]
    if(nrow(ss) == 0){
      return(print('Cattle-Deer: 0.0%'))
    }else{
      paste('Cattle-Deer:', prettyNum(props()$Proportion[(props()$Type == 'Cattle-Deer')]))}})
  
  output$pig_deer <- renderText({
    ss <- props()
    ss <- ss[which(ss$Type == 'Pig-Deer'),]
    if(nrow(ss) == 0){
      return(print('Pig-Deer: 0.0%'))
    }else{
      paste('Pig-Deer:', prettyNum(props()$Proportion[(props()$Type == 'Pig-Deer')]))}})
  
  output$tot_anim <- renderText({
    paste0(prettyNum(nrow(vertex_stats()), big.mark = ','), ' Total Animals')})
  
  output$tot_cow <- renderText({
    paste0(prettyNum(sum(vertex_stats()$count[(vertex_stats()$group == 'Cattle')]), big.mark = ','), ' Cattle')})
  
  output$tot_pig <- renderText({
    paste0(prettyNum(sum(vertex_stats()$count[(vertex_stats()$group == 'Pigs')]), big.mark = ','), ' Pigs')})
  
  output$tot_deer <- renderText({
    paste0(prettyNum(sum(vertex_stats()$count[(vertex_stats()$group == 'Deer')]), big.mark = ','), ' Deer')})
  
  output$tot_inter <- renderText({
    paste0(prettyNum(nrow(newData()),  big.mark = ','), ' Total Interactions')})
  
  output$avg_deg <- renderText({
    paste0('Degree: ', prettyNum(mean(vertex_stats()$degree), digits = 3))})
  
  output$avg_assort <- renderText({
    paste0('Assortitive Value: ', prettyNum(mean(vertex_stats()$assort), digits = 3))})
  
  output$avg_bet <- renderText({
    paste0('Betweenness: ', prettyNum(mean(vertex_stats()$between), digits = 3))})
  
  output$avg_clos <- renderText({
    paste0('Closeness: ', prettyNum(mean(vertex_stats()$closeness), digits = 3))})
  
  output$ok_map <- renderLeaflet({ok_base})
  
  output$networkPlot <- renderVisNetwork({
    edges <- edges()
    nodes <- nodes()
    nodes$size <- deg()
    
    #output$in_view <- renderText({
    #  paste0("Plots in view are for current static definition of a ", input$distance_window, " meter Spatial Window and a ", input$time_window, ' minute Temporal Window. More specifically, for date views between ', input$date_range[1], ' and ', input$date_range[2], '.')})
    
    output$in_view <- renderUI({
      line1 <- paste0("Plots in view are for a <b style = color:#CCCC33;>", input$distance_window, " meter </b> Spatial Window and <b style = color:#CCCC33;>", input$time_window, " minute</b> Temporal Window definition.")
      line2 <- paste0("<br/> More specifically, for date  between <b style = color:#CCCC33;>", input$date_range[1], "</b> and <b style = color:#CCCC33;>", input$date_range[2], "</b>.")
      HTML(paste(line1, line2, sep = '<br/>'))
    })
    
    output$gantt <- renderDygraph({withProgress(message = "Loading...", {
      
      dygraph(don, main = 'Animal Observations by Week') %>% dyLegend(show = 'onmouseover', hideOnMouseOut = T, labelsDiv = "legendDivID") %>% dyGroup(c('c01', 'c02', 'c03', 'c04', 'c05', 'c06', 'c07', 'c08', 'c09', 'c10', 'c11', 'c12', 'c13', 'c14', 'c15', 'c16', 'c17', 'c18', 'c19', 'c20', 'c21', 'c22', 'c23', 'c24', 'c25', 'c28', 'c29', 'c30', 'c32', 'c33', 'c34', 'c35', 'c36', 'c37', 'c38', 'c39', 'c40', 'c41', 'c42'), color = c('#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00', '#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00', '#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00', '#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00','#458B00')) %>% dyGroup(c('p02', 'p04', 'p07', 'p08', 'p10', 'p11', 'p12', 'p14', 'p15', 'p16', 'p18', 'p20', 'p21', 'p22', 'p24', 'p25', 'p27', 'p28', 'p30', 'p32', 'p33', 'p35', 'p36', 'p38', 'p40', 'p41', 'p44', 'p45', 'p46', 'p47', 'p48', 'p49', 'p50', 'p51', 'p52', 'p53', 'p55', 'p56', 'p57', 'p58', 'p59', 'p60', 'p61', 'p62', 'p64', 'p65', 'p67', 'p68'), color = c('#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347', '#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347', '#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347', '#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347', '#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347','#FF6347')) %>% dyGroup(c('d01', 'd02', 'd03', 'd04', 'd05', 'd06', 'd07', 'd09', 'd10', 'd11', 'd12', 'd13', 'd14', 'd15', 'd16', 'd17', 'd18', 'd19', 'd20', 'd21', 'd22', 'd23', 'd24', 'd25', 'd26', 'd27', 'd28', 'd29', 'd30'), color = c('#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633','#996633')) %>% dyAxis('x', axisLabelColor = 'white')%>% dyAxis('y', axisLabelColor = 'white', valueFormatter = paste0('function(y){return "";}') )%>% dyCSS("style/legend.css") %>% dyAxis('y2', valueFormatter = paste0('function(x){ var KIDS = [',paste(paste0("'", names(don),"'"),collapse=','),']; return KIDS[x - 1]; }') ) %>% dyRangeSelector(fillColor = " #8A2252", strokeColor = "#8A2252", retainDateWindow = T)
    })
    })
    
    #  expr, env = parent.frame(), quoted = FALSE)
    
    visNetwork(nodes, edges, width = '750px', height = "100%", background = '#222222') %>% visGroups(groupname = 'Pigs', color = '#FF6347', shadow = list(enabled = T)) %>% visGroups(groupname = 'Cattle', color = '#458B00', shadow = list(enabled = T))  %>% visGroups(groupname = 'Deer', color = '#CD9B1D', shadow = list(enabled = T)) %>% visInteraction(hover = T) %>%  visOptions(selectedBy = list(variable = "group", style = 'width: 150px; height: 22px; background: white; color: #999933; border:none; outline:none;'), highlightNearest = T, collapse = F) %>% visInteraction(keyboard = TRUE, dragNodes = T, dragView = T, zoomView = T) # %>% visIgraphLayout()
  })}

shinyApp(ui = ui, server = server)
knrg07/NobleNetworks documentation built on July 23, 2020, 12:35 a.m.