如何从R Shiny selectInput()的列表中提取元素名称而不是值? [英] How to extract element name, not value, from a list in R Shiny selectInput()?

查看:102
本文介绍了如何从R Shiny selectInput()的列表中提取元素名称而不是值?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我想从R Shiny的selectInput()中用于choices自变量的列表中提取元素名称,而不是特定值.

I would like to extract the element name, and not the specific value, from a list used for the choices argument in selectInput() from R Shiny.

selectInput函数如下所示:

# ...
selectInput("xvar", "What is the predictor variable?",
                        choices = list("MPG" = "mpg",
                                       "Cylinders" = "cyl",
                                       "Engine Displacement" = "disp",
                                       "Horse Power" = "hp",
                                       "Gears" = "gear"),
# ...

在我的server.R代码中,我想使用例如汽缸"而不是"cyl"作为轴标签.例如(使用ggplot2):

In my server.R code I would like to use, for example, "Cylinders" and not "cyl" as an axis label. For example (using ggplot2):

# ...
labs(x = input$xvar, y = input$yvar) +
# ...

names(input$xvar)返回NULL.有什么方法可以调用input$xvar并返回名称吗?

names(input$xvar) returns NULL. Is there any way to call input$xvar and return the name?

推荐答案

感谢Paul的评论,他提供的链接以及

Thanks to Paul's comments, the links he provided, and this SO thread, I was able to answer my question.

下面,我提供了旧的ui.Rserver.R脚本,这些脚本生成了我不满意的轴标签,以及新的ui.Rserver.R脚本,其中的轴标签得到了改进. (新脚本中的更改用# diff标记)

Below I provide the old ui.R and server.R scripts which generated axis labels I was not happy with, as well as new ui.R and server.R scripts where the axis labels are improved. (Changes in the new scripts are marked with # diff)

旧的ui.R:

shinyUI(fluidPage(
    titlePanel("Fit Regression Line for Chosen Variables and Points"),
    sidebarLayout(
        sidebarPanel(
            h2("Model Specifics"), br(),
            selectInput("xvar", "What is the predictor variable?",
                        choices = list("MPG" = "mpg",
                                       "Cylinders" = "cyl",
                                       "Engine Displacement" = "disp",
                                       "Horse Power" = "hp",
                                       "Gears" = "gear"),
                        multiple = FALSE),
            selectInput("yvar", "What is the outcome variable?",
                        choices = list("MPG" = "mpg",
                                       "Cylinders" = "cyl",
                                       "Engine Displacement" = "disp",
                                       "Horse Power" = "hp",
                                       "Gears" = "gear"),
                        multiple = FALSE, selected = "cyl"),
            h4("Intercept"), textOutput("int"),
            h4("Slope"), textOutput("slope")
        ),
        mainPanel(
            br(), h2("Display"), h4("Drag to select which points to include in model"),
            plotOutput("plot", brush = brushOpts(id = "brush1"))
        )
    )
))

旧的server.R:

shinyServer(function(input, output) {
        model <- reactive({
                points <- brushedPoints(mtcars, brush = input$brush1,
                                        xvar = input$xvar,
                                        yvar = input$yvar)
                if(nrow(points) <= 1) {
                        return(NULL)
                } else {
                        lm(as.formula(paste0(input$yvar,
                                             "~", input$xvar)),
                           data = points)
                }
        })
        output$int <- renderText({
                if(is.null(model())) {
                        "Too few data points selected"
                } else {
                        round(model()[[1]][1], 2)
                }
        })
        output$slope <- renderText({
                if(is.null(model())) {
                        "Too few data points selected"
                } else {
                        round(model()[[1]][2], 2)
                }
        })
        output$plot <- renderPlot({
                library(ggplot2)
                ggplot(mapping = aes(x = mtcars[, input$xvar],
                                     y = mtcars[, input$yvar])) +
                        theme_minimal() +
                        geom_point() +
                        labs(x = input$xvar, y = input$yvar) +
                        coord_cartesian(x = c(0, 1.2*max(mtcars[, input$xvar])),
                                        y = c(0, 1.2*max(mtcars[, input$yvar]))) +
                if(!is.null(model())) {
                        geom_abline(intercept = model()[[1]][1], slope = model()[[1]][2],
                                    colour = "red", lwd = 2, alpha = 0.3)
                }
        })
})

脚本中的更改用# diff

新的ui.R:

shinyUI(fluidPage(
    titlePanel("Fit Regression Line for Chosen Variables and Points"),
    sidebarLayout(
        sidebarPanel(
            h2("Model Specifics"), br(),
            uiOutput("si_xvar"), # diff
            uiOutput("si_yvar"), # diff
            h4("Intercept"), textOutput("int"),
            h4("Slope"), textOutput("slope")
        ),
        mainPanel(
            br(), h2("Display"), h4("Drag to select which points to include in model"),
            plotOutput("plot", brush = brushOpts(id = "brush1"))
        )
    )
))

新的server.R:

shinyServer(function(input, output) {
    varlist <- list("MPG" = "mpg",  # diff
                    "Cylinders" = "cyl",
                    "Engine Displacement" = "disp",
                    "Horse Power" = "hp",
                    "Gears" = "gear")
    output$si_xvar <- renderUI(     # diff
        selectInput("xvar", "What is the predictor variable?",
                    choices = varlist,
                    multiple = FALSE)
    )
    output$si_yvar <- renderUI(     # diff
        selectInput("yvar", "What is the outcome variable?",
                    choices = varlist,
                    multiple = FALSE, selected = "cyl")
    )
    model <- reactive({
        points <- brushedPoints(mtcars, brush = input$brush1,
                                xvar = input$xvar,
                                yvar = input$yvar)
        if(nrow(points) <= 1) {
            return(NULL)
        } else {
            lm(as.formula(paste0(input$yvar,
                                 "~", input$xvar)),
               data = points)
        }
    })
    output$int <- renderText({
        if(is.null(model())) {
            "Too few data points selected"
        } else {
            round(model()[[1]][1], 2)
        }
    })
    output$slope <- renderText({
        if(is.null(model())) {
            "Too few data points selected"
        } else {
            round(model()[[1]][2], 2)
        }
    })
    output$plot <- renderPlot({
        library(ggplot2)
        ggplot(mapping = aes(x = mtcars[, input$xvar],
                             y = mtcars[, input$yvar])) +
            theme_minimal() +
            geom_point() +
            labs(x = names(which(input$xvar == varlist)),       # diff
                 y = names(which(input$yvar == varlist))) +     # diff
            coord_cartesian(x = c(0, 1.2*max(mtcars[, input$xvar])),
                            y = c(0, 1.2*max(mtcars[, input$yvar]))) +
            if(!is.null(model())) {
                geom_abline(intercept = model()[[1]][1], slope = model()[[1]][2],
                            colour = "red", lwd = 2, alpha = 0.3)
            }
    })
})

这篇关于如何从R Shiny selectInput()的列表中提取元素名称而不是值?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆