首页 > 解决方案 > r Shiny 是否有能见度条件

问题描述

有没有办法(在纯 Shiny 中)检查一个元素是否在屏幕上可见(显示:块),就像 JScript 对 "is.visible" 所做的那样?

这是我的问题的可复制示例:

library(shiny)
library(leaflet)
library(leaflet.extras)
library(tidyverse)
library(sf)
library(shinyjs)


#Create T0New data
lat <- c(49.823, 49.823, 58.478, 57.478, 45.823)
lng <- c(-10.854,-14.854,-10.854,2.02,2.02)
date <- c(123,125,135,168,149)
cat <-c("A","A","A","B","B")
type <- c("x","x","y","z","w")
col <- c("red","red","purple","green","turquoise")
T0New <- data.frame(lat,lng,date,cat,type,col)



ui <- fluidPage(
  useShinyjs(),

  tags$style("
             p{
             display:contents 
             }
             .show{
             display: block 
             }
             .hide{
             display: none !important
             }
             "),


      column(width = 3,
             HTML(' 
                  <div class="attr-col shiny-input-radiogroup" id="conf">

                      <input type="radio" id="A" name="conf" value="A" checked= "checked"/>
                      <label for="A">A</label>
                          <svg height="10" width="10">
                          <polygon points="0 0, 10 0, 10 10, 0 10" id="AToggle" />
                          </svg>
                      <br/>

                      <div id = "ALegend" class style = " display: none;" >
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="red" /></svg>
                          <p>x </p>
                          </br>
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="purple" /></svg>
                          <p> y </p>
                      </div>

                      <div id = "ALegendBoxes" class style = " display: none;" >
                          <input type="checkbox" id="x" name="x" checked>
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="red" /></svg> 
                          <label for="x">x</label>
                          </br>
                          <input type="checkbox" id="y" name="y" checked>
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="purple" /></svg>
                          <label for="Séculier">y</label>
                      </div>

                      <input type="radio" id="B" name="conf" value="B"  />
                      <label for="B">B</label>
                          <svg height="10" width="10">
                          <polygon points="0 0, 10 0, 10 10, 0 10" id="BToggle" />
                          </svg>
                      <br/>

                      <div id = "BLegend" class style = " display: none;" >
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="green" /></svg>
                          <p> z </p>
                          </br>
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="turquoise" /></svg>
                          <p> w </p>
                      </div>

                      <div id = "BLegendBoxes" class style = " display: none;" >
                          <input type="checkbox" id="z" name="z"checked>
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="green" /></svg>
                          <label for="z">z</label>
                          </br>
                          <input type="checkbox" id="w" name="w"checked>
                          <svg height="10" width="10"><circle cx="5" cy="5" r="5" fill="turquoise" /></svg>
                          <label for="w">w</label>
                      </div>
                  </div>

                  ')
      ),
      column(width = 9, 
             leafletOutput("map", height = "45vh"),
             plotOutput("distribPlot", height = "40vh",
                        brush = brushOpts(id = "distribPlot_brush", direction = "x", resetOnNew = FALSE))
             )
  # )
)


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

  filteredData <- reactive({

    if (input$x == TRUE) xV <- "x" else xV <- ""
    if (input$y == TRUE) yV <- "y" else yV <- ""

    if (input$z == TRUE) zV <- "z" else zV <- ""
    if (input$w == TRUE) wV <- "w" else wV <- ""

    currentlyFiltered <- filter(T0New, type %in% c(xV,yV,zV,wV))

    currentlyFiltered <- filter(currentlyFiltered, cat %in% input$conf)

    if(!is.null(input$distribPlot_brush)){
      thisSel <- input$distribPlot_brush
      currentlyFiltered <- currentlyFiltered %>% 
        filter(date >= thisSel$xmin, date <= thisSel$xmax)
    }


    return(currentlyFiltered)
  })

  #Sortie map
  output$map <- renderLeaflet({
    leaflet()%>%
      addProviderTiles(providers$OpenTopoMap) 
  })

  observe({
      mapData <- filteredData()
      mapProxy <- leafletProxy("map", session = session, data = mapData)
      mapProxy %>%
        clearGroup('1') %>% 
        addCircleMarkers(
          data = mapData,
          lat = mapData$lat,
          lng = mapData$lng,
          radius = 4,
          color = 'white',
          opacity = 1,
          fillColor = ~col,
          stroke = T,
          weight = 1,
          fillOpacity = 1,
          group='1'
        )
  })

  #Sortie graph
  output$distribPlot <- renderPlot({

    distribPlot <- ggplot(T0New,aes(date)) +
      geom_density(col = "#053144", fill = "#43a2ca", alpha = 0.3, adjust = 0.75)

    return(distribPlot)
  })



    onclick(id = "AToggle", c(toggleClass(id = "ALegend", class = "show")), add = FALSE)

    observe({
      toggleClass(id = "ALegend", class = "hide",
                  condition = input$conf=="A")
      toggleClass(id = "ALegendBoxes", class = "show",
                  condition = input$conf=="A")
    })

    onclick(id = "BToggle", c(toggleClass(id = "BLegend", class = "show")), add = FALSE)

    observe({
      toggleClass(id = "BLegend", class = "hide",
                  condition = input$conf=="B")
      toggleClass(id = "BLegendBoxes", class = "show",
                  condition = input$conf=="B")
    })

}

# Create Shiny app ----
shinyApp(ui = ui, server = server)

现在,基于交互,这段代码正是我想做的:通过单击单选按钮旁边的方块,如果它的复选框尚不可见,您可以设置可见它的图例而不使用复选框。如果带有复选框的图例已经可见,则不会设置没有复选框可见的图例。

但是我想通过用箭头替换正方形来增强此功能,如果没有任何图例可见,则指向单选按钮,如果任何图例可见,则指向下方。

现在我正在玩“点击时”(第 169 和 178 行)、单选按钮选择(第 171 到 176 和 180 到 185 行)和“!important”类“隐藏”(第 30 行),但要做我想做的事做这些条件是不够的,所以我正在徘徊,如果有任何“可见”条件在 Shiny 中可以玩

标签: rshiny

解决方案


推荐阅读