我的意图是首先从Types对象和unit对象的选择中绘制图形,然后从unit和type对象中选择面。我面临的挑战是,当我运行应用程序时,只有一个操作按钮有效,其余的甚至选择都无效。
我有包含不同单位和类型对象的数据。我想运行第一个图是选择单位和类型,然后从两个动作按钮的类型和单位中选择多面图。
我已经附上了一些数据
library(shiny)
library(ggplot2)
library(dplyr)
library(shinycssloaders)
library(DT)
library(feather)
library(reshape2)
library(pander)
suppressMessages(library(dplyr))
library(signal)
library(prospectr)
setwd("path")
#list.files()
#neos <- read.csv("Neospec processed with codes.csv")
#wrt<-write_feather(neos,"path")
#neos<- read_feather("path")
#neos[1:7,1:5]
ui <- fluidPage(
titlePanel("Neospec Visualization"),
sidebarLayout(
sidebarPanel(
#fileInput(inputId = "fls", "Upload Neodata", multiple = F, buttonLabel = "Load file", placeholder = "No file loaded", accept = NULL),
uiOutput("unit"),
uiOutput("Type"),
uiOutput("FaceUnit"),
tags$hr(),
uiOutput("FaceType")
),
mainPanel(
tabsetPanel(
tabPanel("Table", dataTableOutput("table"),6),
h3("Data table view"),
#withSpinner(DT::dataTableOutput("contents"),6),
#dataTableOutput("tt"),
h3("Raw Neospec signatures"),
withSpinner(plotOutput("plts"),6)
)
)
)
)
server <- function(input, output){
options(shiny.maxRequestSize=150*1024^2)
#upld.dt<- reactive({
#inFile <- input$fls
#if (is.null(inFile))
#return(NULL)
#all.spec<-read.csv(inFile$datapath)
#all.spec
#})
neos <- reactive({read_feather("path")})
#########Ui to select Units and type#############################
output$unit <- renderUI({
selectInput(inputId = "unit", label = "Select Unit", choices = as.vector(unique(neos()$unit)), selected = NULL)
})
output$Type <- renderUI({
selectInput(inputId = "Type", label = "Select Type", choices = as.vector(unique(neos()$Type)), selected = NULL)
})
output$FaceUnit <- renderUI({
actionButton(inputId = "FaceUnit", label = " Unit", choices = as.vector(unique(neos()$FaceUnit)))
})
output$FaceType <- renderUI({
actionButton(inputId = "FaceType", label = " Type", choices = as.vector(unique(neos()$FaceType)))
})
#########################Subset data by stds##########################
sbst.unt<-reactive({
neodt<-neos()
unt.sbst <- neodt[(neodt$unit==input$unit & neodt$Type==input$Type),]
unt.sbst
})
output$table <- renderDataTable({sbst.unt()})
###Plot by selection of Unit and Type ################################
output$plts <- renderPlot({
plt.dt <- sbst.unt()
wavelength<-as.numeric(substr(colnames(plt.dt[,-c(1:3)]),2,19))
colnames(plt.dt) <- c("SSN","unit","Type",wavelength)
spec.m <- melt(plt.dt, id = c("SSN","unit","Type"))
p <- ggplot(data =spec.m , aes(x = as.numeric(as.vector(variable)),y = value, group = SSN)) +
geom_line(size = 0.1, col = "blue", alpha = 0.8) +
ggtitle("Neospec raw spectrums ") +
xlim(range(wavelength))+
ylim(c(0,1)) +
xlab("Wavelength (nm)") +
ylab("Reflectance") +
#theme with white background
theme_bw() +
#eliminates background, gridlines, and chart border
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 + theme(legend.position = "none")
p
})
###Plot by Action button of Type #################################
sbst.unt<-reactive({
neodt <- neos()
unt.sbst <- neodt[(neodt$unit==input$unit & neodt$Type==input$Type),]
unt.sbst
})
output$table <- renderDataTable({
sbst.unt()
})
# here you react off the FaceType button
plotdata <- eventReactive(input$FaceType,{
req(input$FaceType)
neos()
})
output$plts <- renderPlot({
plt.dt2 <- plotdata()
wavelength2 <- as.numeric(substr(colnames(plt.dt2[,-c(1:3)]),2,19))
colnames(plt.dt2) <- c("SSN","unit","Type",wavelength2)
spec.m2 <- melt(plt.dt2, id = c("SSN","unit","Type"))
p2 <- ggplot(data = spec.m2 , aes(x = as.numeric(as.vector(variable)),y = value, group = SSN)) +
geom_line(size = 0.1, col = "blue", alpha = 0.8) +
ggtitle("Neospec raw spectrums ") +
xlim(range(wavelength2))+
ylim(c(0,1)) +
xlab("Wavelength (nm)") +
ylab("Reflectance") +
#theme with white background
theme_bw() +
#eliminates background, gridlines, and chart border
theme(
plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank())
p2 <- p2 + theme(plot.title = element_text(hjust = 0.5))
p2 <- p2 + theme(legend.position = "none")
fac.typ <- p2 + facet_grid(.~Type, switch ='y', scales = "free")
fac.typ
})
###Plot by Action button of unit ##################################
sbst.unt<-reactive({
neodt <- neos()
unt.sbst <- neodt[(neodt$unit==input$unit & neodt$Type==input$Type),]
unt.sbst
})
output$table <- renderDataTable({
sbst.unt()
})
# here you react off the FaceType button
plotdata <- eventReactive(input$Faceunit,{
req(input$Faceunit)
neos()
})
output$plts <- renderPlot({
plt.dt2 <- plotdata()
wavelength2 <- as.numeric(substr(colnames(plt.dt2[,-c(1:3)]),2,19))
colnames(plt.dt2) <- c("SSN","unit","Type",wavelength2)
spec.m2 <- melt(plt.dt2, id = c("SSN","unit","Type"))
p2 <- ggplot(data = spec.m2 , aes(x = as.numeric(as.vector(variable)),y = value, group = SSN)) +
geom_line(size = 0.1, col = "blue", alpha = 0.8) +
ggtitle("Neospec raw spectrums ") +
xlim(range(wavelength2))+
ylim(c(0,1)) +
xlab("Wavelength (nm)") +
ylab("Reflectance") +
#theme with white background
theme_bw() +
#eliminates background, gridlines, and chart border
theme(
plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank())
p2 <- p2 + theme(plot.title = element_text(hjust = 0.5))
p2 <- p2 + theme(legend.position = "none")
fac.unit <- p2 + facet_grid(.~unit, switch ='y', scales = "free")
fac.unit
})
}
shinyApp(ui = ui, server = server)
dput(
SSN unit Type X2600.000003874302 X2597.4609457191823 X2594.926835544204
RResmicro1g3SI1 Unit1 soil 0.37285368 0.364537573 0.356995724
RResmicro1g3SI1 Unit2 soil 0.295855514 0.292268904 0.289343551
RResmicro1g3SI1 Unit3 soil 0.296041336 0.294366508 0.292749726
RResmicro1mSGe2 Unit1 soil 0.387475087 0.38768638 0.387886013
RResmicro1mSGe2 Unit2 soil 0.428004392 0.42284043 0.41852246
RResmicro1mSGe2 Unit3 soil 0.422322559 0.419495941 0.416767303
RresMicro1mtHj Unit1 dung 0.458153765 0.456678695 0.455340966
RresMicro1mtHj Unit2 dung 0.429987543 0.429523389 0.429238502
)