[英]Change the order of factors inside plots based on user input in rshiny
是否可以根据用户输入更改 Rshiny 中的绘图顺序?
我有一个 dataframe 有两个变量,“士气”(“高”、“中”和“低”)和伤亡(数值变量),我想知道各组之间是否存在差异,我要去到一些箱线图。
这个shinyapp(下面的RepEx),允许你plot这两个变量:
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Morale <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Casualties, Morale)
# Shiny
library(shiny)
library(shinyWidgets)
# Data
library(readxl)
library(dplyr)
# Data
library(effsize)
# Objects and functions
not_sel <- "Not Selected"
main_page <- tabPanel(
title = "Romans",
titlePanel("Romans"),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
br(),
actionButton("run_button", "Run Analysis", icon = icon("play"))
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
plotOutput("plot_1")
)
)
)
)
)
# Function for printing the plots with two different options
# When there is not a selection of the biomarker (we will take into account var_1 and var_2)
# And when there is a selection of the biomarker (we will take into account the three of them)
draw_boxplot <- function(data_input, num_var_1, num_var_2){
print(num_var_1)
if(num_var_1 != not_sel & num_var_2 != not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
geom_boxplot() +
theme_bw()
}
}
################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------
ui <- navbarPage(
main_page
)
################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
data_input <- reactive({
#req(input$xlsx_input)
#inFile <- input$xlsx_input
#read_excel(inFile$datapath, 1)
romans
})
# We update the choices available for each of the variables
observeEvent(data_input(),{
choices <- c(not_sel, names(data_input()))
updateSelectInput(inputId = "num_var_1", choices = choices)
updateSelectInput(inputId = "num_var_2", choices = choices)
})
# Allow user to select the legion
num_var_1 <- eventReactive(input$run_button, input$num_var_1)
num_var_2 <- eventReactive(input$run_button, input$num_var_2)
## Plot
plot_1 <- eventReactive(input$run_button,{
#print(input$selected_factors)
req(data_input())
df <- data_input()
draw_boxplot(df, num_var_1(), num_var_2())
})
output$plot_1 <- renderPlot(plot_1())
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)
正如您在上面的 plot 中看到的那样,变量按字母数字顺序排列(这是因为它们被视为“字符”,而不是“因子”,尽管现在这不是那么重要)。
我想要的是一种改变绘图顺序的方法,因此用户可以手动 select 首先需要哪个因素(高、中或低)等。
有没有办法做到这一点?
让我们使用示例数据集iris
绘制一个具有可变因子水平的箱线图,以便我们可以用鼠标拖动按钮顺序:
library(tidyverse)
library(shiny)
library(shinyjqui)
ui <- fluidPage(
orderInput(inputId = "levels", label = "Factor level order",
items = c("setosa", "versicolor", "virginica")),
plotOutput(outputId = "plot")
)
server <- function(input, output) {
data <- reactive({
mutate(iris, Species = Species %>% factor(levels = input$levels))
})
output$plot <- renderPlot({
qplot(Species, Sepal.Width, geom = "boxplot", data = data())
})
}
shinyApp(ui, server)
使用 Shinyjqui
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Morale <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Casualties, Morale)
# Shiny
library(shiny)
library(shinyWidgets)
# Data
library(readxl)
library(dplyr)
# Data
library(effsize)
# drag
library(shinyjqui)
#plotting
library(tidyverse)
# Objects and functions
not_sel <- "Not Selected"
main_page <- tabPanel(
title = "Romans",
titlePanel("Romans"),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
orderInput('morale_order', 'Morale', items = unique(Morale)),
br(),
actionButton("run_button", "Run Analysis", icon = icon("play"))
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
plotOutput("plot_1")
)
),verbatimTextOutput('order')
)
)
)
# Function for printing the plots with two different options
# When there is not a selection of the biomarker (we will take into account var_1 and var_2)
# And when there is a selection of the biomarker (we will take into account the three of them)
draw_boxplot <- function(data_input, num_var_1, num_var_2){
print(num_var_1)
if(num_var_1 != not_sel & num_var_2 != not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
geom_boxplot() +
theme_bw()
}
}
################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------
ui <- navbarPage(
main_page
)
################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
data_input <- reactive({
#req(input$xlsx_input)
#inFile <- input$xlsx_input
#read_excel(inFile$datapath, 1)
romans |>
mutate(Morale = Morale |> factor(levels = input$morale_order))
})
# We update the choices available for each of the variables
observeEvent(data_input(),{
choices <- c(not_sel, names(data_input()))
updateSelectInput(inputId = "num_var_1", choices = choices)
updateSelectInput(inputId = "num_var_2", choices = choices)
})
# Allow user to select the legion
num_var_1 <- eventReactive(input$run_button, input$num_var_1)
num_var_2 <- eventReactive(input$run_button, input$num_var_2)
## Plot
plot_1 <- eventReactive(input$run_button,{
#print(input$selected_factors)
req(data_input())
df <- data_input()
draw_boxplot(df, num_var_1(), num_var_2())
})
output$plot_1 <- renderPlot(plot_1())
# test what is there
output$order <- renderPrint(input$morale_order)
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.