Question

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

我已经成功创建了2张价值卡，仅可以通过一个滑块进行操作，但是现在我想使用滑块和selectInput来更改ValueCard'pfrol'中的值。

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

global.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",    
))]

ui.r

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)
      )
    )
  )

)

server.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")
       )
     }

   }

})

})

output image below

Answer 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")

ui：

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)
  })

})

如何使用selectInput从R中的数据框中选择特定的列？

1 个答案:

全局：

ui：

服务器：