北京天气预报 R Shiny 应用

最新推荐文章于 2025-07-28 23:11:32 发布

superrcode

最新推荐文章于 2025-07-28 23:11:32 发布

阅读量672

点赞数 22

CC 4.0 BY-SA版权

文章标签： r语言开发语言 Rshiny shiny

本文链接：https://blog.youkuaiyun.com/superrcode/article/details/148745818

# 北京天气预报 R Shiny 应用

# 日期：2025年

# 加载必要的库
library(shiny)
library(shinydashboard)
library(DT)
library(plotly)
library(dplyr)
library(ggplot2)
library(lubridate)
library(jsonlite)
library(httr)
library(shinycssloaders)

# 模拟天气数据函数（实际应用中应该调用真实的天气API）
generate_weather_data <- function() {
# 生成未来7天的模拟天气数据
dates <- seq(from = Sys.Date(), by = "day", length.out = 7)

weather_data <- data.frame(
date = dates,
weekday = weekdays(dates),
temperature_high = round(runif(7, 15, 35), 1),
temperature_low = round(runif(7, 5, 20), 1),
humidity = round(runif(7, 30, 90), 0),
wind_speed = round(runif(7, 5, 25), 1),
pressure = round(runif(7, 1010, 1030), 0),
visibility = round(runif(7, 8, 20), 1),
uv_index = sample(1:10, 7, replace = TRUE),
weather_condition = sample(c("晴朗", "多云", "阴天", "小雨", "中雨", "雷阵雨", "雾霾"), 7, replace = TRUE),
air_quality = sample(c("优", "良", "轻度污染", "中度污染", "重度污染"), 7, replace = TRUE, prob = c(0.3, 0.4, 0.2, 0.08, 0.02))
)

# 确保最低温度小于最高温度
weather_data$temperature_low <- pmin(weather_data$temperature_low, weather_data$temperature_high - 5)

return(weather_data)
}

# 获取天气图标
get_weather_icon <- function(condition) {
icons <- list(
"晴朗" = "☀️",
"多云" = "⛅",
"阴天" = "☁️",
"小雨" = "🌦️",
"中雨" = "🌧️",
"雷阵雨" = "⛈️",
"雾霾" = "🌫️"
)
return(icons[[condition]] %||% "🌤️")
}

# 获取空气质量颜色
get_aqi_color <- function(quality) {
colors <- list(
"优" = "#00e400",
"良" = "#ffff00",
"轻度污染" = "#ff7e00",
"中度污染" = "#ff0000",
"重度污染" = "#8f3f97"
)
return(colors[[quality]] %||% "#999999")
}

# UI 界面设计
ui <- dashboardPage(
# 页面头部
dashboardHeader(
title = tags$div(
style = "font-family: 'Microsoft YaHei'; font-weight: bold;",
"🌤️ 北京天气预报系统"
)
),

# 侧边栏
dashboardSidebar(
width = 250,
sidebarMenu(
menuItem("🏠 天气概览", tabName = "overview", icon = icon("home")),
menuItem("📊 详细数据", tabName = "details", icon = icon("chart-bar")),
menuItem("📈 趋势分析", tabName = "trends", icon = icon("line-chart")),
menuItem("🗺️ 天气地图", tabName = "map", icon = icon("map")),
menuItem("⚙️ 设置", tabName = "settings", icon = icon("cog")),

br(),
div(style = "padding: 20px;",
h4("📍 当前位置", style = "color: white; margin-bottom: 10px;"),
p("北京市", style = "color: #ecf0f1; font-size: 16px;"),
p("海淀区", style = "color: #bdc3c7; font-size: 14px;"),
br(),
actionButton("refresh_data", "🔄 刷新数据",
class = "btn-primary",
style = "width: 100%; background: linear-gradient(45deg, #3498db, #2980b9);")
)
)
),

# 主体内容
dashboardBody(
# 自定义CSS样式
tags$head(
tags$style(HTML("
.content-wrapper, .right-side {
background-color: #f4f7fc;
}
.box {
border-radius: 8px;
box-shadow: 0 2px 10px rgba(0,0,0,0.1);
}
.weather-card {
background: linear-gradient(135deg, #667eea 0%, #764ba2 100%);
color: white;
border-radius: 15px;
padding: 20px;
margin: 10px;
text-align: center;
box-shadow: 0 4px 15px rgba(0,0,0,0.2);
}
.weather-icon {
font-size: 48px;
margin-bottom: 10px;
}
.temperature {
font-size: 32px;
font-weight: bold;
margin: 10px 0;
}
.weather-condition {
font-size: 18px;
margin-bottom: 15px;
}
.weather-details {
display: flex;
justify-content: space-around;
flex-wrap: wrap;
}
.detail-item {
text-align: center;
margin: 5px;
}
.detail-value {
font-size: 16px;
font-weight: bold;
}
.detail-label {
font-size: 12px;
opacity: 0.8;
}
.air-quality-badge {
display: inline-block;
padding: 5px 15px;
border-radius: 20px;
color: white;
font-weight: bold;
margin-top: 10px;
}
"))
),

tabItems(
# 天气概览页面
tabItem(tabName = "overview",
fluidRow(
# 今日天气卡片
column(12,
h2("📅 今日天气", style = "color: #2c3e50; margin-bottom: 20px;"),
div(id = "today_weather", class = "weather-card",
withSpinner(uiOutput("today_weather_card"), type = 6, color = "#3498db")
)
)
),

br(),

fluidRow(
# 核心指标卡片
column(3,
valueBoxOutput("temp_box", width = NULL)
),
column(3,
valueBoxOutput("humidity_box", width = NULL)
),
column(3,
valueBoxOutput("wind_box", width = NULL)
),
column(3,
valueBoxOutput("aqi_box", width = NULL)
)
),

br(),

fluidRow(
# 7天预报
column(12,
box(
title = "📅 7天天气预报", status = "primary", solidHeader = TRUE, width = NULL,
withSpinner(uiOutput("week_forecast"), type = 6, color = "#3498db")
)
)
)
),

# 详细数据页面
tabItem(tabName = "details",
fluidRow(
column(12,
h2("📊 详细天气数据", style = "color: #2c3e50; margin-bottom: 20px;")
)
),

fluidRow(
column(12,
box(
title = "🗃️ 天气数据表", status = "info", solidHeader = TRUE, width = NULL,
withSpinner(DT::dataTableOutput("weather_table"), type = 6, color = "#3498db")
)
)
),

fluidRow(
column(6,
box(
title = "🌡️ 温度统计", status = "warning", solidHeader = TRUE, width = NULL,
withSpinner(plotlyOutput("temp_stats"), type = 6, color = "#f39c12")
)
),
column(6,
box(
title = "💨 风速&湿度分析", status = "success", solidHeader = TRUE, width = NULL,
withSpinner(plotlyOutput("wind_humidity"), type = 6, color = "#27ae60")
)
)
)
),

# 趋势分析页面
tabItem(tabName = "trends",
fluidRow(
column(12,
h2("📈 天气趋势分析", style = "color: #2c3e50; margin-bottom: 20px;")
)
),

fluidRow(
column(12,
box(
title = "🌡️ 温度变化趋势", status = "primary", solidHeader = TRUE, width = NULL,
withSpinner(plotlyOutput("temperature_trend"), type = 6, color = "#3498db")
)
)
),

fluidRow(
column(6,
box(
title = "💧 湿度趋势", status = "info", solidHeader = TRUE, width = NULL,
withSpinner(plotlyOutput("humidity_trend"), type = 6, color = "#17a2b8")
)
),
column(6,
box(
title = "🌪️ 风速&气压变化", status = "warning", solidHeader = TRUE, width = NULL,
withSpinner(plotlyOutput("wind_pressure_trend"), type = 6, color = "#ffc107")
)
)
)
),

# 天气地图页面
tabItem(tabName = "map",
fluidRow(
column(12,
h2("🗺️ 北京天气地图", style = "color: #2c3e50; margin-bottom: 20px;")
)
),

fluidRow(
column(12,
box(
title = "🌍 实时天气雷达图", status = "success", solidHeader = TRUE, width = NULL, height = "600px",
div(style = "text-align: center; padding: 50px;",
h3("🚧 天气雷达图功能开发中", style = "color: #7f8c8d;"),
p("此功能需要接入真实的天气雷达API", style = "color: #95a5a6;"),
img(src = "https://via.placeholder.com/400x300/3498db/ffffff?text=Weather+Radar",
style = "border-radius: 10px; box-shadow: 0 4px 15px rgba(0,0,0,0.2);")
)
)
)
)
),

# 设置页面
tabItem(tabName = "settings",
fluidRow(
column(12,
h2("⚙️ 应用设置", style = "color: #2c3e50; margin-bottom: 20px;")
)
),

fluidRow(
column(6,
box(
title = "🌐 API配置", status = "primary", solidHeader = TRUE, width = NULL,
textInput("api_key", "天气API密钥:", value = "demo_key_12345"),
selectInput("api_provider", "API服务商:",
choices = list("OpenWeatherMap" = "openweather",
"和风天气" = "qweather",
"中国天气网" = "weather.com.cn"),
selected = "openweather"),
numericInput("update_interval", "数据更新间隔(分钟):", value = 30, min = 5, max = 120),
actionButton("save_settings", "💾 保存设置", class = "btn-success")
)
),
column(6,
box(
title = "🎨 显示设置", status = "info", solidHeader = TRUE, width = NULL,
selectInput("temp_unit", "温度单位:",
choices = list("摄氏度 (°C)" = "celsius",
"华氏度 (°F)" = "fahrenheit"),
selected = "celsius"),
selectInput("wind_unit", "风速单位:",
choices = list("公里/小时" = "kmh",
"米/秒" = "ms",
"英里/小时" = "mph"),
selected = "kmh"),
checkboxInput("show_animations", "启用动画效果", value = TRUE),
checkboxInput("dark_mode", "深色模式", value = FALSE),
actionButton("reset_settings", "🔄 重置设置", class = "btn-warning")
)
)
),

fluidRow(
column(12,
box(
title = "ℹ️ 关于应用", status = "success", solidHeader = TRUE, width = NULL,
h4("北京天气预报系统 v1.0"),
p("这是一个基于R Shiny开发的天气预报应用，提供北京地区的详细天气信息。"),
h5("主要功能："),
tags$ul(
tags$li("实时天气数据展示"),
tags$li("7天天气预报"),
tags$li("详细气象数据分析"),
tags$li("天气趋势图表"),
tags$li("交互式数据可视化")
),
hr(),
p("数据来源：模拟数据（演示版本）", style = "color: #7f8c8d; font-style: italic;"),
p("开发者：AI助手 | 最后更新：2025年", style = "color: #95a5a6; font-size: 12px;")
)
)
)
)
)
)
)

# Server 服务器逻辑
server <- function(input, output, session) {

# 响应式数据
weather_data <- reactive({
# 当刷新按钮被点击时重新生成数据
input$refresh_data
generate_weather_data()
})

# 今日天气卡片
output$today_weather_card <- renderUI({
data <- weather_data()
today <- data[1, ]

tagList(
div(class = "weather-icon", get_weather_icon(today$weather_condition)),
div(class = "temperature",
paste0(today$temperature_high, "°C / ", today$temperature_low, "°C")),
div(class = "weather-condition", today$weather_condition),
div(class = "air-quality-badge",
style = paste0("background-color: ", get_aqi_color(today$air_quality)),
paste("空气质量:", today$air_quality)),
br(),
div(class = "weather-details",
div(class = "detail-item",
div(class = "detail-value", paste0(today$humidity, "%")),
div(class = "detail-label", "湿度")
),
div(class = "detail-item",
div(class = "detail-value", paste0(today$wind_speed, " km/h")),
div(class = "detail-label", "风速")
),
div(class = "detail-item",
div(class = "detail-value", paste0(today$pressure, " hPa")),
div(class = "detail-label", "气压")
),
div(class = "detail-item",
div(class = "detail-value", today$uv_index),
div(class = "detail-label", "紫外线指数")
)
)
)
})

# 温度指标卡
output$temp_box <- renderValueBox({
data <- weather_data()
today <- data[1, ]
valueBox(
value = paste0(today$temperature_high, "°C"),
subtitle = "今日最高温度",
icon = icon("thermometer-half"),
color = "red"
)
})

# 湿度指标卡
output$humidity_box <- renderValueBox({
data <- weather_data()
today <- data[1, ]
valueBox(
value = paste0(today$humidity, "%"),
subtitle = "相对湿度",
icon = icon("tint"),
color = "blue"
)
})

# 风速指标卡
output$wind_box <- renderValueBox({
data <- weather_data()
today <- data[1, ]
valueBox(
value = paste0(today$wind_speed, " km/h"),
subtitle = "风速",
icon = icon("wind"),
color = "green"
)
})

# 空气质量指标卡
output$aqi_box <- renderValueBox({
data <- weather_data()
today <- data[1, ]
color_map <- list("优" = "green", "良" = "yellow", "轻度污染" = "orange",
"中度污染" = "red", "重度污染" = "purple")
valueBox(
value = today$air_quality,
subtitle = "空气质量",
icon = icon("leaf"),
color = color_map[[today$air_quality]] %||% "gray"
)
})

# 7天预报
output$week_forecast <- renderUI({
data <- weather_data()

cards <- lapply(1:nrow(data), function(i) {
day <- data[i, ]
column(
width = 12/7,
div(
style = "background: linear-gradient(135deg, #74b9ff, #0984e3);
color: white; border-radius: 10px; padding: 15px;
margin: 5px; text-align: center; min-height: 200px;",
h5(day$weekday, style = "margin-bottom: 10px;"),
div(style = "font-size: 24px; margin: 10px 0;", get_weather_icon(day$weather_condition)),
p(day$weather_condition, style = "font-size: 14px; margin: 5px 0;"),
p(paste0(day$temperature_high, "°/", day$temperature_low, "°"),
style = "font-size: 16px; font-weight: bold; margin: 10px 0;"),
p(paste0("💧 ", day$humidity, "%"), style = "font-size: 12px; margin: 2px 0;"),
p(paste0("💨 ", day$wind_speed, " km/h"), style = "font-size: 12px; margin: 2px 0;")
)
)
})

do.call(fluidRow, cards)
})

# 天气数据表
output$weather_table <- DT::renderDataTable({
data <- weather_data()

# 格式化数据表
formatted_data <- data %>%
mutate(
日期 = format(date, "%Y-%m-%d"),
星期 = weekday,
天气 = paste0(get_weather_icon(weather_condition), " ", weather_condition),
最高温 = paste0(temperature_high, "°C"),
最低温 = paste0(temperature_low, "°C"),
湿度 = paste0(humidity, "%"),
风速 = paste0(wind_speed, " km/h"),
气压 = paste0(pressure, " hPa"),
能见度 = paste0(visibility, " km"),
紫外线 = uv_index,
空气质量 = air_quality
) %>%
select(日期, 星期, 天气, 最高温, 最低温, 湿度, 风速, 气压, 能见度, 紫外线, 空气质量)

DT::datatable(
formatted_data,
options = list(
pageLength = 10,
scrollX = TRUE,
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print')
),
class = "display nowrap compact",
escape = FALSE
)
})

# 温度统计图
output$temp_stats <- renderPlotly({
data <- weather_data()

p <- ggplot(data, aes(x = date)) +
geom_ribbon(aes(ymin = temperature_low, ymax = temperature_high),
fill = "#3498db", alpha = 0.3) +
geom_line(aes(y = temperature_high, color = "最高温"), size = 1.2) +
geom_line(aes(y = temperature_low, color = "最低温"), size = 1.2) +
geom_point(aes(y = temperature_high, color = "最高温"), size = 3) +
geom_point(aes(y = temperature_low, color = "最低温"), size = 3) +
scale_color_manual(values = c("最高温" = "#e74c3c", "最低温" = "#3498db")) +
labs(title = "温度变化", x = "日期", y = "温度 (°C)", color = "类型") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, color = "#2c3e50"),
legend.position = "bottom"
)

ggplotly(p, tooltip = c("x", "y", "colour"))
})

# 风速湿度分析
output$wind_humidity <- renderPlotly({
data <- weather_data()

p <- ggplot(data, aes(x = wind_speed, y = humidity,
color = weather_condition, size = pressure)) +
geom_point(alpha = 0.7) +
geom_smooth(method = "lm", se = FALSE, color = "#95a5a6") +
scale_size_continuous(range = c(3, 8)) +
labs(title = "风速与湿度关系",
x = "风速 (km/h)", y = "湿度 (%)",
color = "天气状况", size = "气压 (hPa)") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, color = "#2c3e50"),
legend.position = "bottom"
)

ggplotly(p, tooltip = c("x", "y", "colour", "size"))
})

# 温度趋势
output$temperature_trend <- renderPlotly({
data <- weather_data()

p <- plot_ly(data, x = ~date, type = 'scatter', mode = 'lines+markers') %>%
add_trace(y = ~temperature_high, name = '最高温度',
line = list(color = '#e74c3c', width = 3),
marker = list(size = 8)) %>%
add_trace(y = ~temperature_low, name = '最低温度',
line = list(color = '#3498db', width = 3),
marker = list(size = 8)) %>%
layout(
title = list(text = "未来7天温度趋势", font = list(size = 18, color = '#2c3e50')),
xaxis = list(title = "日期"),
yaxis = list(title = "温度 (°C)"),
hovermode = 'x unified',
showlegend = TRUE
)

p
})

# 湿度趋势
output$humidity_trend <- renderPlotly({
data <- weather_data()

p <- plot_ly(data, x = ~date, y = ~humidity, type = 'scatter', mode = 'lines+markers',
line = list(color = '#17a2b8', width = 3),
marker = list(size = 8, color = '#17a2b8')) %>%
layout(
title = list(text = "湿度变化趋势", font = list(size = 16, color = '#2c3e50')),
xaxis = list(title = "日期"),
yaxis = list(title = "湿度 (%)"),
hovermode = 'x'
)

p
})

# 风速气压趋势
output$wind_pressure_trend <- renderPlotly({
data <- weather_data()

p <- plot_ly(data, x = ~date) %>%
add_trace(y = ~wind_speed, name = '风速', type = 'scatter', mode = 'lines+markers',
yaxis = 'y', line = list(color = '#27ae60', width = 2),
marker = list(size = 6)) %>%
add_trace(y = ~pressure, name = '气压', type = 'scatter', mode = 'lines+markers',
yaxis = 'y2', line = list(color = '#f39c12', width = 2),
marker = list(size = 6)) %>%
layout(
title = list(text = "风速与气压变化", font = list(size = 16, color = '#2c3e50')),
xaxis = list(title = "日期"),
yaxis = list(title = "风速 (km/h)", side = 'left'),
yaxis2 = list(title = "气压 (hPa)", side = 'right', overlaying = 'y'),
hovermode = 'x unified',
showlegend = TRUE
)

p
})

# 设置保存
observeEvent(input$save_settings, {
showNotification("设置已保存！", type = "success", duration = 3)
})

# 设置重置
observeEvent(input$reset_settings, {
showNotification("设置已重置！", type = "warning", duration = 3)
})
}