使用shiny实现对年、季度、月取值的连锁更新

实现目标

点击按钮年预算更新对所有的提升百分比更新 点击按钮季度预算更新对对应季度以及季度对应的月份的提升百分比更新 点击按钮月份预算更新对对应月份的提升百分比更新

代码

global.R

# 小数转化为百分数输出
numtop <- function(num, p=2){
  num1 <- num * 100
  formt <- paste0("%.", p, "f")
  percent <- sprintf(formt, num1)
  percent <- paste0(percent, "%")
  percent
}

# 年的预算提升百分比初始值
bg_year <- data.frame(year=2016,
                         bg_year_pct=3)
                         
# 季度的预算提升百分比初始值
bg_quarter <- data.frame(quarter=1:4,
                         bg_quarter_pct=3)

# 月度的预算提升百分比初始值
bg_month <- data.frame(month=1:12,
                       quarter=rep(1:4, each=3),
                       bg_month_pct=3)

ui.R

library(shiny)
library(shinydashboard)

shinyUI(
  dashboardPage(
    dashboardHeader(title = "门店销售预算达成分析"),
    
    dashboardSidebar(
      sidebarMenu(
        menuItem("预算百分比设置", tabName = "tab_budget", icon = icon("gear"))
      )
    ),
    
    dashboardBody(
      tabItems(
        tabItem(tabName = "tab_budget",
                fluidRow(
                  box(collapsible = TRUE,
                    solidHeader = TRUE, background = "orange", width = 4,height = 140,
                    textInput("bg_year", "年预算", 3),
                    actionButton('btn_year',"年预算更新")
                  ),
                  
                  box("年预算", collapsible = TRUE,
                    solidHeader = TRUE, background = "navy", width = 5, height = 140,
                    tableOutput("tab_bg_year")
                  ),

                  box(collapsible = TRUE,
                      solidHeader = TRUE, background = "orange", width = 4,height = 240,
                      selectInput("slt_quarter", label = "季度", 
                                  choices = unique(bg_quarter$quarter), 
                                  selected = unique(bg_quarter$quarter)[1]),
                      textInput("num_quarter", label = "季度预算提升百分比", value = 3),
                      actionButton('btn_quarter',"季度预算更新")
                  ),
                  
                  box("季度预算", collapsible = TRUE,
                      solidHeader = TRUE, background = "navy", width = 5, height = 240,
                      tableOutput("tab_bg_quarter")
                  ),

                  
                  box(collapsible = TRUE,
                      solidHeader = TRUE, background = "orange", width = 4,height = 300,
                      selectInput("slt_month", label = "月度", 
                                  choices = unique(bg_month$month), 
                                  selected = unique(bg_month$month)[1]),
                      textInput("num_month", label = "月度预算提升百分比", value = 3),
                      actionButton('btn_month',"月度预算更新")
                  ),
                  
                  box("月度预算", collapsible = TRUE,
                      solidHeader = TRUE, background = "navy", width = 5, height = 460,
                      tableOutput(outputId="tab_bg_month")
                  )
                )
        )
      )
    )
  )
)

server.R

library(shiny)
library(shinydashboard)

shinyServer(function(input, output) {
  ##########################
  ### 预算提升百分比设置 ###
  ##################
  bg_year_update <- reactiveValues(dat=NULL)
  observe({
    bg_year_update$dat <- bg_year
  })
  
  bg_quarter_update <- reactiveValues(dat=NULL)
  observe({
    bg_quarter_update$dat <- bg_quarter
  })
  
  bg_month_update <- reactiveValues(dat=NULL)
  observe({
    bg_month_update$dat <- bg_month
  })
  
  observe({
    if(input$btn_year){
      isolate({
        num <- input$bg_year
        bg_year_update$dat$bg_year_pct <- num
        bg_quarter_update$dat$bg_quarter_pct <- num
        bg_month_update$dat$bg_month_pct <- num
      })
    }
    
    if(input$btn_quarter){
      isolate({
        num <- input$num_quarter
        sel <- input$slt_quarter
        bg_quarter_update$dat$bg_quarter_pct[bg_quarter_update$dat$quarter==sel] <- num
        bg_month_update$dat$bg_month_pct[bg_month_update$dat$quarter==sel] <- num 
      })
    }
    
    if(input$btn_month){
      isolate({
        num <- input$num_month
        sel <- input$slt_month
        bg_month_update$dat$bg_month_pct[bg_month_update$dat$month==sel] <- num 
      })
    }
  })
 
  output$tab_bg_year <- renderTable({
    tmp <- bg_year_update$dat
    tmp$year <- paste(tmp$year, "年", sep="")
    tmp$bg_year_pct <- numtop(as.numeric(tmp$bg_year_pct) / 100)
    names(tmp) <- c("年", "提升百分比")
    tmp
  })

  output$tab_bg_quarter <- renderTable({
    tmp <- bg_quarter_update$dat
    tmp$quarter <- paste(tmp$quarter, "季度", sep="")
    tmp$bg_quarter_pct <- numtop(as.numeric(tmp$bg_quarter_pct) / 100)
    names(tmp) <- c("季度", "提升百分比")
    tmp
  })

  output$tab_bg_month <- renderTable({
    tmp <- bg_month_update$dat
    tmp$month <- paste(tmp$month, "月份", sep="")
    tmp$quarter <- paste(tmp$quarter, "季度", sep="")
    tmp$bg_month_pct <- numtop(as.numeric(tmp$bg_month_pct) / 100)
    names(tmp) <- c("月份", "季度", "提升百分比")
    tmp
  })
})

• 更新（2018-03-06）：直接使用update控件(如：updateSelectInput)+observer/observeEvent监听事件的方式实现