2014-05-05 126 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