Skip to content
Permalink
main
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?

uNetwork/shiny_uNetwork.R

Go to file
 
 
Cannot retrieve contributors at this time
386 lines (281 sloc) 8.65 KB
Raw Blame
Open in GitHub Desktop
rm(list=ls(envir = .GlobalEnv), envir = .GlobalEnv)
library(magrittr)
library(tidyverse)
library(igraph)
library(shiny)
library(shinythemes)
library(Matrix)
library(readxl)
library(enviPat)
data("isotopes")
dir1 <- "Scripts"
for (f in list.files(dir1, pattern = "\\.R$")) {
source(file.path(dir1, f))
}
# source("Scripts/make_network.R")
# source("Scripts/delta_list.R")
# source("Scripts/network_plotter.R")
# source("Scripts/calc_layout.R")
# source("Scripts/network_bipartite.R")
# source("Scripts/convert_to_adjacency.R")
#
assign("colours1", colours() %>% keep(!grepl("^gr[ea]y", .) & !grepl("[0-9]$", .)) %>% sort(), envir = .GlobalEnv)
ui <-
fluidPage(
title = "Feature matrix plotter",
sidebarLayout(
sidebarPanel(
h4("Inputs"),
br(),
tabsetPanel(
tabPanel(
title = "Cluster",
br(),
uiOutput("select_cluster")
),
tabPanel(
title = "Nodes",
br(),
sliderInput(
inputId = "node_size1",
label = "Node size",
value = 10,
min = 1,
step = 1,
max = 20
),
selectizeInput(
inputId = "node_colour_var",
label = "Choose node colour variable",
choices = c("adduct", "gain_loss"),
selected = c("adduct", "gain_loss")[1],
multiple = F,
width = "200px"
)
), # end node
tabPanel(
title = "Edges",
br(),
sliderInput(
inputId = "edge_size",
label = "Edge size (thickness)",
value = 1,
min = 0.5,
step = 0.5,
max = 5
),
selectizeInput(
inputId = "edge_colour_var",
label = "Choose node colour variable",
choices = c("Signature", "COR"),
selected = c("Signature", "COR")[1],
multiple = F,
width = "200px"
)
), # end edge
tabPanel(
title = "Label",
br(),
radioButtons(
inputId = "show_text",
label = "Show labels",
choices = c("yes", "no"),
selected = "yes",
inline = T
),
sliderInput(
inputId = "text_size",
label = "Label size",
value = 5,
min = 1,
step = 0.5,
max = 10
),
selectizeInput(
inputId = "text_var",
label = "Choose node colour variable",
choices = c("FEATURE_ID", "name2"),
selected = "name2",
multiple = F,
width = "200px"
),
selectizeInput(
inputId = "text_colour",
label = "Label colour",
choices = colours1,
selected = "black",
multiple = F,
width = "200px"
)
), # end text
tabPanel(
title = "Canvas",
br(),
sliderInput(
inputId = "plot_width",
label = "Plot width (pixels)",
value = 600,
min = 500,
step = 100,
max = 1500
),
sliderInput(
inputId = "plot_height",
label = "Plot height (pixels)",
value = 600,
min = 500,
step = 100,
max = 1500
)
), # end canvas
tabPanel(
title = "Pdf",
br(),
sliderInput(
inputId = "plot_width_cm",
label = "Pdf plot widht (cm)",
value = 12,
min = 10,
step = 1,
max = 20
),
sliderInput(
inputId = "plot_height_cm",
label = "Pdf plot height (cm)",
value = 12,
min = 10,
step = 1,
max = 20
),
br(),
downloadButton("download_plot", "Save plot as pdf")
), # end pdf
tabPanel(
title = "Layout",
br(),
# selectizeInput(
# inputId = "layout_method",
# label = "Igraph layout algorithm",
# choices = igraph_layout_algos,
# selected = "layout_nicely",
# multiple = F,
# width = "200px"
# ),
br(),
# fileInput(
# inputId = "matrix_infile",
# label = "Upload feature matrix"
# ),
br(),
actionButton("recalc_layout", "Recalculate layout")
) # end layout
)
),
mainPanel(
br(),
uiOutput("main_header"),
br(),
uiOutput("bipartite_plot_wrapper"),
br(),
tableOutput("plot_click")
)
)
)
server <- function(input, output, session) {
my_plot <- reactiveValues()
my_data <- readRDS("data20.RDS")
output$select_cluster <- renderUI({
req(my_data)
ch <- names(my_data)
nm <- sprintf("%s (%s)", ch, map_int(my_data, ~nrow(.x$node)))
map_int(my_data, ~nrow(.x$node))
selectizeInput(
inputId = "cluster",
label = "Choose cluster",
choices = ch %>% set_names(nm),
selected = ch[1],
multiple = F,
width = "200px"
)
})
observeEvent(
input$cluster,
{
my_plot$data <- my_data[[input$cluster]]
}
)
output$bipartite_plot_wrapper <- renderUI({
plotOutput(
"bipartite_plot",
click = "plot_click",
dblclick ="plot_dbl_click",
hover = "plot_hover",
brush = "plot_brush",
height = ifelse(is.null(input$plot_height), 600, input$plot_height),
width = ifelse(is.null(input$plot_width), 600, input$plot_width)
)
})
output$bipartite_plot <- renderPlot({
req(my_plot$data)
my_plot$gg <-
gg_network_plotter(
my_plot$data,
node_size1 = input$node_size1,
node_colour_var = input$node_colour_var,
show_text = input$show_text == "yes",
text_colour_var = input$text_var,
text_size = input$text_size,
text_colour = input$text_colour,
edge_colour_var = input$edge_colour_var,
edge_size = input$edge_size
)
my_plot$gg
})
output$plot_click <- renderTable({
req(input$plot_click)
nearPoints(
my_plot$data$node,
input$plot_click,
maxpoints = 1,
threshold = 300
)
})
# observeEvent(
# input$plot_dbl_click,
# {
# my_plot$highlight_nodes <- NA
# })
output$plot_hover <- renderTable({
req(input$plot_hover)
nearPoints(
my_plot$data$node,
input$plot_hover,
maxpoints = 1,
threshold = 100
)
})
output$download_plot <- downloadHandler(
filename = "unetwork_plot.pdf",
content = function(file) {
ggsave(file, height = input$plot_height_cm, width = input$plot_width_cm, units = "cm")
}
)
onStop(function() {
env = parent.env(environment())
ls(envir = env) %>%
## .. excluding e.g. session" and "output"
setdiff(c("session", "output", "my_pref_update")) %>%
## object in a list
mget(envir = env) %>%
## keep only reactive values
subset(., subset = sapply(., is.reactivevalues)) %>%
## convert reactive values
sapply(function(z) isolate(reactiveValuesToList(z)), simplify=F) %>%
## assign to global environment
list2env(envir = .GlobalEnv)
cat("Session stopped\n")
cat("Type `save(list=ls(), file='tmp.RData')` to save state variables in your current working directory\n")
cat("Find out what current working directory by typing `getwd()`\n")
})
}
shinyApp(ui, server)