r - 如何从 R Shiny selectInput() 中的列表中提取元素名称而不是值?
问题描述
我想从 R Shiny中用于choices
参数的列表中提取元素名称,而不是特定值。selectInput()
该selectInput
函数如下所示:
# ...
selectInput("xvar", "What is the predictor variable?",
choices = list("MPG" = "mpg",
"Cylinders" = "cyl",
"Engine Displacement" = "disp",
"Horse Power" = "hp",
"Gears" = "gear"),
# ...
例如,在我的server.R
代码中,我想使用“Cylinders”而不是“cyl”作为轴标签。例如(使用ggplot2
):
# ...
labs(x = input$xvar, y = input$yvar) +
# ...
names(input$xvar)
返回NULL
。有什么方法可以调用input$xvar
并返回名称吗?
解决方案
感谢 Paul 的评论、他提供的链接和这个SO 线程,我能够回答我的问题。
下面我提供了生成轴标签的旧脚本ui.R
和server.R
我不满意的脚本,以及改进了轴标签的新脚本ui.R
和脚本。server.R
(新脚本中的更改用 标记# 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)
}
})
})
推荐阅读
- mysql - 如何插入一个表空值并从mysql中的另一个表中选择*?
- node.js - 纽约 + 摩卡 + es6 模块
- google-app-engine - 有没有办法分析 App Engine HTTP 日志?
- angular - 提交弹出表单后显示通知消息
- c# - 我正在编写一个名为 WriteSlow() 的函数,它给了我一个错误。我如何解决它?
- api - 有没有办法在基于 api 的颤振中在运行时创建 .arb 文件
- ruby - 如何获得从 Thor 继承的 Ruby 类的命令、子命令、选项的组织结构?
- python - 如果我的数据库已经手动设计,我是否需要使用 sqlalchemy?
- pandas - 大熊猫按排名连续日期分组
- database - 在 Windows 10 中通过 cmd 登录 postgreSQL 时遇到困难