R Shiny无法根据活动选项卡获取条件checkboxGroupInput

时间:2020-11-27 14:29:37

I want to have different CheckboxGroupInput column selectors to be visible based on the tab that I have selected but when I switch on the output conditions for the the two column selector UI's, the data loads but does not render and neither do the column selectors. I could make it work when I just had the main panel without two tabs. I have been at it for 2 days and I just don't know the syntax to make this work. I would be very grateful for some help as I am a beginner on Shiny.

我希望根据我选择的选项卡显示不同的CheckboxGroupInput列选择器,但是当我打开两列选择器UI的输出条件时,数据会加载但不会呈现,列选择器也不会。当我没有两个标签的主面板时,我可以使它工作。我已经在这2天了,我只是不知道使这项工作的语法。我非常感谢一些帮助,因为我是Shiny的初学者。

ui.R

shinyUI(fluidPage(

    titlePanel("Interrogate RSQRM Models"),

    sidebarLayout(

        sidebarPanel(

            selectInput("model", label = h4("Select Model"), 
                        choices = c("RSQRM Global", "RSQRM Europe","RSQRM US","RSQRM Japan","RSQRM Asia ex-JP","RSQRM Resource","RSQRM LatAm"), selected = 'RSQRM Europe'),

            uiOutput("modelCurrency"),

            dateInput("modelDate", 
                      label = h4("Select Model Date"),
                      value = getDateforLatestWednesday(Sys.Date())),

            conditionalPanel(
                condition = "input.model == 'RSQRM Europe' & input.modelCurrency != 'GBP'",
                radioButtons("modelVersion", label = h6("L or G Version"),
                             choices = c("Local Currency Exposure", "Global Currency Exposure"),selected = "Global Currency Exposure")),

            conditionalPanel(
                condition = "input.RSQRM == 'assetData'",
            uiOutput("selectAssetCols")),

            conditionalPanel(
                condition = "input.RSQRM == 'stockBetas'",
                uiOutput("selectBetaCols"))

            ,width=2),

        mainPanel(
            tabsetPanel(id='RSQRM',
                tabPanel("Asset Data", fluidRow(dataTableOutput(outputId="assetData"))), 
                tabPanel("Stock Betas", fluidRow(dataTableOutput(outputId="stockBetas")))#, 
#                 tabPanel("Correlation Matrix", dataTableOutput("corrMatrix")),
#                 tabPanel("Risk Factor Returns", dataTableOutput("risFacRet"))
            )
            ,width=10)
    )
))

==============

==============

server.R

library(timeDate);library(data.table)
source("helper.R")

# Define a server for the Shiny app
shinyServer(function(input, output,session) {

    sModel <- reactive({
        switch(input$model,"RSQRM Global"='GlobalDev',
               "RSQRM Europe"='Europe',
               "RSQRM US"='US',
               "RSQRM Japan"='Japan',
               "RSQRM Asia ex-JP"='AsiaExJP',
               "RSQRM Resource"='Resource',
               "RSQRM LatAm"='LatAm')
    })

    sModelVersion <- reactive({
        switch( input$modelVersion, "Local Currency Exposure"="", "Global Currency Exposure"="_G")
    })

    sModelDate<-reactive({
        input$modelDate
    })

    output$modelCurrency <- renderUI({

        sCurrency<- reactive({
            fillCurrency(sModel=sModel())
        })

        selectInput('modelCurrency', label = h4("Select Model Currency"), choices=sCurrency(),selected=sCurrency()[1])

    })

    #Load Asset Data File
    dfAssetData <- reactive({
        readAssetDataFile(sModel=sModel(),sModelCurrency=input$modelCurrency,sModelDate=sModelDate(),sModelVersion=sModelVersion())
    })

    #Load Stock Betas File
    dfStockBeta <- reactive({
        readStockBetaFile(sModel=sModel(),sModelCurrency=input$modelCurrency,sModelDate=sModelDate(),sModelVersion=sModelVersion())
    })


#     output$selectAssetCols <- renderUI({                                       
#                                 # Get the data set with the appropriate name
#                                 dat <- dfAssetData()
#                                 colnames <- names(dat)
#                                 sSelected<- c('RSQID','Parent ID','Currency of Quotation','Domicile','Exchange Country','Name','Base Currency Mkt Cap','sedol','Industry Code')
#                                 
#                                 # Create the checkboxes and select them all by default
#                                 
#                                 checkboxGroupInput("assetCols", h6("Select columns"),
#                                                choices = colnames,
#                                                selected = sSelected)
#                                     })
#     
#     output$selectBetaCols <- renderUI({
#                                 # Get the data set with the appropriate name
#                                 dat <- dfStockBeta()
#                                 colnames <- names(dat)
#                                 
#                                 # Create the checkboxes and select them all by default
#                                 
#                                 checkboxGroupInput("betaCols", h6("Select columns"),
#                                                    choices = colnames,
#                                                    selected = colnames)
#                                     })


    output$assetData <- renderDataTable({
        dat <- dfAssetData()

#         dat <- dat[, input$assetCols, drop = FALSE]
        dat
    },options = list(aLengthMenu = c(15, 20, 25, 30),iDisplayLength = 15))

    output$stockBetas <- renderDataTable({
        dat <- dfStockBeta()

#         dat <- dat[, input$betaCols, drop = FALSE]
        dat
    },options = list(aLengthMenu = c(15, 20, 25, 30),iDisplayLength = 15))

})

==============

==============

helper.R

library('Hmisc');library(timeDate)

    #Select Latest Wednesday
    getDateforLatestWednesday<- function(x)
    {
        oDate<-as.Date((x-7):x,origin='1970-01-01')
        oDate<-oDate[weekdays(oDate)=='Wednesday']
        return(oDate)
    }

    # Select Currency based on model
    fillCurrency<-function(sModel)
    {
        if(sModel=='GlobalDev')
        {
            sCurrency = c("EUR","USD","GBP")
        } else if (sModel=='Europe')
        {
            sCurrency = c("EUR","GBP","TRY")
        } else if (sModel=='US')
        {
            sCurrency = c("USD")
        } else if (sModel=='Japan')
        {
            sCurrency = c("JPY")
        } else if (sModel=='AsiaExJP')
        {
            sCurrency = c("USD")
        } else if (sModel=='Resource')
        {
            sCurrency = c("AUD","USD")
        } else if (sModel=='LatAm')
        {
            sCurrency = c("USD")
        }
        return(as.vector(sCurrency))
    }

    # Read Asset Data File along with market ids and industry data files 
    readAssetDataFile <- function(sModel,sModelCurrency,sModelDate,sModelVersion)
    {
        sModelPath  <- 'T:/Documents/Rsquared/RSQRM/'
        sIDFileType <- c('RSQIDtoSEDOL','RSQIDtoCUSIP','RSQIDtoISIN','RSQIDtoTICKER')

        #Build Model file path
        if(sModel=='GlobalDev')
        {
            sAssetDataFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_GlobalDev_v2_19_8_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_AssetData.txt',sep='')
            sIDFile<-c('FF_RSQRM Europe_EUR_','FF_RSQRM US_USD_','FF_RSQRM Japan_JPY_','FF_RSQRM AsiaExJP_USD_','FF_RSQRM Resource_USD_','FF_RSQRM LatAm_USD_')
            sIndustryFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_GlobalDev_v2_19_8_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_IndustryData.txt',sep='')
        } else if(sModel=='Europe')
        {
            sAssetDataFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Europe',sModelVersion,'_v2_19_9_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_AssetData.txt',sep='')
            sIDFile<-'FF_RSQRM Europe_EUR_'
            sIndustryFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Europe',sModelVersion,'_v2_19_9_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_IndustryData.txt',sep='')
        } else if(sModel=='US')
        {
            sAssetDataFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_US_v2_19_9_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_AssetData.txt',sep='')
            sIDFile<-'FF_RSQRM US_USD_'
            sIndustryFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_US_v2_19_9_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_IndustryData.txt',sep='')
        } else if(sModel=='Japan')
        {
            sAssetDataFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Japan_v2_19_4_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_AssetData.txt',sep='')
            sIDFile<-'FF_RSQRM Japan_JPY_'
            sIndustryFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Japan_v2_19_4_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_IndustryData.txt',sep='')
        } else if(sModel=='AsiaExJP')
        {
            sAssetDataFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_AsiaExJP_v2_19_6_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_AssetData.txt',sep='')
            sIDFile<-'FF_RSQRM AsiaExJP_USD_'
            sIndustryFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_AsiaExJP_v2_19_6_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_IndustryData.txt',sep='')
        } else if(sModel=='Resource')
        {
            sAssetDataFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Resource_v2_19_6_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_AssetData.txt',sep='')
            sIDFile<-'FF_RSQRM Resource_USD_'
            sIndustryFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Resource_v2_19_6_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_IndustryData.txt',sep='')
        } else if(sModel=='LatAm')
        {
            sAssetDataFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_LatAm_v2_19_4_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_AssetData.txt',sep='')
            sIDFile<-'FF_RSQRM LatAm_USD_'
            sIndustryFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_LatAm_v2_19_4_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_IndustryData.txt',sep='')
        }

        #Read Market IDs
        dfID<-data.frame()
        for (i in 1:length(sIDFile))
        {
            dfCurrentID<-data.frame()
            for (j in 1:length(sIDFileType))
            {
                sIDFileName <- paste(sModelPath,sModel,'/outputData/',sIDFile[i],format(sModelDate,"%Y%m%d"),'_',sIDFileType[j],'.txt',sep="")
                dfIDHeader <- t(scan(sIDFileName,skip=1,nlines=1,what = 'character',sep='|'))
                dfCurrent<-read.csv(sIDFileName,sep='|',skip=2,header=F,stringsAsFactors=F)
                names(dfCurrent) <- dfIDHeader
                names(dfCurrent)[1]<-toupper(names(dfCurrent)[1])

                if(j==1)
                {
                    dfCurrentID <- dfCurrent
                } else
                {
                    dfCurrentID<-merge(dfCurrentID,dfCurrent,by='RSQID',all.x=T)
                }
            }
            dfID<-rbind(dfID,dfCurrentID)
        }

        #Read Industry Data
        dfIndustryHeader <- t(scan(sIndustryFile,skip=2,nlines=1,what = 'character',sep='|'))
        dfIndustry<-read.csv(sIndustryFile,sep='|',skip=3,header=F,stringsAsFactors=F)
        names(dfIndustry)<-dfIndustryHeader
        names(dfIndustry)[1]<-toupper(names(dfIndustry)[1])
        names(dfIndustry)[1]<-'RSQID'

        #Read Asset Data File
        dfDataHeader<-t(scan(sAssetDataFile,skip=2,nlines=1,what = 'character',sep='|'))
        dfData<-read.csv(sAssetDataFile,sep='|',skip=3,header=F,stringsAsFactors=F)
        names(dfData)<-dfDataHeader
        names(dfData)[1]<-'RSQID'

        dfData<-merge(dfData,dfID,by='RSQID',all.x=T)
        dfData<-merge(dfData,dfIndustry,by='RSQID',all.x=T)

        return(dfData)
    }

# Read Stock Betas File 
    readStockBetaFile <- function(sModel,sModelCurrency,sModelDate,sModelVersion)
    {
        sModelPath  <- 'T:/Documents/Rsquared/RSQRM/'

        #Build Model file path
        if(sModel=='GlobalDev')
        {
            sStockBetasFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_GlobalDev_v2_19_8_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_StockBetas.txt',sep='')
        } else if(sModel=='Europe')
        {
            sStockBetasFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Europe',sModelVersion,'_v2_19_9_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_StockBetas.txt',sep='')
        } else if(sModel=='US')
        {
            sStockBetasFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_US_v2_19_9_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_StockBetas.txt',sep='')
        } else if(sModel=='Japan')
        {
            sStockBetasFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Japan_v2_19_4_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_StockBetas.txt',sep='')
        } else if(sModel=='AsiaExJP')
        {
            sStockBetasFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_AsiaExJP_v2_19_6_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_StockBetas.txt',sep='')
        } else if(sModel=='Resource')
        {
            sStockBetasFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_Resource_v2_19_6_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_StockBetas.txt',sep='')
        } else if(sModel=='LatAm')
        {
            sStockBetasFile<-paste(sModelPath,sModel,'/outputData/','FF_RSQ_RSQRM_LatAm_v2_19_4_',sModelCurrency,'_',format(sModelDate,"%Y%m%d"),'_StockBetas.txt',sep='')
        }

        #Read Stock Beta File
        dfDataHeader<-t(scan(sStockBetasFile,skip=2,nlines=1,what = 'character',sep='|'))
        dfData<-read.csv(sStockBetasFile,sep='|',skip=3,header=F,stringsAsFactors=F)
        names(dfData)<-dfDataHeader
        names(dfData)[1]<-'RSQID'

        return(dfData)
    }

==============

==============

1 个解决方案

#1


1  

You have a naming error:

您有一个命名错误:

    conditionalPanel(
      condition = "input.RSQRM == 'Asset Data'",
      uiOutput("selectAssetCols")),

    conditionalPanel(
      condition = "input.RSQRM == 'Stock Betas'",
      uiOutput("selectBetaCols"))

The checkGroups conditional on the tabs work for me when I change to the correct tab names. So to clarify you need to reference the tab names rather then tab ids.

当我更改为正确的选项卡名称时,以tab为条件的checkGroups适用于我。因此,为了澄清您需要引用选项卡名称而不是选项卡ID。

When the shiny app is running you can open firebug if you are running in firefox and in the console type

当闪亮的应用程序运行时,如果您在firefox和控制台类型中运行,则可以打开firebug

>>> Shiny.shinyapp.$inputValues.RSQRM
"Stock Betas"

You can see that the value of the input is "Stock Betas"

您可以看到输入的值是“Stock Betas”

#1


1  

You have a naming error:

您有一个命名错误:

    conditionalPanel(
      condition = "input.RSQRM == 'Asset Data'",
      uiOutput("selectAssetCols")),

    conditionalPanel(
      condition = "input.RSQRM == 'Stock Betas'",
      uiOutput("selectBetaCols"))

The checkGroups conditional on the tabs work for me when I change to the correct tab names. So to clarify you need to reference the tab names rather then tab ids.

当我更改为正确的选项卡名称时,以tab为条件的checkGroups适用于我。因此,为了澄清您需要引用选项卡名称而不是选项卡ID。

When the shiny app is running you can open firebug if you are running in firefox and in the console type

当闪亮的应用程序运行时,如果您在firefox和控制台类型中运行,则可以打开firebug

>>> Shiny.shinyapp.$inputValues.RSQRM
"Stock Betas"

You can see that the value of the input is "Stock Betas"

您可以看到输入的值是“Stock Betas”