CODEWITHSUNDEEP
rshiny
Arun
Arun

Reputation: 285

R Shiny Cannot get conditional checkboxGroupInput to work based on active tab

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.

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

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

Upvotes: 1

Views: 1882

Answers (1)

jdharrison
jdharrison

Reputation: 30425

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.

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

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

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

Upvotes: 1

Related Questions