2014-05-05 128 views
1

我希望有不同的CheckboxGroupInput列选择器基于我选择的选项卡,但是当我打开两个列选择器UI的输出条件时可见,数据加载但不显示,列选择器也不显示。当我的主面板没有两个选项卡时,我可以使其工作。我已经在这里工作了2天,我只是不知道这个工作的语法。我会非常感谢一些帮助,因为我是Shiny的初学者。R闪亮无法获得条件checkboxGroupInput基于活动选项卡

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

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

+0

喜@Arun。你可以请提供'源(“helper.R”)' – jdharrison

+0

嗨jd,道歉,这是帮手.R – Arun

+0

我不知道java脚本,是否没有其他方式来绑定一个GroupCheckBox与所选标签?如何引用选定的选项卡?我已经搜索,但我找不到与此主题相关的任何内容。 – Arun

回答

1

你有一个命名错误:

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

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

的checkGroups对我的标签工作条件,当我更改为正确的选项卡名称。因此,为了说明您需要引用标签名称而不是标签ID。

当闪亮的应用程序正在运行,你可以打开Firebug,如果你在Firefox和控制台类型的运行

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

你可以看到输入的值是“股票贝塔系数”

+0

jdharrison,我没有办法感谢你足够的,它的工作原理,非常感谢。它也帮助我增加了我的理解。 – Arun

+0

很高兴帮助很高兴看到应用程序 – jdharrison