用当前选中的框替换上一个图

时间:2018-08-20 09:17:14

标签: r shiny

您好,在这个闪亮的图表中,在我选中了所需的复选框之后,输出图形就会显示出来。现在,它可以很好地与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)

0 个答案:

没有答案