羅馬歷史愛好者在這里，所以我有一個資料框，其中包含兩個軍團的名稱（fifth和tirteenth），他們的傷亡人數（數值），以及部隊的士氣（high，medium，low）。
我想知道（箱線圖）道德（x 軸）和傷亡人數（y 軸）之間的關系，以及軍團的子集：
Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Moral)
請注意，這是一個玩具示例。在真實資料（無羅馬字）中，我們為每個軸都有幾個變數，因此我們要求用戶加載資料，然后選擇他想為每個軸使用哪些變數。
這就是我所擁有的：
library(shiny)
library(shinythemes)
library(dplyr)
library(readxl)
library(ggplot2)
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)),
selectInput("factor", "Select factor", choices = c(not_sel)),
br(),
actionButton("run_button", "Run Analysis", icon = icon("play"))
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
plotOutput("plot_1")
)
)
)
)
)
draw_plot_1 <- function(data_input, num_var_1, num_var_2, factor){
if(num_var_1 != not_sel & num_var_2 != not_sel & factor == not_sel){
ggplot(data = data_input, aes_string(x = num_var_1, y = num_var_2, fill= num_var_2))
geom_boxplot()
theme_bw()
}
else if(num_var_1 != not_sel & num_var_2 != not_sel & factor != not_sel){
ggplot(data = data_input, aes_string(x = num_var_1, y = num_var_2, fill = factor))
geom_boxplot()
theme_bw()
}
}
ui <- navbarPage(
title = "Plotter",
theme = shinytheme("yeti"),
main_page
)
server <- function(input, output){
options(shiny.maxRequestSize=10*1024^2)
data_input <- reactive({
req(input$xlsx_input)
inFile <- input$xlsx_input
read_excel(inFile$datapath, 1)
})
observeEvent(data_input(),{
choices <- c(not_sel, names(data_input()))
updateSelectInput(inputId = "num_var_1", choices = choices)
updateSelectInput(inputId = "num_var_2", choices = choices)
updateSelectInput(inputId = "factor", choices = choices)
})
num_var_1 <- eventReactive(input$run_button, input$num_var_1)
num_var_2 <- eventReactive(input$run_button, input$num_var_2)
factor <- eventReactive(input$run_button, input$factor)
plot_1 <- eventReactive(input$run_button,{
draw_plot_1(data_input(), num_var_1(), num_var_2(), factor())
})
output$plot_1 <- renderPlot(plot_1())
}
shinyApp(ui = ui, server = server)
我一直在嘗試不同的方法來：
- 首先，讓用戶選擇要繪制的軍團。
- 在繪圖中實作此選擇。
到目前為止，情節是這樣的：
給予的任何幫助將不勝感激。
uj5u.com熱心網友回復：
也許你正在尋找這個
Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Moral)
library(shiny)
library(shinythemes)
library(shinyWidgets)
library(dplyr)
library(readxl)
library(ggplot2)
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)),
selectInput("factor", "Select factor", choices = c(not_sel)), uiOutput("leg"),
br(),
actionButton("run_button", "Run Analysis", icon = icon("play"))
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
plotOutput("plot_1")
)
)
)
)
)
draw_plot_1 <- function(data_input, num_var_1, num_var_2, factor){
print(num_var_1)
if(num_var_1 != not_sel & num_var_2 != not_sel & factor == not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]], fill= .data[[num_var_2]]))
geom_boxplot()
theme_bw()
}
else if(num_var_1 != not_sel & num_var_2 != not_sel & factor != not_sel){
ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]], fill = .data[[factor]]))
geom_boxplot()
theme_bw()
}
}
ui <- navbarPage(
title = "Plotter",
theme = shinytheme("yeti"),
main_page
)
options(shiny.maxRequestSize=10*1024^2)
server <- function(input, output){
data_input <- reactive({
# req(input$xlsx_input)
# inFile <- input$xlsx_input
# read_excel(inFile$datapath, 1)
romans
})
observeEvent(data_input(),{
choices <- c(not_sel, names(data_input()))
updateSelectInput(inputId = "num_var_1", choices = choices)
updateSelectInput(inputId = "num_var_2", choices = choices)
updateSelectInput(inputId = "factor", choices = choices)
})
output$leg <- renderUI({
req(input$factor,data_input())
if (input$factor != not_sel) {
b <- unique(data_input()[[input$factor]])
pickerInput(inputId = 'selected_factors',
label = 'Select factors',
choices = c("NONE",b[1:length(b)]), selected="NONE",
# multiple = TRUE, ### if you wish to select multiple factor values; then deselect NONE
options = list(`style` = "btn-warning"))
}
})
num_var_1 <- eventReactive(input$run_button, input$num_var_1)
num_var_2 <- eventReactive(input$run_button, input$num_var_2)
factor <- eventReactive(input$run_button, input$factor)
plot_1 <- eventReactive(input$run_button,{
req(input$selected_factors,input$factor,data_input())
df <- data_input()[data_input()[[input$factor]] %in% input$selected_factors,]
draw_plot_1(df, num_var_1(), num_var_2(), factor())
})
output$plot_1 <- renderPlot(plot_1())
}
shinyApp(ui = ui, server = server)
轉載請註明出處，本文鏈接：https://www.uj5u.com/qianduan/369343.html
上一篇：如何標記每條趨勢線而不是制作圖例