Выход Shiny Plotly, который меняется в зависимости от условий - PullRequest
0 голосов
/ 24 июня 2018

Я пытаюсь сделать блестящее приложение для удобного для пользователя анализа данных, которые у меня есть, и я хотел бы изменить выводимый график Plotly в зависимости от того, какой файл я смотрю. По сути, я хотел бы, чтобы за один раз выводился один график, где я могу циклически проходить несколько графиков (которые не меняются в моем блестящем приложении) в зависимости от того, какую папку и критерии я использую. В настоящее время я борюсь с этим, и я не знаю точно, что делать отсюда. Я приложил несколько изображений, чтобы уточнить, что я имею в виду и что я хочу.

Эта фотография показывает мой пользовательский интерфейс и то, как я хочу, чтобы мои цифры отображались. Мне бы хотелось, чтобы все цифры отображались в одном и том же месте в зависимости от выбранного файла. This photo shows my UI and how I want my figures to be displayed. I'd like all figures to show in that same location, depending on the selected file.

Когда я переключаюсь на «Регистратор данных», генерируется новый график, который выводится ниже первого. Я бы хотел, чтобы он был помещен поверх него, в том же месте. When I switch to 'Datalogger', a new plot is generated, and it is outputted below the first one. I'd like it to be placed on top of it, in the exact same location.

Любая помощь, которую вы можете предложить, будет очень кстати.

Лучший, Т.

Сценарий:

# Load packages
library(shiny)
library(shinythemes)
library(dplyr)
library(readr)
library(lubridate)
library(plotly)

#picarro
time = as.character(seq(as.POSIXct("2018-06-01 12:00:00"), as.POSIXct("2018-06-01 12:10:00"), by=seconds() )); ch4.corr = runif(length(time), 1980, 2000);
data = data.frame(time, ch4.corr); data$time = as.POSIXct(time); 
#datalogger
time = as.character(seq(as.POSIXct("2018-06-01 12:00:00"), as.POSIXct("2018-06-01 12:10:00"), by=seconds() )); PressureOut = runif(length(time), 1010, 1020);
dlog = data.frame(time, PressureOut); dlog$time = as.POSIXct(time);
#dronelog
time = as.character(seq(as.POSIXct("2018-06-01 12:00:00"), as.POSIXct("2018-06-01 12:10:00"), by=seconds() ));
ulog = data.frame(time); ulog$time = as.POSIXct(time);

#------------------------------------------------------------------------------
ui <- fluidPage(
   titlePanel("Active AirCore analysis"),
   hr(),
   fluidRow(
      column(3,
             radioButtons("fileInput", "File",
                          choices = c("Picarro", "Datalogger", "Dronelog"),
                          selected = "Picarro"),
             hr(),
             conditionalPanel(
                condition = "input.fileInput == 'Picarro'",
                sliderInput("timeInputPicarro", "Time", as.POSIXct(data$time[1]), as.POSIXct(data$time[length(data$time)]), c(as.POSIXct(data$time[1])+minutes(1), as.POSIXct(data$time[length(data$time)])-minutes(1)), timeFormat = "%H:%M:%S", ticks = T, step = seconds(1), pre = "")),
             conditionalPanel(
                condition = "input.fileInput == 'Datalogger'",
                sliderInput("timeInputDatalogger", "Time", as.POSIXct(dlog$time[1]), as.POSIXct(dlog$time[length(dlog$time)]), c(as.POSIXct(dlog$time[1]), as.POSIXct(dlog$time[length(dlog$time)])), timeFormat = "%H:%M:%S", ticks = T, step = seconds(1), pre = "")),
             conditionalPanel(
                condition = "input.fileInput == 'Dronelog'",
                sliderInput("timeInputDronelog", "Time", as.POSIXct(ulog$time[1]), as.POSIXct(ulog$time[length(ulog$time)]), c(as.POSIXct(ulog$time[1])+minutes(1), as.POSIXct(ulog$time[length(ulog$time)])-minutes(1)), timeFormat = "%H:%M:%S", ticks = T, step = seconds(1), pre = "")),
             hr(),
             conditionalPanel(
                condition = "input.fileInput == 'Picarro'",
                radioButtons("picarroPlotInput", "Plot type",
                             choices = c("Time-series", "Process"),
                             selected = "Time-series")),
             conditionalPanel(
                condition = "input.fileInput == 'Datalogger'",
                radioButtons("dataloggerPlotInput", "Plot type",
                             choices = c("Time-series", "Altitude"),
                             selected = "Time-series")),
             hr(),
             checkboxGroupInput(inputId='sidebarOptions', 
                                label=('Options'),
                                choices=c('Blabla', 'Store data', 'BlablaBla')),
             hr()),
      br(),

      mainPanel(
         plotlyOutput("dataplot"),
         hr(),
         plotlyOutput("dlogplot")
      )
   )
)

server <- function(input, output, session) {

   datasetInputPic <- reactive({ data = data;  })
   datasetInputPicSamp <- reactive({ dat = data[(data$time>=input$timeInputPicarro[1]) & (data$time<=input$timeInputPicarro[2]),]; })
   datasetInputDatalogger <- reactive({ dlog = dlog })
   datasetInputDronelog <- reactive({ ulog = ulog })

   output$dataplot <- renderPlotly({
      if( (input$fileInput == 'Picarro' ) & (input$picarroPlotInput == 'Time-series')){
         data = datasetInputPic();
         data$time = as.POSIXct(data$time);
         dat = datasetInputPicSamp();
         dat$time = as.POSIXct(dat$time);

         sec.col = "red";
         f = list(size = 8);

         x <- list(title = " ")
         y <- list(title = "CH<sub>4</sub> [ppb]")
         p2 = plot_ly() %>%
            add_trace(data = data,
                      x = ~time,
                      y = ~ch4.corr,
                      type = 'scatter',
                      mode = "markers",
                      marker = list(size = 3, color = 'black')) %>%
            add_trace(data = dat,
                      x = ~time,
                      y = ~ch4.corr,
                      type = 'scatter',
                      mode = "markers",
                      marker = list(size = 3, color = sec.col)) %>%
            layout(xaxis = x, yaxis = y, title = '', showlegend = F, titlefont = f);

         s1 = subplot(p2, margin = 0.06,nrows=1,titleY = TRUE) %>%
            layout(showlegend = F, margin = list(l=50, r=0, b=50, t=10), titlefont = f);
         s1
      }
   })
   output$dlogplot <- renderPlotly({
      if( (input$fileInput == 'Datalogger' ) & (input$dataloggerPlotInput == 'Time-series')){
         data = datasetInputDatalogger();
         data$time = as.POSIXct(data$time);

         x <- list(title = " ")
         y <- list(title = "Outside pressure [mbar]")
         p1 = plot_ly() %>%
            add_trace(data = data, 
                      y = ~PressureOut, 
                      x = ~time, 
                      type = 'scatter',
                      mode = "markers",  
                      marker = list(size = 3, color = 'black'));

         s1 = subplot(p1, margin = 0.07, nrows=2, titleY = TRUE, titleX = FALSE)
         layout(s1, showlegend = F, margin = list(l=100, r=100, b=0, t=100), title = "Datalogger data")
         s1
      }
   })

   outputOptions(output, c("dataplot", "dlogplot"), suspendWhenHidden = TRUE)
}

runApp(list(ui = ui, server = server))

1 Ответ

0 голосов
/ 24 июня 2018

Ваша проблема в том, что в вашем пользовательском интерфейсе вы написали:

mainPanel(
     plotlyOutput("dataplot"),
     hr(),
     plotlyOutput("dlogplot")
  )

Используя эту структуру, «dlogplot» всегда будет отображаться ниже «dataplot», потому что вы, по сути, дали ему свою собственную позицию в главномпанель, которая находится ниже «датаплота».Одним из решений, если вы хотите, чтобы графики отображались в одном и том же точном месте при нажатии различных кнопок, является предоставление только одной plotlyOutput.Далее вы должны поставить условные if, else if и else в renderPlotly.Например:

   output$dataplot <- renderPlotly({
  if( (input$fileInput == 'Picarro' ) & (input$picarroPlotInput == 'Time-series')){
     data = datasetInputPic();
     data$time = as.POSIXct(data$time);
     dat = datasetInputPicSamp();
     dat$time = as.POSIXct(dat$time);

     sec.col = "red";
     f = list(size = 8);

     x <- list(title = " ")
     y <- list(title = "CH<sub>4</sub> [ppb]")
     p2 = plot_ly() %>%
        add_trace(data = data,
                  x = ~time,
                  y = ~ch4.corr,
                  type = 'scatter',
                  mode = "markers",
                  marker = list(size = 3, color = 'black')) %>%
        add_trace(data = dat,
                  x = ~time,
                  y = ~ch4.corr,
                  type = 'scatter',
                  mode = "markers",
                  marker = list(size = 3, color = sec.col)) %>%
        layout(xaxis = x, yaxis = y, title = '', showlegend = F, titlefont = f);

     s1 = subplot(p2, margin = 0.06,nrows=1,titleY = TRUE) %>%
        layout(showlegend = F, margin = list(l=50, r=0, b=50, t=10), titlefont = f);
     s1
  }
 else if( (input$fileInput == 'Datalogger' ) & (input$dataloggerPlotInput == 'Time-series')){
     data = datasetInputDatalogger();
     data$time = as.POSIXct(data$time);

     x <- list(title = " ")
     y <- list(title = "Outside pressure [mbar]")
     p1 = plot_ly() %>%
        add_trace(data = data, 
                  y = ~PressureOut, 
                  x = ~time, 
                  type = 'scatter',
                  mode = "markers",  
                  marker = list(size = 3, color = 'black'));

     s1 = subplot(p1, margin = 0.07, nrows=2, titleY = TRUE, titleX = FALSE)
     layout(s1, showlegend = F, margin = list(l=100, r=100, b=0, t=100), title = "Datalogger data")
     s1
  }
})

Этот код поместит «dlogplot» и «dataplot» в одну и ту же позицию на главной панели.(Вам также необходимо избавиться от output$dlogplot <- renderPlotly({...}), чтобы он не пытался составить этот сюжет.)

Попробуйте и посмотрите, работает ли он для ваших целей.

...