diff --git a/panels/richnessB-server.R b/panels/richnessB-server.R index 2cac8ee279f387c91c3992c839a804a75ba3ac68..54c4f89168244f898fb0a7e02b0e546eef7e0f91 100644 --- a/panels/richnessB-server.R +++ b/panels/richnessB-server.R @@ -70,6 +70,70 @@ observeEvent(input$betaHeatmap_output_code, } ) +output$betaNetworkUI <- renderUI({ + validate(need(physeq(), "")) + box( + title = "Setting : " , + width = NULL, + status = "primary", + sliderInput("betaNetworkMax", + label = "Threshold : ", + min = 0, + max = 1, + value = 0.7), + checkboxInput("betaNetworkOrphan", + label = "Keep orphans", + value = TRUE), + textInput("betaNetworkTitle", + label = "Title : ", + value = "Beta diversity network"), + selectInput("betaNetworkCol", + label = "Color : ", + choices = c("..." = 0, sample_variables(physeq()))), + selectInput("betaNetworkShape", + label = "Shape : ", + choices = c("..." = 0, sample_variables(physeq()))), + selectInput("betaNetworkLabel", + label = "Label : ", + choices = c("..." = 0, "Sample name" = "value", sample_variables(physeq()))) + ) +}) + +output$betaNetwork <- metaRender2(renderPlot, { + validate(need(physeq(), "Requires an abundance dataset")) + data <- physeq() + + metaExpr({ + g <- make_network(data, + distance = ..(input$betaDistance), + max.dist = ..(input$betaNetworkMax), + keep.isolates = ..(input$betaNetworkOrphan) + ) + p <- plot_network(g, + physeq = data, + color = ..(checkNull(input$betaNetworkCol)), + shape = ..(checkNull(input$betaNetworkShape)), + label = ..(checkNull(input$betaNetworkLabel)), + hjust = 2, + title = ..(checkNull(input$betaNetworkTitle)) + ) + p + }) +}) + +observeEvent(input$betaNetwork_output_code, + { + displayCodeModal( + expandChain( + quote(library(phyloseq)), + quote(library(phyloseq.extended)), + "# Replace `data` with you own data.", + output$betaNetwork() + ) + ) + } +) + output$betaTable <- renderUI({ validate(need(physeq(), "Requires an abundance dataset")) box( @@ -79,66 +143,3 @@ output$betaTable <- renderUI({ beautifulTable(tibble::rownames_to_column(as.data.frame(round(as.matrix(distance(physeq(), method = input$betaDistance)), digits = 2)), var = "SAMPLE")) ) }) - -# output$networkBUI <- renderUI({ -# validate(need(physeq(), "")) -# box( -# title = "Setting : " , -# width = NULL, -# status = "primary", -# sliderInput( -# "netwMax", -# label = "Threshold : ", -# min = 0, -# max = 1, -# value = 0.7 -# ), -# checkboxInput("netwOrphan", -# label = "Keep orphans", -# value = TRUE), -# textInput("netwTitle", -# label = "Title : ", -# value = "Beta diversity network"), -# selectInput( -# "netwCol", -# label = "Color : ", -# choices = c("..." = 0, sample_variables(physeq())) -# ), -# selectInput( -# "netwShape", -# label = "Shape : ", -# choices = c("..." = 0, sample_variables(physeq())) -# ), -# selectInput( -# "netwLabel", -# label = "Label : ", -# choices = c( -# "..." = 0, -# "Sample name" = "value", -# sample_variables(physeq()) -# ) -# ) -# ) -# }) -# -# output$networkB <- renderPlot({ -# validate(need(physeq(), -# "Requires an abundance dataset")) -# g <- make_network( -# physeq(), -# distance = input$betaDistance, -# max.dist = input$netwMax, -# keep.isolates = input$netwOrphan -# ) -# p <- plot_network( -# g, -# physeq = physeq(), -# color = checkNull(input$netwCol), -# shape = checkNull(input$netwShape), -# label = checkNull(input$netwLabel), -# hjust = 2, -# title = checkNull(input$netwTitle) -# ) -# return(p) -# }) -# diff --git a/panels/richnessB-ui.R b/panels/richnessB-ui.R index c1c5f316f2511de468a8f069b6f20a1358b2425f..ef87673150c96940ff844223d4bc72301afd2142 100644 --- a/panels/richnessB-ui.R +++ b/panels/richnessB-ui.R @@ -2,6 +2,6 @@ betaCluster <- fluidPage(outputCodeButton(withLoader(plotOutput("betaCluster", h uiOutput("betaClusterUI")) betaHeatmap <- fluidPage(outputCodeButton(withLoader(plotOutput("betaHeatmap", height = 700))), uiOutput("betaHeatmapUI")) -betaNetworks <- fluidPage(outputCodeButton(withLoader(plotOutput("betaNetworks", height = 700))), - uiOutput("betaNetworksUI")) +betaNetwork <- fluidPage(outputCodeButton(withLoader(plotOutput("betaNetwork", height = 700))), + uiOutput("betaNetworkUI")) betaTable <- fluidPage(uiOutput("betaTable")) diff --git a/ui.R b/ui.R index b1f011b1c223c1cffbaa6ab4d64f8cd6c6cc823b..4a4a946c727d54121ed2c5e42b940a69dc0a51aa 100644 --- a/ui.R +++ b/ui.R @@ -43,7 +43,7 @@ dashboardHeader(title = "Easy16S"), choices = list("bray", "jaccard", "unifrac", "wunifrac", "dpcoa", "jsd", "euclidean")), menuSubItem("Samples clustering", tabName = "betaCluster"), menuSubItem("Samples heatmap", tabName = "betaHeatmap"), - menuSubItem("Networks", tabName = "betaNetworks"), + menuSubItem("Network", tabName = "betaNetwork"), menuSubItem("Table", tabName = "betaTable") ), menuItem("MultiDimensional Scaling", tabName = "mds", icon = icon("dot-circle")), @@ -61,7 +61,7 @@ dashboardHeader(title = "Easy16S"), tabItem(tabName = "alphaTable", alphaTable), tabItem(tabName = "betaCluster", betaCluster), tabItem(tabName = "betaHeatmap", betaHeatmap), - tabItem(tabName = "betaNetworks", betaNetworks), + tabItem(tabName = "betaNetwork", betaNetwork), tabItem(tabName = "betaTable", betaTable), tabItem(tabName = "mds", mds), tabItem(tabName = "pca", pca),