在不同尺寸的屏幕上固定gvisGeoChart上注释的相对位置

Question

我仍在尝试找到解决此问题的方法：在 gvisGeoChart 中的 colorAxis 两侧插入文本，而不是 Shiny 应用程序的数字

据我所知，不可能（1）向颜色条添加标题，或（2）删除颜色条两侧的数字。作为解决方法，我尝试在其上方单独放置注释。我的问题是，它会根据屏幕的大小而大幅移动。

有没有办法可以将文本固定在颜色条上方，无论屏幕尺寸如何？现在我已经把它放在了合适的位置，所以它对所有东西都适用，但它并不像我想要的那么整洁......

超大屏幕：

13寸笔记本电脑：

手机：

相关代码为：

    library(shiny)
    library(googleVis)
    library(dplyr)
    library(DT)
    
    # Load your data
    combined_vul_data <- 
      structure(list(ISO3 = c("AF", "AL", "DZ", "AD", "AO", "AG", "AR", 
                              "AM", "AU", "AT", "AZ", "BS", "BH", "BD", "BB", "BY", "BE", "BZ", 
                              "BJ", "BT"), Name = c("Afghanistan", "Albania", "Algeria", "Andorra", 
                                                    "Angola", "Antigua and Barbuda", "Argentina", "Armenia", "Australia", 
                                                    "Austria", "Azerbaijan", "Bahamas", "Bahrain", "Bangladesh", 
                                                    "Barbados", "Belarus", "Belgium", "Belize", "Benin", "Bhutan"
                              ), vul_capacity_Rank_2021 = c(0.709035449, 0.511126182, 0.523332101, 
                                                            NA, 0.740026186, 0.621133795, 0.446088596, 0.462491218, 0.296565054, 
                                                            0.26689445, 0.47917568, NA, 0.453936004, 0.649876424, 0.398904506, 
                                                            0.386808093, 0.27763708, 0.547525366, 0.763503499, 0.635633065
                              )), class = "data.frame", row.names = c(NA, -20L))
    
    
    # Define UI for the map
    ui <- fluidPage(
  tags$head(
    tags$style(HTML("
      .color-scale-label {
        position: absolute;
        bottom: 35px;
        left: 20%;
        transform: translateX(-25%);
        background: rgba(255, 255, 255, 0.3);
        padding: 5px;
        z-index: 1000;
        pointer-events: none;
  }
      @media (max-width: 768px) {
        .shiny-input-container {
          width: 100%;
        .main-panel, .content {
          height: calc(100vh - 56px) !important;
          overflow: auto;
        }
        .main-panel {
          height: 100vh;
        }
      }
    "))
  ),
     titlePanel(div(span("Country Rankings"), style={'padding-top: 15px'})),
      tabsetPanel(
        tabPanel("Vulnerability Map",
                 sidebarLayout(
                   sidebarPanel(
                     selectInput("year", "Select Year", choices = 2021, selected = 2021),
                     selectInput("category", "Select Category", 
                                 choices = list("Adaptive Capacity" = "vul_capacity"), selected = "vul_vulnerability")
                   ),
                   mainPanel(
                     tags$div(class="color-scale-label", "Least to Most Vulnerable"),
                     htmlOutput("map")
                   )
                 )
        )
      )
    )
    
    # Define server logic for the map
    server <- function(input, output) {
       output$map <- renderGvis({
        year <- input$year
        category <- input$category
        
        # Create the column name for the selected year and category
        rank_column <- paste(category, "_Rank_", year, sep = "")
        
        # Filter and prepare the data
        map_data <- combined_vul_data %>%
          select(ISO3, Name, Rank = !!sym(rank_column)) %>%
          mutate(Tooltip = ifelse(is.na(Rank), paste(Name, "- Insufficient data"), paste(Name)))
        
        # Update locationvar column
        map_data <- map_data %>%
          mutate(Location = ifelse(Name %in% c("Congo (Brazzaville)", "Congo (Kinshasa)"), ISO3, Name))
        
        # Determine the range of the Rank values
        min_rank <- min(map_data$Rank, na.rm = TRUE)
        max_rank <- max(map_data$Rank, na.rm = TRUE)
        
        # Create the map
        gvisGeoChart(map_data, locationvar = "Location", colorvar = "Rank",
                     hovervar = "Tooltip",  
                     options = list(colorAxis = paste0("{minValue:", min_rank, ", maxValue:", max_rank, ", colors:['#00FF00', '#FFFF00', '#FF0000']}"),
                                    backgroundColor = '#81d4fa', datalessRegionColor = '#f5f5f5',
                                    defaultColor = '#f5f5f5',
                                    tooltip = "{isHtml: true}",
                                    width = "100%",
                                    height = "500px"))  
      })
      
    }
    
    shinyApp(ui = ui, server = server)

Answer 1

googleVis

库中似乎没有任何对这项工作有用的东西，但是你可以用 JS 做无限的可能性。

你提到要摆脱价值观；您还提到添加标题。

这个答案涉及如何添加动态标题。

我没有将你的风格包含在头部中。当然，你可以把它们加回去，不会和我写的有任何冲突。

head中有一个javascript，用于识别colorbar在哪里以及它有多大。

在该 JS 中，带有函数

addSVG()

的前 2 行包含您可能想要更改的元素。

• 标题（当前设置为

  title = 'Least to Most Vulnerable';

  ）
• 在工具栏左侧找到的值（当前为

  round(min(combined_vul_data$vul_capacity_Rank_2021, na.rm = T), 3)

  ）

函数

addSVG()

中的最后一行包含

$('#putItHere').html(svgu); 

，其中

putItHere

与 UI 中调用的 ID 相同（当前为

tags$div(id = "putItHere", style = css(position = "absolute", width = "100%", top = 0))

）——如果更改一个，则必须更改另一个。

我在添加到您的代码中的内容中添加了很多注释，但是如果您有任何疑问，请随时询问。

数据和服务器不变（我这里只有UI。）

# Define UI for the map
ui <- fluidPage(
  tags$head(
    tags$script(HTML(
      paste0(
        "window.addEventListener('DOMContentLoaded', function(){
      setTimeout(function() {   /* ensure entire SVG has loaded before executing */
        addSVG();
      }, 1000);

      function addSVG() {        
        title = 'Least to Most Vulnerable';     /* title to add to the plot */      
        where = $('g text:contains(", round(min(combined_vul_data$vul_capacity_Rank_2021, na.rm = T), 3), ")'); 
                                                /* identify where to position the title */
        w = Math.floor($('g text:contains(0.267)')[0].getBoundingClientRect().width * 6);
        h = $('g text:contains(0.267)')[0].getBoundingClientRect().height * 2;
    
        newSz = Number(where[0].getAttribute('font-size')) * 1.5;  /* used to determine title spacing height */
        getA = where[0].outerHTML;                                 /* get element attributes- white background */
        getB = where[1].outerHTML;                                 /* get element attributes- black text */
        newA = getA.replace(/(?<=(y=\"))([0-9.]+)/g, newSz);       /* update y position for title */
        newB = getB.replace(/(?<=(y=\"))([0-9.]+)/g, newSz);       /* update y position for title */
        newTa = newA.replace(/(?<=(\\>))[0-9.]+/g, title);         /* Add title */
        newTb = newB.replace(/(?<=(\\>))[0-9.]+/g, title);         /* Add title */
                                                                   /* create SVG element */
        newE = '<svg width=\"' + w + '\" height=\"' + h + '\" viewBox=\"0 0 ' + w + ' ' + h + '\" transform=\"translate(0, ' + 
                   Math.floor((Number(where[0].getAttribute('y')) - h) * 0.98) + ')\">';
    
        svgu = newE + '<g>' + newTa + newTb + '</g></svg>';         /* assemble SVG content */
        $('#putItHere').html(svgu);                                 /* add to page; output$NAME in Shiny app */
      }
    });"))
    )),
  titlePanel(div(span("Country Rankings"), style={'padding-top: 15px'})),
  tabsetPanel(
    tabPanel("Vulnerability Map",
             sidebarLayout(
               sidebarPanel(
                 selectInput("year", "Select Year", choices = 2021, selected = 2021),
                 selectInput("category", "Select Category", 
                             choices = list("Adaptive Capacity" = "vul_capacity"), selected = "vul_vulnerability")
               ),
               mainPanel(
                 # tags$div(class="color-scale-label", "Least to Most Vulnerable"),
                 htmlOutput("map"),
                 tags$div(id = "putItHere", style = css(position = "absolute", width = "100%", top = 0))
               )
             )
    )
  )
)

一些观点：