Question

我遇到两个问题，也许它们可能是单独的问题。但是，由于shiny具有一系列特殊性，因此我决定在此声明两个问题。

（I）第一个问题与facet_grid一起使用slideInput函数。由于某种原因，该子设置似乎不在某个范围内工作，而只是选择了滑块的极值。

（我想让图表显示范围，而不是每个极端中选取的值）

（II）第二个问题与样本数据（Company_Name）中sample_data变量的排序有关。我无法在Year的组内应用排序，因此我的条形图按年份排序。

（我希望按每年的顺序排序值）

这是代码：

library(shiny)
library(ggplot2)
library(dplyr)


sample_data = data.frame(Company_Name=c("Company 1","Company 2","Company 3",
                                        "Company 1","Company 2","Company 3",
                                        "Company 1","Company 2","Company 3"),
                         Profits_MM = c(20,100,80,
                                        45,120,70,
                                        50,110,130),
                         Sales_MM = c(200,800,520,
                                      300,1000,630,
                                      410,1150,1200),
                         Year=c(2016,2016,2016,
                                2017,2017,2017,
                                2018,2018,2018))


# UI
ui <- fluidPage(

  sidebarLayout(

    # Input(s)
    sidebarPanel(

      checkboxGroupInput(inputId = "sel_com",
                         label = "Company Selection:",
                         choices = c("Company 1","Company 2","Company 3"),
                         selected = "Company 1"),


      selectInput(inputId = "y", 
                  label = "Performance Variable",
                  choices = c("Profits (in Millions)" = "Profits_MM", 
                              "Sales (in Millions)" = "Sales_MM"),
                  selected = "Profits_MM"),


      sliderInput("year","Year Selection:",
                  min=2016,
                  max=2018,
                  value=c(2017,2018),
                  step=1)


    ),

    # Output(s)
    mainPanel(
      plotOutput(outputId = "barplot")
    )
  )
)

# Server
server <- function(input, output, session) {

  companies_sel <- reactive({

    req(input$sel_com)

    sample_data_gg = filter(sample_data, Company_Name %in% input$sel_com)
    #  print(sample_data_gg)
    sample_data_gg

  })

  year_sample <- reactive({

    req(input$year)
    sample_data_gg = sample_data
    if(length(input$year)>1){

      Years = seq(input$year[1],input$year[2])

      sample_data_gg = filter(companies_sel(), Year %in% Years)

    }  

    if(length(input$year==1)){

      sample_data_gg = filter(companies_sel(), Year %in% input$year)

    }
    #  print(sample_data_gg)
    sample_data_gg
  })


  output$barplot = renderPlot({

    sample_data_gg = year_sample()

    sample_data_gg = sample_data_gg %>%
                     group_by(Year) %>%
                     mutate(Sigla = factor(Company_Name, 
                                           levels = Company_Name[order(input$y)]))

    y <- input$y
    ggplot(data = sample_data_gg, aes(x=Company_Name, y =get( y ))) +
    geom_col(position="dodge", fill="darkred") +
    facet_grid(Year~., scales = "free_y")  +
    theme(axis.text.x = element_text(angle = 60, hjust = 1)) 


  })

}

shinyApp(ui = ui, server = server)

这个问题与此here

有关

修改：使用此question中作为答案发布的函数来完成问题II的工作：

reorder_within <- function(x, by, within, fun = mean, sep = "___", ...) {
  new_x <- paste(x, within, sep = sep)
  stats::reorder(new_x, by, FUN = fun)
}

scale_x_reordered <- function(..., sep = "___") {
  reg <- paste0(sep, ".+$")
  ggplot2::scale_x_discrete(labels = function(x) gsub(reg, "", x), ...)
}

并将渲染图更改为：

sample_data_gg = year_sample()

y <- input$y
ggplot(data = sample_data_gg, aes(x=reorder_within(Company_Name, get( y ), Year), y = get( y ))) +
  geom_col(position="dodge", fill="darkred") +
  facet_wrap(Year~., scales = "free")  +
  scale_x_reordered() +
  theme(axis.text.x = element_text(angle = 60, hjust = 1))

Answer 1

您的第一个问题是由于您的if条件所致，因为输入的长度始终为1。我将用以下内容替换它

library(shiny)
library(ggplot2)
library(dplyr)

sample_data = data.frame(Company_Name=c("Company 1","Company 2","Company 3",
                                        "Company 1","Company 2","Company 3",
                                        "Company 1","Company 2","Company 3"),
                         Profits_MM = c(20,100,80,
                                        45,120,70,
                                        50,110,130),
                         Sales_MM = c(200,800,520,
                                      300,1000,630,
                                      410,1150,1200),
                         Year=c(2016,2016,2016,
                                2017,2017,2017,
                                2018,2018,2018))


# UI
ui <- fluidPage(

  sidebarLayout(

    # Input(s)
    sidebarPanel(

      checkboxGroupInput(inputId = "sel_com",
                         label = "Company Selection:",
                         choices = c("Company 1","Company 2","Company 3"),
                         selected = "Company 1"),


      selectInput(inputId = "y", 
                  label = "Performance Variable",
                  choices = c("Profits (in Millions)" = "Profits_MM", 
                              "Sales (in Millions)" = "Sales_MM"),
                  selected = "Profits_MM"),


      sliderInput("year","Year Selection:",
                  min=2016,
                  max=2018,
                  value=c(2017,2018),
                  step=1)


    ),

    # Output(s)
    mainPanel(
      plotOutput(outputId = "barplot")
    )
  )
)

# Server
server <- function(input, output, session) {

  companies_sel <- reactive({

    req(input$sel_com)

    sample_data_gg = filter(sample_data, Company_Name %in% input$sel_com)
    #  print(sample_data_gg)
    sample_data_gg

  })

  year_sample <- reactive({

    req(input$year)
    sample_data_gg = sample_data
    if((input$year[2] - input$year[1])>1){

      Years = seq(input$year[1],input$year[2])

      sample_data_gg = filter(companies_sel(), Year %in% Years)

    }  

    if((input$year[2] - input$year[1])==1){

      sample_data_gg = filter(companies_sel(), Year %in% input$year)

    }
    #  print(sample_data_gg)
    sample_data_gg
  })


  output$barplot = renderPlot({

    sample_data_gg = year_sample()

    sample_data_gg = sample_data_gg %>%
      group_by(Year) %>%
      mutate(Sigla = factor(Company_Name, 
                            levels = Company_Name[order(input$y)]))

    y <- input$y
    ggplot(data = sample_data_gg, aes(x=Company_Name, y =get( y ))) +
      geom_col(position="dodge", fill="darkred") +
      facet_grid(Year~., scales = "free_y")  +
      theme(axis.text.x = element_text(angle = 60, hjust = 1))


  })

}

shinyApp(ui = ui, server = server)

将facet_wrap与sliderInput配合使用，可以显示光泽和顺序值

1 个答案: