在闪亮应用的MLR模型中添加和删除动态数量的因变量

e4eetjau  于 2023-05-04  发布在  其他
关注(0)|答案(1)|浏览(125)

我有下面的shiny应用程序,我每次都想使用一个闪亮的小部件在我的多元线性回归模型中添加另一个自变量,但我无法使其正常工作,而且我也不知道我最终会使用多少变量。我希望能够使用它们全部。

## app.R ##
library(shiny)
library(shinydashboard)
library(htmlwidgets)
library(ggplot2)
library(tidyverse)
library(dplyr)

diamonds<-structure(list(`Approved Amount_UA Equivalent` = c(2219168628.96743, 
7910915006.08302, 2945430613.82441, 566728468.043035, 88329573, 
1358334742.43214, 154458822.437869, 2277782734.89826, 741826741.108259, 
847582159.129072, 1073340403.95213, 69304767.7924836, 1996421218.60972, 
2285448543.98486, 1219425905.30524, 416052930.270822, 475569814.997042, 
110213600.606809, 1877512072.92976, 878178278.897963, 394121308.069995, 
794940791.885493, 870570569.250428, 2223818025.07865, 290476596.417383, 
262411644.388115, 49919237.6842862, 607024212.811439, 3034312319.45931, 
1116549963.55694, 109407208.224749, 137384009.609597, 369189707.097464, 
52384648.6575371, 3361231217.85468, 1171720315.61533, 167729174.793072, 
165214259.038085, 112288377.271093, 42620991.164361, 172482696.513884, 
466392209.103056, 744915930.376353, 136037687.882746, 101003400, 
155411250.451016, 408189979.586085, 107200000, 194742957.590488, 
349454434.398465, 389223626.467406, 118593779.953281, 1087745585.21858, 
214083569.432016, 102227495.089862, 3944346.17544808, 717068623.467266, 
62312088.8481568, 3186850.5368895, 66931325.4734835, 15331250.3471359, 
348913.280511739, 1.56e+08, 31042195.248091), `Approved Amount_USDEquivalent` = c(2958151782.41359, 
10545249703.1087, 3926259008.22793, 755449047.901366, 117743320.809, 
1810660211.66204, 205893610.30968, 3036284385.61938, 988855045.89731, 
1129827018.11905, 1430762758.46818, 92383255.4673806, 2661229484.40675, 
3046502909.13181, 1625494731.77189, 554598556.051006, 633934563.391057, 
146914729.608877, 2502723593.21537, 1170611645.77098, 525363703.657303, 
1059656075.58336, 1160470568.81082, 2964349427.42984, 387205303.024371, 
349794721.969357, 66542343.8331535, 809163275.677648, 4044738321.83925, 
1488361101.4214, 145839808.56359, 183132884.809593, 492129879.560919, 
69828736.660497, 4480521213.40029, 1561903180.71523, 223582989.999166, 
220230607.297767, 149680406.902367, 56813781.2220932, 229919434.453008, 
621700814.734373, 992972935.191679, 181338237.9477, 134637532.2, 
207163196.851204, 544117242.788252, 142897600, 259592362.468121, 
465822761.053154, 518835094.081052, 158085508.677723, 1449964865.09637, 
285373398.052877, 136269250.954786, 5257813.45187228, 955852475.081865, 
83062014.4345929, 4248071.76567371, 89219456.8561535, 20436556.7127322, 
465101.402922149, 207948000, 41379246.2657053), `High Five Prority 1: Feed Africa` = c(NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, 143413724.693453, NA, 95605.5161066851, 
49742936.0998292, NA, NA, NA, 31042195.248091), `High Five Prority 2: Light Up And Power Africa` = c(NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, 143413724.693453, NA, 31868.505368895, 
NA, NA, NA, NA, NA), `High Five Prority 3: Industrialize Africa` = c(NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
160494711.235755, NA, NA, NA, NA, NA, NA, 143413724.693453, NA, 
NA, NA, NA, NA, 1.56e+08, NA), `High Five Prority 4: Integrate Africa` = c(NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, 143413724.693453, NA, NA, NA, NA, 
NA, NA, NA), `High Five Prority 5: Improve Quality Of Life` = c(NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 27698877.7418283, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 143413724.693453, 
NA, 3059376.51541392, NA, NA, 348913.280511739, NA, NA), `NUMBER OF PROJECT` = c(38, 
265.805555555556, 47, 22, 6, 27, 16, 42, 20.5, 26, 11, 6, 30, 
21, 12, 23, 19, 10, 27, 18, 20.1666666666667, 24, 29.5, 46.5, 
28, 12, 8, 28, 49, 23, 14.5, 17, 6, 6, 35, 12, 23, 13, 18, 3, 
15.8333333333333, 25, 26, 16, 8, 7.5, 30, 9, 15, 4, 10, 19, 17, 
13, 12, 1.5, 1, 5, 1, 2, 2, 1, 1, 1), `Amount in UA Million` = c(2219.16862896743, 
7910.91500608303, 2945.43061382441, 566.728468043035, 88.329573, 
1358.33474243214, 154.458822437869, 2277.78273489826, 741.82674110826, 
847.582159129072, 1073.34040395213, 69.3047677924836, 1996.42121860972, 
2285.44854398486, 1219.42590530524, 416.052930270822, 475.569814997042, 
110.213600606809, 1877.51207292976, 878.178278897963, 394.121308069995, 
794.940791885493, 870.570569250428, 2223.81802507865, 290.476596417383, 
262.411644388115, 49.9192376842862, 607.024212811439, 3034.31231945931, 
1116.54996355694, 109.407208224749, 137.384009609597, 369.189707097464, 
52.3846486575371, 3361.23121785468, 1171.72031561533, 167.729174793072, 
165.214259038085, 112.288377271093, 42.620991164361, 172.482696513884, 
466.392209103056, 744.915930376353, 136.037687882746, 101.0034, 
155.411250451016, 408.189979586085, 107.2, 194.742957590488, 
349.454434398465, 389.223626467406, 118.593779953281, 1087.74558521858, 
214.083569432016, 102.227495089862, 3.94434617544808, 717.068623467266, 
62.3120888481568, 3.1868505368895, 66.9313254734835, 15.3312503471359, 
0.348913280511739, 156, 31.042195248091)), row.names = c(NA, 
-64L), class = c("tbl_df", "tbl", "data.frame"))
# app page
ui <- dashboardPage(
  dashboardHeader(
    title = "Task Managers' Workload Analysis",
    titleWidth = 400
  ),
  dashboardSidebar(
    uiOutput("var_selection")
  ),
  dashboardBody(
    verbatimTextOutput("mlr_output")
  )
)

 # server side actions
server <- function(input, output, session) {
  
  # UI for variable selection based on available columns in the data
  output$var_selection <- renderUI({
    colnames <- colnames(diamonds)[-8]
    selectInput(
      "vars", 
      "Select variables", 
      choices = colnames, 
      selected = colnames[1], 
      multiple = TRUE
    )
  })
  
  # Reactively select the data based on selected variables
  data <- reactive({
    select(diamonds, contains("NUMBER OF PROJECTS"), input$vars)
  })
  
  # run multiple linear regression model, on selecting the variables
  model <- reactive({
    formula <- as.formula(paste0("NUMBER OF PRODUCTS ~ ", paste(input$vars, collapse = "+")))
    lm(formula, data = data())
  })
  
  # print summary of regression model above
  output$mlr_output <- renderPrint({
    summary(model())
  })
  
} 

shinyApp(ui, server)
3ks5zfa0

3ks5zfa01#

下面是修改后的代码(请注意,我已经包含了几个包,在运行代码之前必须安装):

## app.R ##
library(shiny)
library(shinydashboard)
library(htmlwidgets)
library(ggplot2)
library(tidyverse)
library(dplyr)
data(diamonds)

# app page
ui <- dashboardPage(
  dashboardHeader(
    title = "Task Managers' Workload Analysis",
    titleWidth = 400
  ),
  dashboardSidebar(
    uiOutput("var_selection")
  ),
  dashboardBody(
    verbatimTextOutput("mlr_output")
  )
)

 # server side actions
server <- function(input, output, session) {
  
  # UI for variable selection based on available columns in the data
  output$var_selection <- renderUI({
    colnames <- colnames(diamonds)[c(1, 5, 6, 8, 9, 10)]
    selectInput(
      "vars", 
      "Select variables", 
      choices = colnames, 
      selected = colnames[1], 
      multiple = TRUE
    )
  })
  
  # Reactively select the data based on selected variables
  data <- reactive({
    select(diamonds, contains("price"), input$vars)
  })
  
  # run multiple linear regression model, on selecting the variables
  model <- reactive({
    formula <- as.formula(paste0("price ~ ", paste(input$vars, collapse = "+")))
    lm(formula, data = data())
  })
  
  # print summary of regression model above
  output$mlr_output <- renderPrint({
    summary(model())
  })
  
} 

shinyApp(ui, server)

当我运行这段代码时,我看到的输出是:

让我知道如果这有帮助...
对于包含以下内容的数据集:

str(diamonds)
tibble [64 × 9] (S3: tbl_df/tbl/data.frame)
 $ Approved Amount_UA Equivalent                 : num [1:64] 2.22e+09 7.91e+09 2.95e+09 5.67e+08 8.83e+07 ...
 $ Approved Amount_USDEquivalent                 : num [1:64] 2.96e+09 1.05e+10 3.93e+09 7.55e+08 1.18e+08 ...
 $ High Five Prority 1: Feed Africa              : num [1:64] NA NA NA NA NA NA NA NA NA NA ...
 $ High Five Prority 2: Light Up And Power Africa: num [1:64] NA NA NA NA NA NA NA NA NA NA ...
 $ High Five Prority 3: Industrialize Africa     : num [1:64] NA NA NA NA NA NA NA NA NA NA ...
 $ High Five Prority 4: Integrate Africa         : num [1:64] NA NA NA NA NA NA NA NA NA NA ...
 $ High Five Prority 5: Improve Quality Of Life  : num [1:64] NA NA NA NA NA NA NA NA NA NA ...
 $ NUMBER OF PROJECT                             : num [1:64] 38 266 47 22 6 ...
 $ Amount in UA Million                          : num [1:64] 2219.2 7910.9 2945.4 566.7 88.3 ...

你应该修改上面的shiny app代码:

ui <- dashboardPage(
  dashboardHeader(
    title = "Task Managers' Workload Analysis",
    titleWidth = 400
  ),
  dashboardSidebar(
    selectInput(
      "vars", 
      "Select variables", 
      choices = c(
        "Approved_Amt_UA" = "Approved Amount_UA Equivalent",
        "Approved_Amt_USD" = "Approved Amount_USDEquivalent",
        "HFP1FA" = "High Five Prority 1: Feed Africa",
        "HFP2LP" = "High Five Prority 2: Light Up And Power Africa",
        "HFP3IA" = "High Five Prority 3: Industrialize Africa",
        "HFP4IA" = "High Five Prority 4: Integrate Africa",
        "HFP5IQL" = "High Five Prority 5: Improve Quality Of Life",
        "NUMBER OF PROJECT" = "Num_of_Projects",
        "Amount in UA Million" = "Amt_in_UA_Million"
      ),
      selected = "Approved_Amt_UA",
      multiple = TRUE
    )
  ),
  dashboardBody(
    verbatimTextOutput("mlr_output")
  )
)

相关问题