sorry if this is repetitive and so simple it is annoying, but I am new to Shiny.
I need help with a shiny app I am trying to create for my golf game. I have loaded a CSV file with previous distance and accuracy observations to Rstudio and completed a script file with what will generally be done: data preprocessing and then visualizations.
I am now struggling with converting that to the app.R file, specifically, how to create a widget where I can add new numeric observations to the current data frame. The end goal is to use the app to log data as I play (practice or an actual round), which updates in real time for quick insight into the average distance and accuracy for each club.
Here is the very basic shiny code I have got to work for the numeric input:
`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)`
I have found ways to include an 'add' button to a list, but what I am hoping to do is have the new numeric input be added to the specified variable (club, distance, accuracy) in the referenced dataset. This action would change the existing data, but add to it and grow the dataset over time.
Not sure if this helps for context at all, but below is the script file for preprocessing and visuals I described above:
`######### 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)`
Something I have found regarding the add button is the code here:
` ,actionButton('add','add')
,verbatimTextOutput('list')
)`
This does create an add button, which after updating the server code does create a list of added inputs, however I would like to be able to adjust the code for adding the observation to the variables in the data set.
I assume I would create an add button for each variable, just need to understand better how to do that.
The structure of your data used in the plot is not clear, but this is how to get the inputs or update dataset using eventReactive or observeEvent in the server. you can read this to learn the difference
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
})
}
the two output plots in your code have the same outputId
Follow UP to my Question: I have written the code for the ui, now I am still trying to figure out how to code the server properly so the distance and accuracy numeric inputs can be added to a data frame. That data frame will then be used to create the two visuals.
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)
I have the code below, but the options for the individual columns widths I want to control is not doing anything.
output$search_results <- DT::renderDataTable(filtered_df(),
server=TRUE,
extensions = c('Buttons', 'ColReorder', 'FixedColumns','FixedHeader', 'KeyTable'),
options = list(
#dom = 'Blfrtip',
dom = 'Blptilp',
colReorder = TRUE,
buttons = c('copy', 'csv', 'excel'),
autoWidth = TRUE,
scrollX = TRUE,
scrollY = "500px",
fixedColumns = list(leftColumns = 2),
fixedHeader = TRUE,
keys=TRUE,
lengthMenu = c(5,10,20,50,100),
columnDefs = list(list(width = '500px', targets = c(0,1)))
)
)
I have a data frame with a lot of rows and columns, so I added a horizontal scroll bar so the columns wouldn't be squished. However In order to access the scroll bar I need to scroll all the way to the bottom of the datatable.
Is there an option to lock the horizontal scroll bar to the bottom of your screen and not the bottom of the datatable in the base DT package or do I need a DT extension?
output$sheet <- renderDT({
datatable(
display_table(),
options = list(
scrollX = TRUE,
autoWidth = TRUE,
pageLength = nrow(display_table()),
columnDefs = list(
list(width = "65px", targets = c(1,11)),
list(className = 'dt-center', targets = "_all")
)
)
)
})
I am trying to build a shiny app with shinyMobile, and storing the results using shinyStore, I have been looking at several answers but I haven't been able to fix this. I think there might be an issue with the multiple option.
Here is the code:
library(shiny)
library(shinyMobile)
library(shinyStore)
Species_List <- structure(list(Scientific_name = c("Juncus alpinoarticulatus ssp. nodulosus",
"Diphasiastrum complanatum ssp. complana-tum", "Rubus macrophyllus",
"Equisetum scirpoides", "Trifolium hybridum ssp. hybridum", "Narthecium ossifragum",
"Peucedanum oreoselinum", "Sonchus oleraceus", "Juncus subnodulosus",
"Minuartia viscosa"), Danish_name = c("siv, stilk-", "ulvefod, flad",
"brombær, storbladet", "padderok, tråd-", "kløver, alsike-",
"benbræk", "svovlrod, bakke-", "svinemælk, almindelig", "siv, butblomstret",
"norel, klæbrig")), row.names = c(NA, -10L), class = "data.frame")
shinyApp(
ui = f7Page(
title = "Species app",
f7SingleLayout(
navbar = f7Navbar(
title = "Select Species",
hairline = TRUE,
shadow = TRUE
),
toolbar = f7Toolbar(
position = "bottom",
f7Link(label = "Link 1", href = "https://www.google.com"),
f7Link(label = "Link 2", href = "https://www.google.com")
),
initStore("store", "shinyStore-ex1"),
# A button to save current input to local storage
actionButton("save", "Save", icon("save")),
# A button to clear the input values and local storage
actionButton("clear", "Clear", icon("stop")),
# main content
f7Shadow(
intensity = 16,
hover = TRUE,
f7SmartSelect(inputId = "SpeciesListSc",
label = "Select all species",
multiple = TRUE,
choices = unique(Species_List$Scientific_name),
virtualList = T,
openIn = "sheet")
)
)
),
server = function(input, output, session) {
observe({
if (input$save <= 0){
updateF7SmartSelect(session, inputId = "SpeciesListSc", selected = isolate(input$store)$SpeciesListSc, choices = unique(Species_List$Scientific_name), multiple = TRUE)
}
})
observe({
if (input$save > 0){
updateStore(session, name = "SpeciesListSc", isolate(input$SpeciesListSc))
}
})
}
)
I have selectInputs in my Shiny application but they leave a lot of blank gaps.
selectInput("vicNation", "Select victim nationality: ",
choices = sort(unique(newngo$Victim.Nationality)), selected = NULL,
multiple = TRUE, selectize = TRUE, width = NULL, size = NULL)
When I run it i get:
Is it possible to move the selectInput to beside the text so there is less blank spaces
As mentioned in the comments:
ui <- fluidPage(
fluidRow(column(3,
"Select victim nationality: "),
column(6,
selectInput("vicNation", label = NULL,
choices = c('German','English','French'), selected = NULL,
multiple = TRUE, selectize = TRUE, width = NULL, size = NULL)
)
)
)