shiny【2】——组件

介绍各种组件的使用方法。


text文本

ui <- fluidPage( textOutput(“text”), ) server <- function(input, output, session) { output$text <- renderText({ “Hello friend!” }) }

1. infobox

语法:ui中写入infoBoxOutput,serve中写入renderInfoBox,renderInfoBox中可以调用变量。

ui <- dashboardPage(
  dashboardBody(
    tabItem(
      tabName = "home",
      fluidRow(
        infoBoxOutput("cpuBox", width = 3),
        infoBoxOutput("likeBox", width = 3),
        infoBoxOutput("saleBox", width = 3),
        infoBoxOutput("memberBox", width = 3)
      )
    )
  )
)

server = function(input, output) {
  output$cpuBox <- renderInfoBox({
    infoBox(
      "CPU TRAFFIC", 
      value = paste0(input$cpu, "%"), 
      # subtitle = "",
      icon = icon("gear"),
      color = "light-blue"
    )
  })
  output$likeBox <- renderInfoBox({
    infoBox(...)
  })
  output$saleBox <- renderInfoBox({
    infoBox(...)
  })
  output$memberBox <- renderInfoBox({
    infoBox(...)
  })
  }

2. 环形比例图

语法:ui中写入plotlyOutput,serve中写入renderPlotly。

library(shiny)
library(plotly)

# 定义UI
ui <- fluidPage(
  fluidRow(
    box( # 这里的box是我自己的网页中设置了一个外面的box,在box中按照上图中的顺序对环图进行排列
      # title = "Title",
      status = "warning",
      width = 12,
      fluidRow(
        column(6,plotlyOutput("pie1",height = 200)),
        column(6,plotlyOutput("pie2",height = 200))
      )
    )
  )
)

# 定义服务器逻辑
server <- function(input, output) {
  # 创建交互式圆环图
  output$pie1 <- renderPlotly({
    plot_ly(data1, labels = ~label1, values = ~Freq, type = 'pie', hole = 0.6, textinfo = "none") %>%
      hide_legend() %>% 
      layout(title = "Donor Infor1")
  })
  
  output$pie2 <- renderPlotly({
    plot_ly(data2, labels = ~label2, values = ~Freq, type = 'pie', hole = 0.6, textinfo = "none") %>%
      hide_legend() %>% 
      layout(title = "Donor Infor2")
  })
}

# 运行Shiny应用
shinyApp(ui, server)

地图

该部分代码还需要进一步debug

library(shiny)
library(leaflet)
library(ip2location)

# 创建一个IP地址到地理位置的映射,这里使用ip2location包获取地理位置信息
ip_to_location <- function(ip) {
  # 这里需要您自己获取IP地址的地理位置信息
  # 在示例中,我们使用假数据来模拟地理位置信息
  return(list(lat = 40.7128, lon = -74.0060))  # 纽约市的经纬度
}

ui <- fluidPage(
  titlePanel("IP地址地图展示"),
  mainPanel(
    leafletOutput("ip_map")
  )
)

server <- function(input, output, session) {
  # 创建一个空的leaflet地图
  output$ip_map <- renderLeaflet({
    leaflet() %>%
      addTiles()  # 添加底图
  })
  
  # 处理新的IP地址并在地图上标记位置
  observe({
    visitors_ip <- req(session$clientData$session$remote$address)
    location <- ip_to_location(visitors_ip)
    
    # 在地图上添加标记
    leafletProxy("ip_map") %>%
      addMarkers(
        data = location,
        lat = ~lat,
        lon = ~lon,
        popup = visitors_ip  # 在标记上显示IP地址
      )
  })
}

shinyApp(ui, server)

把ip地址转化为经纬度

library(ip2location)

# 初始化IP2Location数据库文件
db <- IP2Location$new(database = "path_to_database_file.IP2LOCATION-LITE-DB1.IPV6.BIN")

# 定义一个函数来获取IP地址的经纬度
get_lat_lon_from_ip <- function(ip) {
  result <- db$find(ip)
  if (!is.null(result)) {
    lat <- result$latitude
    lon <- result$longitude
    return(list(lat = lat, lon = lon))
  } else {
    return(NULL)
  }
}

# 测试获取IP地址的经纬度
ip_address <- "8.8.8.8"  # 举例:Google的DNS服务器IP地址
location <- get_lat_lon_from_ip(ip_address)
if (!is.null(location)) {
  cat("IP地址:", ip_address, " 经度:", location$lon, " 纬度:", location$lat, "\n")
} else {
  cat("未找到IP地址的位置信息\n")
}

在shiny中根据用户选择,取数据选多个列的方法

ui <- {
 shinyWidgets::virtualSelectInput(
          inputId = "select_site",
          label = "Tumor site :",
          choices = list(
            "All" = lapply(sub("_"," ",tumorsite.pie$tumor.site), HTML)
          ),
          selectize = FALSE,
          showValueAsTags = TRUE,
          search = TRUE,
          multiple = TRUE
        )
}

dataset <- reactive({
    selected_columns <- input$select_site
    if (!is.null(selected_columns) && length(selected_columns) > 0) {
      selected_columns <- paste0("`", selected_columns, "`", collapse = ", ")
      query <- sprintf("SELECT %s FROM cbioportal;", selected_columns)
      cat("Generated query:", query, "\n") 
      dbGetQuery(con, query) %>% as.data.frame()
    } else {
      data.frame()  # 返回一个空数据框,以避免错误
    }
  })

  observeEvent(dataset(), {
    updateVirtualSelect(
      inputId = "select_site",
      choices = dataset()$select_site
    )
  })
  output$dynamic1 <- renderDataTable( # Clinical
    dataset(),
    options = list(
      pageLength = 10,
      scrollX = TRUE
    )
  )

参考资料:

  • master shiny
comments powered by Disqus