Selectinput和Action按钮不能按预期工作,只有一个亮点

时间:2018-08-06 06:47:06

标签: r shiny

我的意图是首先从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  
  )

0 个答案:

没有答案