如何基于下拉输入动态重命名R Shiny中的多个列?

时间:2016-09-28 12:04:00

标签: r dplyr shiny

我有一个闪亮的应用程序,如下所示:

require(shiny)
require(dplyr)
server <-  function(input, output) {

  dataa <- reactive({
    table1 <- mtcars
    return(table1)
  })

  output$contents <- renderDataTable({
    dataa()      
  })

  output$mpg <- renderUI({
    selectizeInput(
      'MPG', 'MPG: ', choices = c("",as.list(colnames(dataa()))),
      options = list(
        placeholder = 'Please select',
        onInitialize = I('function() { this.setValue(""); }')
      )
    )
  })   

  output$cyl <- renderUI({
    selectizeInput(
      'CYL', 'CYL: ', choices = c("",as.list(colnames(dataa()))),
      options = list(
        placeholder = 'Please select',
        onInitialize = I('function() { this.setValue(""); }')
      )
    )
  })  


  DataRename <- reactive({
    Data <- dataa()
    DataNew1<-Data
    MPG <- input$MPG
    CYL <- input$CYL
    if(!is.null(MPG)){
      StatRenameEmp1 <- paste0("DataNew1 <- dplyr::rename(DataNew1,Mileage=",MPG,")")
      eval(parse(text=StatRenameEmp1))
    } else{
      DataNew1<-Data
    }
    if(!is.null(CYL)){
      StatRenameEmp1 <- paste0("DataNew1 <- dplyr::rename(DataNew1,Cylinders=",CYL,")")
      eval(parse(text=StatRenameEmp1))
    }else{
      DataNew1<-Data
    }

    return(DataNew1)
  })

  output$rename <- renderDataTable({
    DataRename()      
  })


}

ui <- shinyUI({
  navbarPage("Dynamic Rename",
             tabPanel("Data",
                      fluidPage(
                        titlePanel("mtcars"),

                        dataTableOutput('contents'))
                      ),
             tabPanel("Variables",
                      fluidPage(
                        sidebarLayout(
                          sidebarPanel(
                            uiOutput("mpg"),
                            uiOutput("cyl")
                          ),
                          mainPanel(
                            dataTableOutput("rename")
                          )
                        )
                      )
   )


  )



})

shinyApp(ui = ui, server = server)

目的是重命名数据框的列(mtcars),其中我给出了最终数据的一些标准名称,用户应该从输入数据集中选择相应的变量。例如,我想将用户选择的某个列(在这种情况下为mpg)重命名为&#34;里程&#34;,cyl到&#34; Cylinder&#34;等等。

我的问题是我无法一次重命名多个列。只重命名第一列而不是剩余的。

其次,我可能不会选择任何列,在这种情况下,不需要更改列名,即,如果未选择MPG,则它应保持为mpg

如何根据用户输入根据我设置的名称重命名所有列?

如果选择所有下拉菜单,重命名效果会很好。

1 个答案:

答案 0 :(得分:1)

为什么不简单?

colnames(df)[which(colnames(df)=="mpg")]="New name"

或者我可能不理解你的目标......

闪亮的例子

require(shiny)
require(dplyr)
server <-  function(input, output) {

  dataa <- reactive({
    table1 <- mtcars
    return(table1)
  })

  output$contents <- renderDataTable({
    dataa()      
  })

  output$mpg <- renderUI({
    selectizeInput(
      'MPG', 'MPG: ', choices = c("",as.list(colnames(dataa()))),
      options = list(
        placeholder = 'Please select',
        onInitialize = I('function() { this.setValue(""); }')
      )
    )
  })   

  output$cyl <- renderUI({
    selectizeInput(
      'CYL', 'CYL: ', choices = c("",as.list(colnames(dataa()))),
      options = list(
        placeholder = 'Please select',
        onInitialize = I('function() { this.setValue(""); }')
      )
    )
  })  


  DataRename <- reactive({
    Data <- dataa()
    DataNew1<-Data
    MPG <- input$MPG
    CYL <- input$CYL

    if(!is.null(MPG)){
      colnames(DataNew1)[which(colnames(DataNew1)==MPG)]="Mileage"
    }

    if(!is.null(CYL)){
      colnames(DataNew1)[which(colnames(DataNew1)==CYL)]="Cylinders"
    }

    return(DataNew1)
  })

  output$rename <- renderDataTable({
    DataRename()      
  })


}

ui <- shinyUI({
  navbarPage("Dynamic Rename",
             tabPanel("Data",
                      fluidPage(
                        titlePanel("mtcars"),

                        dataTableOutput('contents'))
             ),
             tabPanel("Variables",
                      fluidPage(
                        sidebarLayout(
                          sidebarPanel(
                            uiOutput("mpg"),
                            uiOutput("cyl")
                          ),
                          mainPanel(
                            dataTableOutput("rename")
                          )
                        )
                      )
             )


  )



})

shinyApp(ui = ui, server = server)

或者,如果您想使用文本输入重命名列,您可以这样做

require(shiny)
require(dplyr)
server <-  function(input, output) {

  dataa <- reactive({
    table1 <- mtcars
    return(table1)
  })

  output$contents <- renderDataTable({
    dataa()      
  })

  output$renamer <- renderUI({
    lapply(colnames(dataa()),function(i){
      textInput(paste0("col_",i),i,i)
    })
  })  


  DataRename <- reactive({
    Data <- dataa()
    DataNew1<-Data

    for ( i in names(input) ){

      if(grepl(pattern = "col_",i)){
        colnames(DataNew1)[which(colnames(DataNew1)==substr(i,5,nchar(i)))]=input[[i]]
      }

    }

    return(DataNew1)
  })

  output$rename <- renderDataTable({
    DataRename()      
  })


}

ui <- shinyUI({
  navbarPage("Dynamic Rename",
             tabPanel("Data",
                      fluidPage(
                        titlePanel("mtcars"),

                        dataTableOutput('contents'))
             ),
             tabPanel("Variables",
                      fluidPage(
                        sidebarLayout(
                          sidebarPanel(

                            uiOutput("renamer")
                          ),
                          mainPanel(
                            dataTableOutput("rename")
                          )
                        )
                      )
             )


  )



})

shinyApp(ui = ui, server = server)