R Notebook

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Ctrl+Shift+Enter.

library(shiny)
library(shinydashboard)

## 
## 载入程序包：'shinydashboard'

## The following object is masked from 'package:graphics':
## 
##     box

library(DT)

## 
## 载入程序包：'DT'

## The following objects are masked from 'package:shiny':
## 
##     dataTableOutput, renderDataTable

library(ggplot2)
library(plotly)

## 
## 载入程序包：'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(dplyr)

## 
## 载入程序包：'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidyr)

# 球员数据
players_data <- data.frame(
  Player = c("姆巴佩", "维尼修斯-儒尼奥尔", "祖德-贝林厄姆", "哈里-凯恩", "劳塔罗-马丁内斯", "埃尔林-哈兰德", "菲尔-福登", "达尼-奥尔莫", "拉明-亚马尔", "弗洛里安-维尔茨", "佩德里", "费德里科-巴尔韦德", "德克兰-赖斯", "马丁-厄德高", "罗德里戈", "科尔-帕尔默", "布卡约-萨卡", "贾马尔-穆西亚拉"),
  League = c("西甲", "西甲", "西甲", "德甲", "意甲", "英超", "英超", "西甲", "西甲", "德甲", "西甲", "西甲", "英超", "英超", "西甲", "英超", "英超", "德甲"),
  Club = c("皇家马德里", "皇家马德里", "皇家马德里", "拜仁慕尼黑", "国际米兰", "曼城", "曼城", "巴塞罗那", "巴塞罗那", "勒沃库森", "巴塞罗那", "皇家马德里", "阿森纳", "阿森纳", "皇家马德里", "切尔西", "阿森纳", "拜仁慕尼黑"),
  Age = c(26, 24, 21, 31, 27, 24, 24, 26, 17, 21, 22, 26, 26, 26, 24, 22, 23, 22),
  Goals = c(33, 21, 13, 35, 21, 30, 11, 8, 14, 15, 5, 8, 7, 5, 14, 14, 11, 18),
  Assists = c(5, 13, 12, 11, 4, 4, 7, 5, 19, 12, 7, 8, 9, 7, 9, 8, 13, 6),
  Minutes = c(4085, 3710, 3751, 3312, 3259, 3438, 2878, 1412, 3694, 2950, 3829, 4282, 3531, 2806, 3220, 2962, 2075, 2871),
  ShotAccuracy = c(89, 85, 86, 93, 93, 96, 83, 80, 80, 82, 69, 83, 72, 83, 82, 85, 85, 82),
  PassAccuracy = c(82, 85, 87, 88, 78, 75, 86, 82, 85, 87, 88, 78, 75, 86, 82, 85, 87, 88),
  Dribbles = c(92, 91, 88, 82, 84, 81, 89, 87, 87, 90, 89, 84, 79, 89, 88, 88, 88, 90),
  InjuryRisk = c("低", "中", "高", "中", "高", "低", "中", "低", "中", "高", "中", "高", "低", "中", "低", "中", "高", "中")
)

# 欧冠数据
ucl_data <- data.frame(
  Player = c("姆巴佩", "维尼修斯-儒尼奥尔", "祖德-贝林厄姆", "哈里-凯恩", "劳塔罗-马丁内斯", "埃尔林-哈兰德", "菲尔-福登", "达尼-奥尔莫", "拉明-亚马尔", "弗洛里安-维尔茨", "佩德里", "费德里科-巴尔韦德", "德克兰-赖斯", "马丁-厄德高", "罗德里戈", "科尔-帕尔默", "布卡约-萨卡", "贾马尔-穆西亚拉"),
  Matches = c(8, 7, 8, 6, 5, 8, 7, 8, 6, 5, 8, 7, 8, 6, 5, 8 ,6, 7),
  Goals = c(6, 5, 10, 4, 2, 3, 4, 2, 6, 7, 3, 3, 4, 4, 8, 2, 5, 5),
  Assists = c(3, 4, 2, 1, 3, 4, 4, 5, 2, 7, 3, 8, 3, 9, 3, 2, 6, 4),
  xG = c(6.8, 4.5, 9.2, 5.1, 1.8, 6.8, 4.5, 9.2, 5.1, 1.8, 6.8, 4.5, 9.2, 5.1, 1.8, 6.8, 4.5, 9.2),
  KeyPasses = c(18, 15, 12, 10, 14, 11, 13, 14, 12, 14, 12, 9, 10, 12, 13, 12, 15, 17)
)

# 联赛数据
league_stats <- data.frame(
  League = c("英超", "西甲", "德甲", "法甲", "意甲"),
  AvgGoals = c(2.8, 2.6, 3.1, 2.7, 2.4),
  AvgPossession = c(54, 58, 52, 56, 53),
  AvgShots = c(13.2, 12.8, 14.1, 12.5, 11.9),
  TopScorer = c("哈兰德", "莱万", "凯恩", "马尔基尼奥斯", "劳塔罗"),
  TopScorerGoals = c(24, 20, 22, 21, 19)
)

# 教练战术数据
coaches_data <- data.frame(
  Coach = c("瓜迪奥拉", "安切洛蒂", "哈维", "阿隆索", "阿尔特塔"),
  Team = c("曼城", "皇马", "巴萨", "勒沃库森", "阿森纳"),
  Formation = c("4-3-3", "4-3-3", "4-3-3", "3-4-3", "4-3-3"),
  Pressing = c("高强度", "中强度", "中高强度", "高强度", "高强度"),
  AvgPossession = c(65, 58, 62, 55, 60),
  GoalsPerGame = c(2.5, 2.3, 2.1, 2.4, 2.2)
)

# 训练建议数据
training_data <- data.frame(
  Player = c("姆巴佩", "维尼修斯", "罗德里戈", "拉菲尼亚", "莱万", "哈兰德", "亚马尔"),
  StrengthFocus = c("爆发力", "盘带", "射门精度", "传中", "头球", "力量", "技术"),
  WeaknessFocus = c("防守贡献", "决策", "身体对抗", "防守意识", "速度", "灵活性", "经验"),
  RecommendedTraining = c("高强度间歇训练", "技术训练+决策训练", "射门训练+力量训练", 
                          "传中训练+防守训练", "核心力量训练", "灵活性训练", "技术训练+心理训练"),
  RecoveryTime = c(48, 72, 48, 48, 24, 48, 24)
)

# 受伤风险评估数据
injury_data <- data.frame(
  Player = c("姆巴佩", "维尼修斯", "罗德里戈", "拉菲尼亚", "莱万", "哈兰德", "亚马尔"),
  InjuryHistory = c("2次肌肉拉伤", "3次肌肉问题", "1次脚踝扭伤", "2次膝盖问题", 
                    "1次脚踝问题", "3次肌肉问题", "无"),
  InjuryRisk = c("中", "高", "中", "中", "低", "中", "低"),
  LastInjury = c("2024-02-15", "2024-03-10", "2023-11-20", "2024-01-05", 
                 "2023-09-12", "2024-02-28", "无"),
  RecoveryStatus = c("完全恢复", "恢复中", "完全恢复", "完全恢复", "完全恢复", "恢复中", "无")
)

ui <- dashboardPage(
  dashboardHeader(title = "足球数据分析平台"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("球员表现", tabName = "players", icon = icon("user")),
      menuItem("比赛数据", tabName = "matches", icon = icon("futbol")),
      menuItem("联赛统计", tabName = "leagues", icon = icon("trophy")),
      menuItem("教练战术", tabName = "coaches", icon = icon("clipboard")),
      menuItem("训练建议", tabName = "training", icon = icon("running")),
      menuItem("受伤风险", tabName = "injuries", icon = icon("heartbeat"))
    )
  ),
  dashboardBody(
    tabItems(
      # 球员表现模块
      tabItem(tabName = "players",
              fluidRow(
                box(title = "选择球员", width = 12,
                    selectInput("player_select", "选择球员:", 
                                choices = unique(players_data$Player),
                                selected = "姆巴佩")
                )
              ),
              fluidRow(
                box(title = "基本信息", width = 4,
                    tableOutput("player_info")
                ),
                box(title = "进球与助攻", width = 8,
                    plotlyOutput("goals_assists_plot")
                )
              ),
              fluidRow(
                box(title = "技术统计", width = 12,
                    plotlyOutput("tech_stats_plot")
                )
              )
      ),
      
      # 比赛数据模块
      tabItem(tabName = "matches",
              fluidRow(
                box(title = "欧冠表现", width = 12,
                    DTOutput("ucl_table")
                )
              ),
              fluidRow(
                box(title = "欧冠数据分析", width = 12,
                    selectInput("ucl_player", "选择球员:", 
                                choices = unique(ucl_data$Player),
                                selected = "姆巴佩"),
                    plotlyOutput("ucl_player_plot")
                )
              )
      ),
      
      # 联赛统计模块
      tabItem(tabName = "leagues",
              fluidRow(
                box(title = "五大联赛比较", width = 12,
                    plotlyOutput("league_comparison")
                )
              ),
              fluidRow(
                box(title = "联赛详细数据", width = 12,
                    DTOutput("league_table")
                )
              )
      ),
      
      # 教练战术模块
      tabItem(tabName = "coaches",
              fluidRow(
                box(title = "教练战术分析", width = 12,
                    selectInput("coach_select", "选择教练:", 
                                choices = unique(coaches_data$Coach),
                                selected = "瓜迪奥拉"),
                    plotlyOutput("coach_plot")
                )
              ),
              fluidRow(
                box(title = "所有教练数据", width = 12,
                    DTOutput("coaches_table")
                )
              )
      ),
      
      # 训练建议模块
      tabItem(tabName = "training",
              fluidRow(
                box(title = "选择球员查看训练建议", width = 12,
                    selectInput("training_player", "选择球员:", 
                                choices = unique(training_data$Player),
                                selected = "姆巴佩")
                )
              ),
              fluidRow(
                box(title = "训练重点", width = 6,
                    tableOutput("training_focus")
                ),
                box(title = "建议训练计划", width = 6,
                    verbatimTextOutput("training_plan")
                )
              )
      ),
      
      # 受伤风险模块
      tabItem(tabName = "injuries",
              fluidRow(
                box(title = "球员受伤风险评估", width = 12,
                    selectInput("injury_player", "选择球员:", 
                                choices = unique(injury_data$Player),
                                selected = "姆巴佩")
                )
              ),
              fluidRow(
                box(title = "受伤历史", width = 6,
                    tableOutput("injury_history")
                ),
                box(title = "风险分析", width = 6,
                    plotlyOutput("injury_risk_plot")
                )
              )
      )
    )
  )
)

server <- function(input, output) {
  
  # 球员表现模块
  selected_player <- reactive({
    players_data %>% filter(Player == input$player_select)
  })
  
  output$player_info <- renderTable({
    selected_player() %>% 
      select(Player, Club, League, Age, Goals, Assists)
  })
  
  output$goals_assists_plot <- renderPlotly({
    long_data <- selected_player() %>% 
      pivot_longer(cols = c(Goals, Assists), names_to = "Type", values_to = "Value")
    
    p <- long_data %>% 
      ggplot(aes(x = Type, y = Value, fill = Type)) +
      geom_bar(stat = "identity", width = 0.5) +
      labs(title = paste0(input$player_select, "的进球与助攻"), 
           x = "", y = "数量") +
      theme_minimal() +
      scale_fill_manual(values = c("Goals" = "#1f77b4", "Assists" = "#ff7f0e"))
    
    ggplotly(p)
  })
  
  output$tech_stats_plot <- renderPlotly({
    tech_data <- selected_player() %>% 
      select(ShotAccuracy, PassAccuracy, Dribbles) %>% 
      gather(key = "Metric", value = "Value")
    
    p <- ggplot(tech_data, aes(x = Metric, y = Value, fill = Metric)) +
      geom_bar(stat = "identity") +
      labs(title = paste0(input$player_select, "的技术统计"), 
           x = "", y = "百分比/每90分钟") +
      theme_minimal() +
      scale_fill_brewer(palette = "Set2")
    
    ggplotly(p)
  })
  
  # 比赛数据模块
  output$ucl_table <- renderDT({
    datatable(ucl_data, options = list(pageLength = 5))
  })
  
  output$ucl_player_plot <- renderPlotly({
    player_data <- ucl_data %>% filter(Player == input$ucl_player)
    
    p <- player_data %>% 
      select(Goals, Assists, xG, KeyPasses) %>% 
      gather(key = "Metric", value = "Value") %>% 
      ggplot(aes(x = Metric, y = Value, fill = Metric)) +
      geom_bar(stat = "identity") +
      labs(title = paste0(input$ucl_player, "的欧冠表现"), 
           x = "", y = "数量") +
      theme_minimal() +
      scale_fill_brewer(palette = "Set1")
    
    ggplotly(p)
  })
  
  # 联赛统计模块
  output$league_comparison <- renderPlotly({
    p <- league_stats %>% 
      ggplot(aes(x = League, y = AvgGoals, fill = League)) +
      geom_bar(stat = "identity") +
      labs(title = "五大联赛场均进球比较", 
           x = "联赛", y = "场均进球") +
      theme_minimal()
    
    ggplotly(p)
  })
  
  output$league_table <- renderDT({
    datatable(league_stats, options = list(pageLength = 5))
  })
  
  # 教练战术模块
  output$coach_plot <- renderPlotly({
    coach_data <- coaches_data %>% filter(Coach == input$coach_select)
    
    p <- coach_data %>% 
      select(AvgPossession, GoalsPerGame) %>% 
      gather(key = "Metric", value = "Value") %>% 
      ggplot(aes(x = Metric, y = Value, fill = Metric)) +
      geom_bar(stat = "identity") +
      labs(title = paste0(input$coach_select, "的战术特点"), 
           x = "", y = "数值") +
      theme_minimal() +
      scale_fill_manual(values = c("AvgPossession" = "#2ca02c", 
                                   "GoalsPerGame" = "#d62728"))
    
    ggplotly(p)
  })
  
  output$coaches_table <- renderDT({
    datatable(coaches_data, options = list(pageLength = 5))
  })
  
  # 训练建议模块
  output$training_focus <- renderTable({
    training_data %>% 
      filter(Player == input$training_player) %>% 
      select(StrengthFocus, WeaknessFocus)
  })
  
  output$training_plan <- renderPrint({
    plan <- training_data %>% 
      filter(Player == input$training_player) %>% 
      pull(RecommendedTraining)
    
    cat("推荐训练计划:\n\n", plan)
  })
  
  # 受伤风险模块
  output$injury_history <- renderTable({
    injury_data %>% 
      filter(Player == input$injury_player) %>% 
      select(InjuryHistory, LastInjury, RecoveryStatus)
  })
  
  output$injury_risk_plot <- renderPlotly({
    risk_data <- injury_data %>% 
      filter(Player == input$injury_player) %>% 
      mutate(RiskLevel = case_when(
        InjuryRisk == "高" ~ 3,
        InjuryRisk == "中" ~ 2,
        InjuryRisk == "低" ~ 1
      ))
    
    p <- ggplot(risk_data, aes(x = "风险等级", y = RiskLevel, fill = InjuryRisk)) +
      geom_bar(stat = "identity", width = 0.3) +
      scale_y_continuous(limits = c(0, 3)) +
      labs(title = paste0(input$injury_player, "的受伤风险等级"), 
           x = "", y = "") +
      theme_minimal() +
      scale_fill_manual(values = c("高" = "#d62728", "中" = "#ff7f0e", "低" = "#2ca02c"))
    
    ggplotly(p)
  })
}

shinyApp(ui, server)

Shiny applications not supported in static R Markdown documents

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.