0

我想从下拉列表中选择选项，这些选项作为不同的属性存储在我的数据框中，并使用滑块更改年份，以便我可以看到它对 valueCard 的影响。我被卡住的地方是，要找出如何从 df1 数据帧调用 pf_rol 属性以反映其在 valueCard 上的值。

我已经成功地创建了 2 个值卡，只需一个滑块即可操作，但现在我想使用滑块和 selectInput 来更改 ValueCard 'pfrol' 中的值。

PS：如果有人帮助绘制图表，我将不胜感激。我拥有所有国家/地区的名称，并且想操纵不同的属性以及滑块来观察变化的趋势，就像价值卡一样。

全球.r

df <-   read.csv("hfi_cc_2018.csv", header = T)

summary(df)
sapply(df, function(x) sum(is.na(x)))
#Replace Null Values
df[is.na(df)] <- 0
df[,5:ncol(df)] <- round(df[,5:ncol(df)], 2)

#adding selective columns new df1
#https://stackoverflow.com/questions/10085806/extracting-specific-columns-from-a-data-frame
df1<-  df[, (names(df) %in% c("year","countries","region","pf_rol", "pf_ss_homicide","pf_ss_disappearances_violent",    
))]

用户界面

require(shiny)
require(shinydashboard)

shinyUI(

  dashboardPage( 
    dashboardHeader(title = "Human Freedom Index", titleWidth = 300),
    dashboardSidebar(
      sliderInput("years","Select Year:",
                  min = min(df1$year),
                  max = max(df1$year),
                  value = min(df1$year),
                  step = 1),
      selectInput("variable","Select Freedom Factor:",
                  choices = list("Rule of Law"= "pf_rol",
                                 "Homicides Reported" = "pf_ss_homicide")
                  )
    ),

    dashboardBody(
        fluidRow(
        valueBoxOutput("pfrol"),  
        valueBoxOutput("pfrank"),
        valueBoxOutput("efrank")
      ),
      fluidRow(
        box(plotlyOutput("plot1"), width=15, height=400)
      )
    )
  )

)

服务器.r

require(shiny)
require(dplyr)
require(shinydashboard)

shinyServer(function(input,output){

   observe({
     (card <- df1 %>%
      filter(year == input$years))
    output$pfrank = renderValueBox(
      valueBox(round(mean(card$pf_score),1),
               "Personal Freedom Score")
    )

  })  

observe({

   if(input$variable == "Rule of Law"){
     if(filter(df1$year == input$years)){
       output$pfrol = renderValueBox(
         valueBox(round(mean(df1$pf_rol),1),
                  "Rule of Law")
       )
     }

   }

})

})

下面输出图片

4

1 回答 1

1

就像评论中建议的那样，如果你想使用闪亮的，看看如何使用反应和观察是必须的。官方教程真的讲了这一切：https ://shiny.rstudio.com/tutorial/

如果有人感兴趣，我会从 Kaggle 获得数据：https ://www.kaggle.com/gsutters/the-human-freedom-index

在这种情况下，我要做的是定义card为过滤年份的反应值，然后使用它来呈现输出，这就是我的意思：

全球的：

df <-   read.csv("hfi_cc_2018.csv", header = T)

# Replace Null Values
df[is.na(df)] <- 0
df[,5:ncol(df)] <- round(df[,5:ncol(df)], 2)

df1<-  df[, (names(df) %in% 
               c("year", "pf_rol", "pf_ss_homicide", "pf_score"))]

#  added this to global to get the label for the card
select_ops <- c("Rule of Law"= "pf_rol",
                "Homicides Reported" = "pf_ss_homicide")

用户界面：

library(shiny)
library(shinydashboard)

shinyUI(dashboardPage( 
  dashboardHeader(title = "Human Freedom Index", titleWidth = 300),
  dashboardSidebar(
    sliderInput("years","Select Year:",
                min = min(df1$year),
                max = max(df1$year),
                value = min(df1$year),
                step = 1),
    selectInput("variable","Select Freedom Factor:",
                choices = c("Rule of Law"= "pf_rol",
                            "Homicides Reported" = "pf_ss_homicide")
    )
  ),

  dashboardBody(
    fluidRow(
      valueBoxOutput("pfrol"),  
      valueBoxOutput("pfrank")
    ),
    fluidRow(
      box(width=15, height=400)
    )
  )
))

服务器：

library(shiny)
library(dplyr) 

shinyServer(function(input,output){
  card <- reactive(df1 %>%
                     filter(year == input$years))

  output$pfrank <- renderValueBox({
    valueBox(round(mean(card()$pf_score), 1),
             "Personal Freedom Score")
  })

  output$pfrol <- renderValueBox({
    lbl <- names(select_ops)[select_ops==input$variable]
    valueBox(round(mean(card() %>%  pull(input$variable)), 1),
             lbl)
  })

})
于 2019-06-03T13:11:56.070 回答