R 闪亮，具有自定义写入功能

Question

我尝试制作一个使用我编写的函数的闪亮应用程序。不幸的是，根据我如何尝试将该功能合并到应用程序的服务器中，我遇到了各种错误。 这是函数：

match_predictor <- function(home_team, away_team, league){
  if (!('scales' %in% installed.packages())){install.packages('scales')}
  library(scales)
  if (!(home_team %in% league$team)){warning('Home team not found.')}
  if (!(away_team %in% league$team)){stop('Away team not found.')}
  if (home_team == away_team){stop('Home team can not be equal to away team.')}    
  average_goals_scored_in_league <- sum(league$goals_for)/sum(league$matches_played)
  attack_rating <- rep(0, nrow(league))
  defense_rating <- rep(0, nrow(league))
  league$attack_rating <- attack_rating
  league$defense_rating <- defense_rating
  
  for (i in 1:nrow(league)){
    league$attack_rating[i] = (league$goals_for[i]/league$matches_played[i]) / average_goals_scored_in_league
    league$defense_rating[i] = (league$goals_against[i]/league$matches_played[i]) / average_goals_scored_in_league
  }
  
  home_idx <- which(league$team == home_team, arr.ind=TRUE)
  away_idx <- which(league$team == away_team, arr.ind=TRUE)
  
  home_expGoals <- league$attack_rating[home_idx] * league$defense_rating[away_idx] * average_goals_scored_in_league
  away_expGoals <- league$attack_rating[away_idx] * league$defense_rating[home_idx] * average_goals_scored_in_league
  
  possible_goals <- seq(0,15)
  col2 <- rep(0, length(possible_goals))
  col3 <- rep(0, length(possible_goals))
  col4 <- rep(0, length(possible_goals))
  col5 <- rep(0, length(possible_goals))
  pred_df <- data.frame(possible_goals, col2, col3, col4, col5)
  colnames(pred_df) <- c('possible_goals', home_team, away_team, paste0(home_team, "_win_chance"), paste0(away_team, "_win_chance"))
  
  for (i in 1:nrow(pred_df)){
    pred_df[i,2] <- dpois(x = pred_df$possible_goals[i], lambda = home_expGoals)
    pred_df[i,3] <- dpois(x = pred_df$possible_goals[i], lambda = away_expGoals)
  }
  for (j in 2:nrow(pred_df)){
    pred_df[j,4] <- pred_df[j,2] * sum(pred_df[1:j-1,3])
    pred_df[j,5] <- pred_df[j,3] * sum(pred_df[1:j-1,2])
  }
  
  column1 <- rep(0,1)
  column2 <- rep(0,1)
  column3 <- rep(0,1)
  result_df <- data.frame(column1, column2, column3)
  colnames(result_df) <- c(paste0(home_team, "_win_chance"), paste0(away_team, "_win_chance"), 'draw_chance')
  result_df[1,1] <- sum(pred_df[,4])
  result_df[1,2] <- sum(pred_df[,5])
  result_df[1,3] <- 1 - result_df[1,1] - result_df[1,2]
  result_df[1,1] <- label_percent()(result_df[1,1])
  result_df[1,2] <- label_percent()(result_df[1,2])
  result_df[1,3] <- label_percent()(result_df[1,3])
  
  list(details = pred_df, prediction = result_df)
}

这是我成功制作的 Shiny 应用程序的一部分（服务器部分中的伪代码）：

ui <- fluidPage(
    titlePanel("Soccer game prediction model."),
    sidebarLayout(
      sidebarPanel(
        selectInput('league', 'Select league', choices = c('laliga', 'serieA', 'bundesliga', 'ligue1', 'premierleague'), 'laliga'),
        
        conditionalPanel(
          condition = "input.league == 'laliga'",
          selectInput('home_team', 'Select home team', unique(laliga$team)),
          selectInput('away_team', 'Select away team', unique(laliga$team))
        ),
        
        conditionalPanel(
          condition = "input.league == 'serieA'",
          selectInput('home_team', 'Select home team', unique(serieA$team)),
          selectInput('away_team', 'Select away team', unique(serieA$team))
        ),
        
        conditionalPanel(
          condition = "input.league == 'bundesliga'",
          selectInput('home_team', 'Select home team', unique(bundesliga$team)),
          selectInput('away_team', 'Select away team', unique(bundesliga$team))
        ),
        
        conditionalPanel(
          condition = "input.league == 'ligue1'",
          selectInput('home_team', 'Select home team', unique(ligue1$team)),
          selectInput('away_team', 'Select away team', unique(ligue1$team))
        ),
        
        conditionalPanel(
          condition = "input.league == 'premierleague'",
          selectInput('home_team', 'Select home team', unique(premierleague$team)),
          selectInput('away_team', 'Select away team', unique(premierleague$team))
        ),
        
      ),
      mainPanel(
        #tableOutput('table_out')
        DT::DTOutput("table_out")
      )
    )
)

server <- function(input, output, session){
  myfun <- reactive({})
  output$table_out <- DT::renderDT({myfun()})
}

shinyApp(ui = ui, server = server)

任何帮助表示赞赏！

亲切的问候， 雅各布

Answer 1

在服务器端，似乎你从未调用过你的函数。

我会从反应内部调用该函数。为了避免错误，还为每个所需的输入添加一个

req()

参数（否则定义默认值）。

server <- function(input, output, session){
  myfun <- reactive({
req(input$league)
req(input$away_team)
req(input$home_team)

match_predictor(input$home_team,input$away_team,input$league
) 

})
  output$table_out <- DT::renderDT({myfun()})
}