微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

是否可以隐藏 titlePanel 功能?

如何解决是否可以隐藏 titlePanel 功能?

是否可以在 Shiny 中创建隐藏的 titlePanel 功能?完美的输出是:

  1. 具有隐藏功能(红色箭头)的仪表板存在但未激活。在这种情况下是正常的仪表板认演示。

enter image description here

  1. 具有隐藏功能(红色箭头)的仪表板已激活。但在这种情况下,titlePanel 被隐藏以增加绘图区域。

enter image description here

我的示例代码是:

library(leaflet)
library(leaflet.providers)
library(ggplot2)
library(shinythemes)
library(sf)
library(lubridate)
library(dplyr)
library(rgdal)
library(rgeos)

# get AOI
download.file(
  "https://github.com/Leprechault/trash/raw/main/stands_example.zip",zip_path <- tempfile(fileext = ".zip")
)
unzip(zip_path,exdir = tempdir())

# Open the files
setwd(tempdir())
stands_extent <- readOGR(".","stands_target") # Border
stands_ds <- read.csv("pred_target_stands.csv",sep=";") # Data set
stands_ds <- stands_ds %>%
  mutate(DATA_S2 = ymd(DATA_S2))
stands_ds$CLASS<-c(rep("A",129),rep("B",130)) 
stands_ds$CD<-abs(rnorm(length(stands_ds[,1]),mean=50))

# Create the shiny dash
ui <- fluidPage(
  theme = shinytheme("cosmo"),titlePanel(title="My Map Dashboard"),sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "selectedvariable0",label = "Type",choices = c(unique(stands_ds$pest)),selected = TRUE ),selectInput(inputId = "selectedvariable1",label = "Date",choices = c(unique(stands_ds$DATA_S)),selectInput(inputId = "selectedvariable2",label = "Project",choices = c(unique(stands_ds$PROJeto)),selectInput(inputId = "selectedvariable3",label = "Stand",choices = c(unique(stands_ds$CD_TALHAO)),selected = TRUE),selectInput(inputId = "selectedvariable4",label = "Unique ID",choices = c(unique(stands_ds$ID_UNIQUE)),selectInput(inputId = "selectedvariable5",label = "Class",choices = c(unique(stands_ds$CLASS)),selected = TRUE)            
    ),mainPanel(
      textoutput("idSaida"),fluidRow(
        splitLayout(plotOutput("myplot"))),dateInput(inputId = "Dates selection",label = "Time"),leafletoutput("map") 
    )
  )
)
server <- function(input,output){
  
  currentvariable0 <- reactive({input$selectedvariable0})
  currentvariable1 <- reactive({input$selectedvariable1})
  currentvariable2 <- reactive({input$selectedvariable2})
  currentvariable3 <- reactive({input$selectedvariable3})
  currentvariable4 <- reactive({input$selectedvariable4})
  currentvariable5 <- reactive({input$selectedvariable5})
  
  observe({ 
    if(currentvariable5()=="A"){
      
      
      output$myplot <- renderPlot({
        
        #Subset stand
        stands_sel <- subset(stands_extent,stands_extent@data$ID_UNIQUE==currentvariable4())
        
        #Subset for input$var and assign this subset to new object,"fbar"
        ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
        
        #Create a map
        polys <- st_as_sf(stands_sel)
        ggplot() +
          geom_sf(data=polys) +
          geom_point(data=ds_sel,aes(x=X,y=Y),color="red") +
          xlab("Longitude") + ylab("Latitude") +
          coord_sf() +
          theme_bw() +
          theme(text = element_text(size=10)) 
      })
    } else {
      
      #Subset stand
      stands_sel <- subset(stands_extent,stands_extent@data$ID_UNIQUE==currentvariable4())
      
      #Subset for input$var and assign this subset to new object,"fbar"
      ds_sel<- stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
      
      #Create a map
      polys <- st_as_sf(stands_sel)
      ggplot() +
        geom_sf(data=polys) +
        geom_raster(data = stands_sel,aes(x = X,y = Y,fill = CD)) + 
        scale_fill_gradientn(name="Desfolha (%)",colours = terrain.colors(100))+
        xlab("Longitude") + ylab("Latitude") +
        coord_sf() +
        theme_bw() +
        theme(text = element_text(size=10)) 
      
    }
    
    output$map <- renderLeaflet({
      
      stands_actual<-stands_ds[stands_ds$ID_UNIQUE==currentvariable4(),]
      lng <- mean(stands_actual$X)
      lat <- mean(stands_actual$Y)
      
      leaflet() %>%
        setView(lng = lng,lat = lat,zoom=17) %>%
        addProviderTiles(providers$Esri.WorldImagery) %>%                   
        addMarkers(lng=stands_actual$X,lat=stands_actual$Y,popup="Location")
      
    }) }) #end of observe function.
}
shinyApp(ui,server)

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。