您好,在这个闪亮的图表中,在我选中了所需的复选框之后,输出图形就会显示出来。现在,它可以很好地与condionalPanel
一起使用,唯一的挑战是我希望此图表以2列的网格格式进行组织,然后当我选中和取消选中复选框时,它应该很灵活。这是一长列复选框,为什么我不希望这些图像conditionalPanel
那样垂直显示。我希望这些图以网格格式显示,那么如果我取消选中第一个复选框,该图将消失并且其位置将替换为当前情节。
代码如下:
UI.R
library(shiny)
library(shinythemes)
library(ggplot2)
library(dplyr)
library(shinycssloaders)
library(feather)
library(reshape2)
library(pander)
library(downloader)
library(soil.spec)
library(prospectr)
library(reshape)
library(baseline)
setwd("path")
ui <- fluidPage(
theme = shinytheme("cerulean"),
cols<- brewer.pal(3, "BuGn"),
titlePanel("Preprocessing Methods"),
navbarPage("Infrared Spectral Processing Methods",
tabPanel("Read OPUS files"),
navbarMenu("Exploratory Analysis",
tabPanel("Item A"),
tabPanel("Item B")),
navbarMenu("Data quality Control",
tabPanel("Item A"),
tabPanel("Item B")),
navbarMenu("Tools",
tabPanel("Item A"),
tabPanel("Item B")),
tabPanel("Calibration"),
tabPanel("Infrared_Prediction"),
sidebarLayout(
sidebarPanel(
fileInput(inputId = "fls", "Choose CSV File", multiple = F, buttonLabel = "Browse", placeholder = "No file loaded", accept = NULL),
#tags$hr(),
uiOutput("Raw"),
uiOutput("SG"),
#tags$hr(),
uiOutput("MSC"),
uiOutput("SNV"),
uiOutput("SNVDetrend"),
uiOutput("Baseline")
),
mainPanel(
#splitLayout(cellWidths = c("50%", "50%"),
conditionalPanel(
condition = "input.Raw",
withSpinner(plotOutput("plts"))
),
conditionalPanel(
condition = "input.Savitzky",
withSpinner(plotOutput("plts1"))
),
conditionalPanel(
condition = "input.MSC",
withSpinner(plotOutput("plts2"))
),
conditionalPanel(
condition = "input.SNV",
withSpinner(plotOutput("plts3"))
),
)) )
)
**server.r**
server <- function(input, output){
# Begin by downloading the demo data
download("path", "Spectral_preprocessing.zip", mode="wb")
unzip("Spectral_preprocessing.zip")
# 0. raw spectra
#spectra <- read.csv("./Spectral_preprocessing/Alpha_ZnSe spectra.csv")
output$Raw <- renderUI({
checkboxInput("Raw", label = "Raw Plot", value = FALSE)
})
output$SG <- renderUI({
checkboxInput("Savitzky", label = "Savitzky-Golay first derivative", value = FALSE)
})
output$MSC <- renderUI({
checkboxInput("MSC", label = "Multiplicate Scatter Correction", value = FALSE)
})
output$SNV <- renderUI({
checkboxInput("SNV", label = "Standard Normal Variate", value = FALSE)
})
output$SNVDetrend <- renderUI({
checkboxInput("SNVDetrend", label = "SNV + Detrending", value = FALSE)
})
output$Baseline <- renderUI({
checkboxInput("Baseline", label = "Baseline Correction", value = FALSE)
})
spectra0 <- read.csv("./Spectral_preprocessing/Alpha_ZnSe spectra.csv")
# here you react off the FaceType button
plotdata <- eventReactive(input$Raw,{
req(input$Raw)
spectra0
})
#observe({edit(print( plotdata()))})
########Raw Spectra #######
# Visualize raw and the preprocessed spectra
output$plts <- renderPlot({
input$Raw
plt.dt <- plotdata()
colnames(spectra0) <- colnames(spectra0) # To insert back the prefix removed before pre-procesing
all <- spectra0
all$method <- rep("0. Raw",nrow(spectra0))
wavenumbers <- as.numeric(substr(colnames(all[,-c(1,ncol(all))]),2,19))
colnames(all) <- c("SSN",wavenumbers,"method")
spec <- melt(all, id.vars = c("SSN","method"))
specr <- subset(spec, method == "raw")
p <- ggplot(data = spec, aes(x = as.numeric(as.vector(variable)),y = as.numeric(as.vector(value)),group = SSN, col = method)) +
#scale_colour_brewer("Red")+
geom_line(size = 0.14, alpha = 0.6, fill="#FF9999", colour="Blue") +
ggtitle("Raw spectra Plot") +
xlab(expression("Wavenumbers cm"^-1)) +
xlim(rev(range(wavenumbers))) +
ylab("Absorbance") +
theme_bw() +
theme(plot.title = element_text(family = "Trebuchet MS", color="#666666", face="bold", size=20)) +
theme(axis.title = element_text(family = "Trebuchet MS", color="#666666", face="bold", size=18)) +
theme(
plot.background = element_blank()
,panel.grid.major = element_blank()
,panel.grid.minor = element_blank()
)
p <- p + theme(plot.title = element_text(hjust =0.5))
#p <- p + facet_wrap(~method, strip.position ='top', scales = "free") + theme(legend.position = "none")
p + theme(legend.position = "none")
})
#1. First derivative spectra
########################################################################################################
spectra <- read.csv("./Spectral_preprocessing/Alpha_ZnSe spectra.csv")
wavenumbers <- as.numeric(substr(colnames(spectra[,-1]),2,19))
#Rename colnames of spectra table
colnames(spectra) <- c("SSN", wavenumbers)
# Make the spectra table as matrix
spectra <- as.matrix(spectra)
derivative <- trans(spectra[,-1])$trans # uses trans function from soil.spec
# Add SSN
derivative <- as.data.frame(cbind(as.vector(spectra[,1]),derivative))
# here you react off the FaceType button
plotdata2 <- eventReactive(input$Savitzky,{
req(input$Savitzky)
derivative
})
#output$table <- renderDataTable({plotdata2()})
# Visualize raw and the preprocessed spectra
output$plts1 <- renderPlot({
input$Savitzky
plt.dt <- plotdata2()
#observe({edit(print(plt.dt()))})
colnames( plt.dt) <- colnames(spectra) # To insert back the prefix removed before pre-procesing
#all <- rbind(spectra, derivative)
#all <- rbind(spectra, derivative)
plt.dt$method <- rep("1. Sgolay First Derivative",nrow(spectra))
wavenumbers <- as.numeric(substr(colnames(plt.dt[,-c(1,ncol(plt.dt))]),1,19))
colnames(plt.dt) <- c("SSN",wavenumbers,"method")
spec <- melt(plt.dt, id.vars = c("SSN","method"))
specr <- subset(spec, method == "Sgolay First Derivative")
p1 <- ggplot(data = spec, aes(x = as.numeric(as.vector(variable)),y = as.numeric(as.vector(value)),group = SSN, col = method)) +
geom_line(size = 0.14, alpha = 0.6) +
ggtitle("Savitzky-Golay first derivative") +
xlab(expression("Wavenumbers cm"^-1)) +
xlim(rev(range(wavenumbers))) +
ylab("Absorbance") +
theme_bw() +
theme(plot.title = element_text(family = "Trebuchet MS", color="#666666", face="bold", size=20)) +
theme(axis.title = element_text(family = "Trebuchet MS", color="#666666", face="bold", size=18)) +
theme(
plot.background = element_blank()
,panel.grid.major = element_blank()
,panel.grid.minor = element_blank()
)
p1 <- p1 + theme(plot.title = element_text(hjust =0.5))
#p <- p + facet_wrap(~method, strip.position ='top', scales = "free") + theme(legend.position = "none")
p1 + theme(legend.position = "none")
})
}
shinyApp(ui = ui, server = server)