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

在 Shiny 中调整 html 小部件的大小? (echarts4r)

如何解决在 Shiny 中调整 html 小部件的大小? (echarts4r)

下午好/晚上好。我正在尝试使用传单和 echarts4r 创建一个闪亮的应用程序,但我想知道是否可以更改出现在侧面的直方图的大小。任何人都对我如何做到这一点有任何想法?这是一个屏幕截图,表明我对图形感兴趣的大小:

SS of the app

应用程序代码如下:

library(shiny)
library(leaflet)
library(RColorBrewer)
library(htmltools)
library(echarts4r)

ui <- bootstrapPage(
  tags$style(type = "text/css","html,body {width:100%;height:100%}"),leafletoutput("map",width = "100%",height = "100%"),absolutePanel(top = 10,right = 10,sliderInput("range","Magnitudes",min(quakes$mag),max(quakes$mag),value = range(quakes$mag),step = 0.1
                ),selectInput("colors","Color Scheme",rownames(subset(brewer.pal.info,category %in% c("seq","div")))
                ),checkBoxInput("legend","Show legend",TRUE),p( iris %>%
                     e_charts() %>%
                     e_histogram(Sepal.Length,name = "histogram",breaks = "freedman-diaconis") %>%
                     e_tooltip(trigger = "axis") |> 
                     e_color(color = "#753732")
                   
                   )
  )
)

server <- function(input,output,session) {
  
  # Reactive expression for the data subsetted to what the user selected
  filteredData <- reactive({
    quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
  })
  
  # This reactive expression represents the palette function,# which changes as the user makes selections in UI.
  colorpal <- reactive({
    colorNumeric(input$colors,quakes$mag)
  })
  
  output$map <- renderLeaflet({
    # Use leaflet() here,and only include aspects of the map that
    # won't need to change dynamically (at least,not unless the
    # entire map is being torn down and recreated).
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long),~min(lat),~max(long),~max(lat))
  })
  
  # Incremental changes to the map (in this case,replacing the
  # circles when a new color is chosen) should be performed in
  # an observer. Each independent set of things that can change
  # should be managed in its own observer.
  observe({
    pal <- colorpal()
    
    leafletProxy("map",data = filteredData()) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10,weight = 1,color = "#777777",fillColor = ~pal(mag),fillOpacity = 0.7,popup = ~paste(mag)
      ) %>% addTiles("http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png",attribution = paste(
                   "&copy; <a href=\"http://openstreetmap.org\">OpenStreetMap</a> contributors","&copy; <a href=\"http://cartodb.com/attributions\">CartoDB</a>"
                 )
      ) 
  })
  
  # Use a separate observer to recreate the legend as needed.
  observe({
    proxy <- leafletProxy("map",data = quakes)
    
    # Remove any existing legend,and only if the legend is
    # enabled,create a new one.
    proxy %>% clearControls()
    if (input$legend) {
      pal <- colorpal()
      proxy %>% addLegend(position = "bottomright",pal = pal,values = ~mag
      )
    }
  })
}

shinyApp(ui,server)

解决方法

这是一种选择 -

获取服务器端的直方图,并在 ui 中使用 echarts4rOutput,您可以根据自己的选择轻松调整 heightwidth

library(shiny)
library(leaflet)
library(RColorBrewer)
library(htmltools)
library(echarts4r)

ui <- bootstrapPage(
  tags$style(type = "text/css","html,body {width:100%;height:100%}"),leafletOutput("map",width = "100%",height = "100%"),absolutePanel(top = 10,right = 10,sliderInput("range","Magnitudes",min(quakes$mag),max(quakes$mag),value = range(quakes$mag),step = 0.1
                ),selectInput("colors","Color Scheme",rownames(subset(brewer.pal.info,category %in% c("seq","div")))
                ),checkboxInput("legend","Show legend",TRUE),echarts4rOutput('hist_plot',height = '1000px',width = '500px')
  )
)

server <- function(input,output,session) {
  
  # Reactive expression for the data subsetted to what the user selected
  filteredData <- reactive({
    quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
  })
  
  # This reactive expression represents the palette function,# which changes as the user makes selections in UI.
  colorpal <- reactive({
    colorNumeric(input$colors,quakes$mag)
  })
  
  output$map <- renderLeaflet({
    # Use leaflet() here,and only include aspects of the map that
    # won't need to change dynamically (at least,not unless the
    # entire map is being torn down and recreated).
    leaflet(quakes) %>% addTiles() %>%
      fitBounds(~min(long),~min(lat),~max(long),~max(lat))
  })
  
  # Incremental changes to the map (in this case,replacing the
  # circles when a new color is chosen) should be performed in
  # an observer. Each independent set of things that can change
  # should be managed in its own observer.
  observe({
    pal <- colorpal()
    
    leafletProxy("map",data = filteredData()) %>%
      clearShapes() %>%
      addCircles(radius = ~10^mag/10,weight = 1,color = "#777777",fillColor = ~pal(mag),fillOpacity = 0.7,popup = ~paste(mag)
      ) %>% addTiles("http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png",attribution = paste(
                       "&copy; <a href=\"http://openstreetmap.org\">OpenStreetMap</a> contributors","&copy; <a href=\"http://cartodb.com/attributions\">CartoDB</a>"
                     )
      ) 
  })
  
  # Use a separate observer to recreate the legend as needed.
  observe({
    proxy <- leafletProxy("map",data = quakes)
    
    # Remove any existing legend,and only if the legend is
    # enabled,create a new one.
    proxy %>% clearControls()
    if (input$legend) {
      pal <- colorpal()
      proxy %>% addLegend(position = "bottomright",pal = pal,values = ~mag
      )
    }
  })
  
  
  output$hist_plot <- renderEcharts4r({
    iris %>%
         e_charts() %>%
         e_histogram(Sepal.Length,name = "histogram",breaks = "freedman-diaconis") %>%
         e_tooltip(trigger = "axis") %>%
         e_color(color = "#753732")
  })
}

shinyApp(ui,server)

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