r - Selectinput 和 Action 按钮没有按预期工作，只有一个在闪亮的地块

Question

我的意图是首先从类型对象和单元对象的选择中绘制图形，然后是多面单元和类型对象，我面临的挑战是当我运行应用程序时，只有一个操作按钮有效，其余的甚至选择都不起作用。

我有具有不同单位和类型对象的数据。我想如果我运行第一个图是选择单位和类型，然后从两个动作按钮类型和单位中选择分面图。

我附上了一些数据

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  
  )

标签： rshiny