我需要帮助来开发我正在为我的高尔夫游戏创建的闪亮应用程序。我已将包含先前距离和精度观测值的 CSV 文件加载到 Rstudio,并完成了一个脚本文件,其中通常会执行以下操作:数据预处理,然后可视化。
我现在正在努力将其转换为 app.R 文件,特别是如何创建一个小部件,在其中我可以将新的数字观察添加到当前数据帧。最终目标是在我打球(练习或实际回合)时使用该应用程序记录数据,这些数据会实时更新,以便快速了解每个俱乐部的平均距离和准确性。
这是我必须为数字输入工作的非常基本的闪亮代码:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("Numeric Add Test"),
column(3,
numericInput("num",
h3("Numeric input"),
value = 1,
min = 50,
max = 400,
step = 25))
)
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)`
我已经找到了在列表中包含“添加”按钮的方法,但我希望做的是将新的数字输入添加到引用数据集中的指定变量(俱乐部、距离、准确性)。此操作将更改现有数据,但会添加到其中并随着时间的推移增加数据集。
不确定这是否对上下文有帮助,但下面是我上面描述的用于预处理和视觉效果的脚本文件:
######### Golf Data Practice for App #############
## Read in Data set and address the column names starting with a number
Golfdata <- data.frame(read_csv("Shiny Apps/Golf Dataset .csv"))
Golfdata <- as.data.frame(Golfdata)
#Drop the last two columns for only clubs. Then create shot bias DF as well.
Clubs <- Golfdata %>% select(-c(11,12))
ShotBias <- Golfdata %>% select(c(11,12))
#Visualize the Average club distance
##Convert the club df by summarizing each variable by its average,
## then use the gather() to convert to long instead of wide to finally
## prepare the df for visualizing.
ClubAverage <- Clubs %>% summarise_all(mean) %>% gather(ClubAverage) %>%
mutate_if(is.numeric, round, digits = 0)
library(ggplot2)
value <- ClubAverage$value
ggplot(ClubAverage) +
aes(x = fct_reorder(ClubAverage, value, .desc = TRUE), y = value, label = value,
color = ClubAverage) +
geom_col( show.legend = FALSE, fill = "white") +
geom_text(nudge_y = 10, color = "black", size=4, fontface = "bold") +
labs(x = "Club",
y = "Yards", title = "Average Club Distance") +
theme(panel.background = element_rect(fill="forestgreen"),
panel.grid.major.x = element_blank(),
panel.grid.major = element_line(color = "yellow"),
panel.grid.minor = element_line(color = "yellow1")) +
theme(plot.title = element_text(size = 24L,
face = "bold", hjust = 0.5), axis.title.y = element_text(size = 18L, face = "bold"), axis.title.x =
element_text(size = 18L,
face = "bold"))
## Visualize the Average Accuracy ##
## This time, summarize the columns by their mean,
## but keep as wide -- no gather() function needed.
AverageShotBias <- ShotBias %>% summarise_all(mean)
ggplot(AverageShotBias) +
aes(x = Accuracy.Bias, y = Distance.Bias) +
geom_point(shape = "circle filled",
size = 18L, fill = "yellow") +
labs(x = "Accuracy", y = "Distance", title = "Average Shot Bias") +
theme(panel.background = element_rect(fill="forestgreen")) +
theme(plot.title = element_text(size = 24L, face = "bold", hjust = 0.5), axis.title.y =
element_text(size = 14L,
face = "bold"), axis.title.x = element_text(size = 14L, face = "bold")) +
xlim(-1, 1) +
ylim(-1, 1) +
geom_hline(yintercept = 0, size=1) +
geom_vline(xintercept = 0, size=1)`
我发现有关添加按钮的代码是这里:
` ,actionButton('add','add')
,verbatimTextOutput('list')
)`
这确实创建了一个添加按钮,在更新服务器代码后确实创建了添加输入的列表,但是我希望能够调整代码以将观察结果添加到数据集中的变量。
我假设我会为每个变量创建一个添加按钮,只需要更好地了解如何做到这一点。
图中使用的数据结构尚不清楚,但这是如何在服务器中使用
eventReactive
或 observeEvent
获取输入或更新数据集。 您可以阅读本文以了解其中的区别
server <- function(input, output) {
distance <- eventReactive(input$addButton, {
input$distInput
}, ignoreInit = T, ignoreNULL = F)
accbias <- eventReactive(input$accBiasButton, {
input$accslider
})
distbias <- eventReactive(input$DistBiasButton, {
input$distslider
}, ignoreNULL=F)
output$plot1 <- renderPlot({
input$distInput
mydist <- distance()
# plot
})
output$plot2 <- renderPlot({
input$distInput # use the inputs here
mydist <- distance() # or the reactives
})
}
代码中的两个输出图具有相同的
outputId
跟进我的问题:我已经编写了用户界面的代码,现在我仍在尝试弄清楚如何正确地对服务器进行编码,以便可以将距离和精度数字输入添加到数据框中。然后该数据框将用于创建两个视觉效果。
library(shiny)
library(gridlayout)
library(DT)
library(tidyverse)
ui <- grid_page(
layout = c(
"title title title",
"h1 h2 h3 ",
"h4 h4 h5 "
),
row_sizes = c(
"100px",
"0.86fr",
"1.14fr"
),
col_sizes = c(
"250px",
"0.71fr",
"1.29fr"
),
gap_size = "1rem",
grid_card_text(
area = "title",
content = "My Golf Data",
alignment = "center",
is_title = FALSE
),
grid_card(
area = "h2",
title = "Distance Input",
numericInput(
inputId = "distInput",
label = "Distance",
value = 50L,
min = 50L,
max = 400L,
step = 15L
),
actionButton(
inputId = "addButton",
label = "Add",
width = "100%"
)
),
grid_card(
area = "h1",
title = "Club Select",
radioButtons(
inputId = "clubRadiobuttons",
label = "",
choices = list(
Driver = "D",
`5Wood` = "5W",
`4H` = "4H",
`5I` = "5I",
`6I` = "6I",
`7I` = "7I",
`8I` = "8I",
`9I` = "9I",
PW = "PW",
SW = "SW"
),
width = "100%"
)
),
grid_card(
area = "h3",
title = "Accuracy",
sliderInput(
inputId = "accslider",
label = "Accuracy Bias",
min = -1L,
max = 1L,
value = 0L,
width = "98%",
step = 1L
),
actionButton(
inputId = "accBiasButton",
label = "Add Acc Bias",
width = "100%"
),
sliderInput(
inputId = "distslider",
label = "Distance Bias",
min = -1L,
max = 1L,
value = 0L,
width = "100%",
step = 1L
),
actionButton(
inputId = "DistBiasButton",
label = "Add Dist Bias",
width = "100%"
)
),
grid_card(
area = "h5",
title = "Average Club Distance",
plotOutput(
outputId = "plot",
width = "100%",
height = "400px"
)
),
grid_card(
area = "h4",
title = "Accuracy Average",
plotOutput(
outputId = "plot",
width = "100%",
height = "400px"
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)