光沢のあるスライダーの値をどのように参照しますか？

Question

私はベクトル中の数項目に基づいて、いくつかのスライダーを作成する必要があります。

UIコード：

library(shiny) 
library(shinydashboard) 
library(leaflet) 
library(data.table) 
library(ggplot2) 
library(ggthemes) 
library(usl) 

ui<-dashboardPage(skin="green", 
        dashboardHeader(title = "ADM Logical Capacity Planning Service",titleWidth = 350), 
        dashboardSidebar(

        sidebarMenu(
         menuItem("Visualize & Create Model", tabName = "visualize",icon=icon("area-chart")), 
         menuItem("Forecast", tabName = "capacity", icon=icon("line-chart")) ) 
       ), 
        dashboardBody(
        tags$head(tags$style(HTML(' 
               .skin-blue .main-header .logo { 
               background-color: #3c8dbc; 
               } 
               .menuItem .main-header .logo:hover { 
               background-color: #3c8dbc; 
               } 
               '))), 


        tabItems(
         tabItem("capacity", 
           fluidRow(
           column(3, 
             wellPanel(
             span("Given the growth rate, forecast the underlying dependent variable") 
             ), 
             wellPanel(


              # Create a uiOutput to hold the sliders 
              uiOutput("sliders") 
             ), 



             # Generate a row with a sidebar 
             #sliderInput("capacity", "Growth Rate in Volume:", min=0, max=100, value=0,post="%"), 
             #br(), 
             #sliderInput("add_capacity", "Add Capacity in %:", min=0, max=100, value=0,post="%"), 


             br(), 
             wellPanel(

             actionButton("calcbtn", "Calculate Forecast") 
             ) 
           ), 

           mainPanel(
            h4("Prediction"), 
            verbatimTextOutput("forecast_summary"), 

            h4("Available Capacity"), 
            verbatimTextOutput("capacity_summary") 

            #h4("Peak Capacity"), 
            #verbatimTextOutput("peak_capacity") 
           ) 
          ) 

        ), 
         tabItem("visualize", 
           pageWithSidebar(
           headerPanel("Logical Capacity Planning Dashboard"), 
           sidebarPanel(
            fileInput('file1', 'Upload CSV File to Create a Model', 
              accept=c('text/csv','text/comma-separated-values,text/plain','.csv')), 
            tags$hr(), 
            checkboxInput('header', 'Header', TRUE), 
            fluidRow(
            column(6,checkboxGroupInput("xaxisGrp","X-Axis:", c("1"="1","2"="2"))), 
            column(6,radioButtons("yaxisGrp","Y-axis:", c("1"="1","2"="2"))) 
           ), 
            radioButtons('sep', 'Separator', 
               c(Comma=',', Semicolon=';',Tab='\t'), ','), 
            radioButtons('quote', 'Quote', 
               c(None='','Double Quote'='"','Single Quote'="'"),'"'), 
            uiOutput("choose_columns") 
           ), 
           mainPanel(
            tabsetPanel(
            tabPanel("Data", tableOutput('contents')), 
            tabPanel("Create Model & Plot",plotOutput("plot"),verbatimTextOutput("PeakCapacity")), 
            tabPanel("Model Summary",verbatimTextOutput("summary")) 

           ) 
           ) 
          ) 
        ) 
        ) 
        ) 
        ) 

サーバコード：

server <- function(input, output, session) 
{ 


    ### 
    output$sliders <- renderUI({ 
    xv <- input$xaxisGrp 
    # First, create a list of sliders each with a different name 
    sliders <- lapply(1:length(xv), function(i) { 
     inputName <- xv[i] 
     sliderInput(inputName, inputName, min=0, max=100, value=0, post="%") 
    }) 
    # Create a tagList of sliders (this is important) 
    do.call(tagList, sliders) 
    }) 



    ### 

    observeEvent(input$calcbtn, { 

    n <- isolate(input$calcbtn) 
    if (n == 0) return() 

    output$forecast_summary <- renderPrint({ 
     n<-pred.model() 
     n<-data.frame(n) 
     row.names(n)<-NULL 
     print(n) 
    }) 

    output$capacity_summary <- renderPrint({ 
     n<-pred.model() 
     n<-data.frame(n) 
     row.names(n)<-NULL 
     #c<-round(peak.scalability(usl.model()),digits=0) 
     available<-round(((c-n[1,1])/c)*100,digits=0) 
     row.names(available)<-NULL 
     print(paste0(available,"%")) 

    }) 

    # output$peak_capacity <- renderPrint({ 

    # print(paste("Maximum Capacity: ", round(peak.scalability(pred.model()),digits=0))) 

    # }) 

    output$plot_forecast <- renderPlot({ 
     df <- data_set() 
     new_df<- pred.model() 

     print(sliders) 
     if (!is.null(df)){ 

     xv <- input$xaxisGrp 
     yv <- input$yaxisGrp 
     print(xv) 
     print(yv) 
     if (!is.null(xv) & !is.null(yv)){ 

      if (sum(xv %in% names(df))>0){ # supress error when changing files 

      df1<-data.frame(usl.model()$fitted) 
      colnames(df1)<-c("Model") 
      df<-cbind(df,df1) 
      Model=c("Model") 
      #ggplot(df, aes_string(xv,yv))+geom_point(size=3,colour="blue")+geom_line(data=df, aes_string(xv,Model),colour="orange",size=1)+ 
      #geom_point(data=new_df,aes(new_df[,1],new_df[,2]), colour="red",size=10)+theme_bw()+theme(legend.position = "none") 

      #max_capacity<-round(peak.scalability(usl.model()),digits=0) 
      Ninety_Fifth_Perc<-quantile(df[,2], 0.95) 
      #peak<-round(peak.scalability(usl.model()),digits=0) 
      #available<-round(((max_capacity-Ninety_Fifth_Perc)/max_capacity)*100,digits=0) 
      new_d<-pred.model() 

      ggplot(df, aes_string(xv,yv))+geom_point(size=4,shape=21, fill="blue")+geom_line(data=df, aes_string(xv,Model),colour="orange",size=1)+ 
       geom_point(data=new_df,aes(new_df[,1],new_df[,2]), colour="red",size=10)+ 
       theme_bw()+theme(legend.position = "none")+geom_vline(xintercept=new_df[,1], colour="green",size=1.5) 



      } 
     } 
     } 

    }) 

    }) 

    ###pred function 
    pred.model <- reactive({ 
    xv <- input$xaxisGrp 
    yv <- input$yaxisGrp 

    #latest_df<-do.call(data.frame,setNames(lapply(xv,function(e) vector(typeof(e))),xv)) 
    latest_df<-data.frame() 
    new_df1 = data.frame() 


    for(i in 1:length(xv)){ 
    ##xv[i]<-as.numeric(input$xv[i]) 

    # capacity<-as.numeric(input$capacity) 
    #add_capacity<-as.numeric(input$add_capacity) 

     df <- data_set() 
     if (!is.null(df)){ 

     if (!is.null(xv) & !is.null(yv)){ 

      if (sum(xv[i] %in% names(df))>0){ # supress error when changing files 
      #usl.model <- usl(as.formula(paste(yv, '~', xv)), data = df) 

      #new_growth<-tail(df[,xv],1)*(1+capacity/100) 
      new_growth<-quantile(df[,xv[i]],0.95)*(1+input$xv[i]/100) 
      new_cap<-new_growth 

      new_df1[1,i] = setNames(data.frame(new_cap),xv[i]) 

      row.names(new_df1)<-NULL 
      } 
     } 
     } 
    } 
    latest_df=new_df1 

    prediction<-predict(usl.model(),newdata = latest_df) 
    prediction<-data.frame(prediction) 
    prediction<-prediction[1,1] 

    return(prediction) 
}) 
    ##end of pred function 

    ###visualize section 
    dsnames <- c() 

    data_set <- reactive({ 
    inFile <- input$file1 
    data(specsdm91) 
    if (is.null(inFile)) 
     return(specsdm91) 

    data_set<-read.csv(inFile$datapath, header=input$header, 
         sep=input$sep, quote=input$quote,stringsAsFactors=F) 
    }) 

    output$contents <- renderTable({data_set()}) 

    observe({ 
    dsnames <- names(data_set()) 
    cb_options <- list() 
    cb_options[ dsnames] <- dsnames 
    updateCheckboxGroupInput(session, "xaxisGrp", 
         label = "X-Axis", 
         choices = cb_options, 
         selected = "") 
    updateRadioButtons(session, "yaxisGrp", 
          label = "Y-Axis", 
          choices = cb_options, 
          selected = "") 
    }) 
    output$choose_dataset <- renderUI({ 
    selectInput("dataset", "Data set", as.list(data_sets)) 
    }) 

    usl.model <- reactive({ 

    df <- data_set() 
    if (!is.null(df)){ 

     xv <- input$xaxisGrp 
     yv <- input$yaxisGrp 
     print(xv) 
     print(yv) 
     if (!is.null(xv) & !is.null(yv)){ 

     if (sum(xv %in% names(df))>0){ # supress error when changing files 
      xv <- paste(xv, collapse="+") 

      lim <- lm(as.formula(paste(yv, '~', xv)), data = df) 

      return(lim) 

     } 
     } 
    } 
    }) 


    ##plot 
    output$plot = renderPlot({ 

    df <- data_set() 
    if (!is.null(df)){ 

     xv <- input$xaxisGrp 
     yv <- input$yaxisGrp 
     print(xv) 
     print(yv) 
     if (!is.null(xv) & !is.null(yv)){ 

     if (sum(xv %in% names(df))>0){ # supress error when changing files 

      #plot(as.formula(paste(yv, '~', xv)), data = df, pch = 21) 

      #plot(usl.model(),add=TRUE) 

      df1<-data.frame(usl.model()$fitted) 
      colnames(df1)<-c("Best_Fit_Model") 
      #df<-cbind(df,df1) 
      Model<-c("Best_Fit_Model") 
      df1<-cbind(df[yv],df1) 

      #max_capacity<-round(peak.scalability(usl.model()),digits=0) 
      #Ninety_Fifth_Perc<-quantile(df[,2], 0.95) 
      #peak<-round(peak.scalability(usl.model()),digits=0) 
      #available<-round(((max_capacity-Ninety_Fifth_Perc)/max_capacity)*100,digits=0) 
      #new_d<-pred.model() 
      df.melt=melt(df, id=yv) 
      xx<-c("value") 

      ggplot(df.melt,aes_string(x = xx, y = yv)) + geom_point() +facet_wrap(~variable, scale="free")+theme_bw()+ 
      geom_smooth(method="lm", se=F, colour="red") 

     # p2<-ggplot(df1,aes_string(x = yv, y = Model)) + geom_point() + theme_bw()+ 
      # geom_smooth(method="lm", se=F, colour="red") 



     } 
     } 
    } 

    }) 

    ## 
    output$summary <- renderPrint({ 

    summary(usl.model()) 

    }) 


    output$choose_columns <- renderUI({ 

    if(is.null(input$dataset)) 
     return() 
    colnames <- names(contents) 
    checkboxGroupInput("columns", "Choose columns", 
         choices = colnames, 
         selected = colnames) 
    }) 


} 

Answer 1

EDIT：あなたはまた、xaxisGrpを参照しています入力（それはない）。それはいくつかの問題を引き起こしています。これを修正すると（下記の例を参照）、問題なく動作します。私はそれを認識しませんでした！クール。

コメントに基づいて更新すると、ブラケット表記を使用して各入力にアクセスできる必要があります。あなたの質問は依然として存在しないinput$xaxisGrpを参照しています。私はまだ何もプロットされていないので、renderPlot({})と呼んでいるのかどうかはわかりません。

library(shiny) 

ui <- shinyUI(
    fluidPage(
    sidebarLayout(
     sidebarPanel(
     uiOutput("sliders") 
    ), 
     mainPanel(

    ) 
)) 

server <- shinyServer(function(input, output, session) { 

    xaxisGrp <- c("CPU", "Memory", "Disk") 

    output$sliders <- renderUI({ 
    xv <- xaxisGrp 
    sliders <- lapply(1:length(xv), function(i) { 
     inputName <- xv[i] 
     sliderInput(inputName, inputName, min=0, max=100, value=0, post="%") 
    }) 
    do.call(tagList, sliders) 
    }) 

    output$plot_forecast <- renderPlot({ 
    xv <- xaxisGrp 

    for(i in 1:length(xv)) { 
     value <- input[xv[i]] 
    } 
    }) 
}) 

---

あなたはスライダーをこのように構築している理由私はちょっとわからないんです。 namespacingを調べましたか？または、3つの別々の出力を書き込むだけですか？例えば、（あなたは、各入力<key, value>ペアを見て、これを実行することができます）：あなたの入力はすべて（xaxisGrpはあなたの例では、有効な入力ではありません）任意のIDなしでレンダリングされているようなあなたの場合には

library(shiny) 

ui <- shinyUI(
    fluidPage(
    sidebarLayout(
     sidebarPanel(
     uiOutput("slider1"), 
     uiOutput("slider2"), 
     uiOutput("slider3"), 
     uiOutput("sliders") 
    ), 
     mainPanel(
     verbatimTextOutput("inputVals") 
    ) 
    ) 
)) 

server <- shinyServer(function(input, output, session) { 
    output$slider1 <- renderUI({ 
    sliderInput("CPU2", "CPU2", min=0, max=100, value=0, post="%") 
    }) 

    output$slider2 <- renderUI({ 
    sliderInput("Memory2", "Memory2", min=0, max=100, value=0, post="%") 
    }) 

    output$slider3 <- renderUI({ 
    sliderInput("Disk2", "Disk2", min=0, max=100, value=0, post="%") 
    }) 

    output$sliders <- renderUI({ 
    xv <- c("CPU","Memory","Disk") 
    sliders <- lapply(1:length(xv), function(i) { 
     inputName <- xv[i] 
     sliderInput(inputName, inputName, min=0, max=100, value=0, post="%") 
    }) 
    do.call(tagList, sliders) 
    }) 

    output$inputVals <- renderPrint({ 
    print(reactiveValuesToList(input)) 
    }) 
}) 

# Run the application 
shinyApp(ui = ui, server = server) 

、それが見えます。それは悪いです、彼らはそれぞれユニークなものが必要です。名前空間は、UI生成関数を抽象化し、入力ごとに一意のIDを保証することでこれを解決する1つの方法です。 （私が知らないのであれば、外部要因に基づいて動的に生成する必要がある場合を除き）、複数の個別の入力を作成するだけです。

あなただけの任意の反応コンテキスト内input$inputId構文を使用し、任意の与えられた入力の値にアクセスするには、その後、正しく入力を構築したら：

output$CPUValue <- renderText({ 
    input$CPU 
})