Related
I have this R Shiny that gives me values of Meters covered based on the drill selected and the time selected by the user. Here is my code.
library(shiny)
library(dplyr)
# MyData <- read.csv("/Users/sonamoravcikova/Desktop/ShinyTest/ForShiny1.csv")
MyData <- structure(list(Drill = c("GP Warm Up", "5v2 Rondo", "11v11", "10v6 Drop
Behind Ball"), PlayerLoadPerMinute = c(7.72949670665213, 6.49382926701571,
9.67483408668731, 5.86770863636364), MetersPerMinute = c(69.9524820610687,
45.823744973822, 95.9405092879257, 58.185375), class = "data.frame", row.names
= c(NA, -4L)))
# Define UI ----
ui <- fluidPage(
titlePanel("Practice Planner"),
sidebarLayout(
sidebarPanel(
#Select number of drills
numericInput("num", h3("Number of Drills"), value = 1),
),
mainPanel(
#Show boxes for the number of drill selected and select drill type
selectInput("DrillName1",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider1",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM1"),
br(),
conditionalPanel(
condition = "input.num > '1'",
selectInput("DrillName2",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider2",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM2")),
br(),
conditionalPanel(
condition = "input.num > '2'",
selectInput("DrillName3",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
sliderInput("slider3",
label = h3("Slider"),
min = 0,
max = 60,
value = 0),
textOutput("MpM3"))
)
)
)
# Define server logic ----
server <- function(input, output, session) {
#Calculate number of meters covered
lapply(1:10, function(x) {
output[[paste0("MpM", x)]] <- renderText({
chosendrill <- input[[paste0("DrillName", x)]]
MpM <- MyData %>%
distinct(MetersPerMinute, .keep_all = T)
MpM_text <- (MpM$MetersPerMinute[MpM$Drill == chosendrill]) * (input[[paste0("slider", x)]])
paste0("Meters covered: ", paste0(MpM_text, collapse = " "))
})
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
Now I'm trying to just add all of the values that I get for the individual drills together so that I will get Meters covered for the whole session but I have no idea how to do that. So if someone could help me out where to start I would appreciate it. Thanks
What I have
I made a Shiny app that shows a plot with some points.
You can manually change the y axis. There is a button that allows to automatically adjust the y axis so it fits the data. There is a drop-down box that allows you to select data.
I have this code:
library(shiny)
# user interface ----------------------------------------------------------
ui <- fluidPage(
fluidRow(plotOutput("myplot")),
tabsetPanel(
tabPanel(
"Input",
fluidRow(
column(
2,
numericInput(inputId = "ymax", label = "y-axis maximum", value = 30),
numericInput(inputId = "ymin", label = "y-axis minimum", value = 9),
actionButton("fity", label = "zoom to fit")
),
column(
2,
selectInput(inputId = "yaxis", label = "y-axis",
choices = list("1 to 5" = 1,
"3 to 7" = 2)
),
checkboxInput("mybx", label = "checkbox", value = TRUE)
)
)
),
fluidRow()
)
)
# server function ---------------------------------------------------------
server <- function(input, output, session) {
ydata <- reactive({
switch(input$yaxis,
"1" = {
updateCheckboxInput(session, "mybx", value = TRUE)
1:5},
"2" = {
updateCheckboxInput(session, "mybx", value = FALSE)
3:7}
)
})
observeEvent(input$fity, {
newymax <- trunc(max(ydata())) + 1
newymin <- trunc(min(ydata()))
updateNumericInput(session, "ymax", value = newymax)
updateNumericInput(session, "ymin", value = newymin)}
)
output$myplot <- renderPlot({
par(mar = c(4, 4, 0.1, 0.1))
plot(x = 1:5, y = ydata(), ylim = c(input$ymin, input$ymax))
})
}
shinyApp(ui = ui, server = server)
What I want to do
I want that the fit-y-axis code triggered by the action button will also be triggered when I'm changing the data with the dropdown box.
Things I've tried:
This. But I think it doesn't like getting a selectInput together with the button.
Putting the fit-y-axis code into a separate function, calling the function from both ydata <- reactive and observeEvent. Did not work. Cries about recursion (obviously - it's calling ydata again from inside ydata!).
Any help would be appreciated.
Why not just have another observeEvent that monitors the change in the yaxis input?
library(shiny)
# user interface ----------------------------------------------------------
ui <- fluidPage(
fluidRow(plotOutput("myplot")),
tabsetPanel(
tabPanel(
"Input",
fluidRow(
column(
2,
numericInput(inputId = "ymax", label = "y-axis maximum", value = 30),
numericInput(inputId = "ymin", label = "y-axis minimum", value = 9),
actionButton("fity", label = "zoom to fit")
),
column(
2,
selectInput(inputId = "yaxis", label = "y-axis",
choices = list("1 to 5" = 1,
"3 to 7" = 2)
),
checkboxInput("mybx", label = "checkbox", value = TRUE)
)
)
),
fluidRow()
)
)
server <- function(input, output, session) {
ydata <- reactive({
switch(input$yaxis,
"1" = {
updateCheckboxInput(session, "mybx", value = TRUE)
1:5},
"2" = {
updateCheckboxInput(session, "mybx", value = FALSE)
3:7}
)
})
observeEvent(input$fity, {
newymax <- trunc(max(ydata())) + 1
newymin <- trunc(min(ydata()))
updateNumericInput(session, "ymax", value = newymax)
updateNumericInput(session, "ymin", value = newymin)}
)
observeEvent(input$yaxis, {
newymax <- trunc(max(ydata())) + 1
newymin <- trunc(min(ydata()))
updateNumericInput(session, "ymax", value = newymax)
updateNumericInput(session, "ymin", value = newymin)}
)
output$myplot <- renderPlot({
par(mar = c(4, 4, 0.1, 0.1))
plot(x = 1:5, y = ydata(), ylim = c(input$ymin, input$ymax))
})
}
shinyApp(ui = ui, server = server)
But this makes your 'zoom to fit' button redundant.
I have a leaflet map in my main panel and I want to place a dygraph inside an absolutePanel within an R shiny app.
My problem is that I can't see the dygraph inside the absolutePanel.
The code in my ui.R is like this:
library(dygraphs)
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 300, height = "auto",
h2("Sensitivity Explorer"),
sliderInput(inputId="year",
label="Select a forecast year",
value=2018, min=2018, max=2050),
numericInput("months", label = "Months to Predict",
value = 72, min = 12, max = 144, step = 12),
selectInput("interval", label = "Prediction Interval",
choices = c("0.80", "0.90", "0.95", "0.99"),
selected = "0.95"),
checkboxInput("showgrid", label = "Show Grid", value = TRUE),
dygraphOutput("dygraph",width = '50%')
)
and my server.R :
library(dygraphs)
function(input, output, session) {
predicted <- reactive({
hw <- HoltWinters(ldeaths)
predict(hw, n.ahead = input$months,
prediction.interval = TRUE,
level = as.numeric(input$interval))
})
output$dyngraph <- renderDygraph({
if (nrow(zipsInBounds()) == 0)
return(NULL)
dygraph(predicted(), main = "Predicted Deaths/Month") %>%
dySeries(c("lwr", "fit", "upr"), label = "Deaths") %>%
dyOptions(drawGrid = input$showgrid)
})
}
Make sure you test for null first, also make use of req to find out how it works just type?req. Also its dyngraph btw
rm(list = ls())
library(shiny)
library(dygraphs)
ui <- fluidPage(
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 300, height = "auto",
h2("Sensitivity Explorer"),
sliderInput(inputId="year",
label="Select a forecast year",
value=2018, min=2018, max=2050),
numericInput("months", label = "Months to Predict",
value = 72, min = 12, max = 144, step = 12),
selectInput("interval", label = "Prediction Interval",
choices = c("0.80", "0.90", "0.95", "0.99"),
selected = "0.95"),
checkboxInput("showgrid", label = "Show Grid", value = TRUE),
dygraphOutput("dyngraph",width = '50%')
)
)
server <- function(input, output, session){
zipsInBounds <- reactive({mtcars[0,0]})
predicted <- reactive({
req(input$interval)
req(input$months)
hw <- HoltWinters(ldeaths)
predict(hw, n.ahead = as.numeric(input$months),
prediction.interval = TRUE,
level = as.numeric(input$interval))
})
output$dyngraph <- renderDygraph({
if (is.null(zipsInBounds()))
return()
dygraph(predicted(), main = "Predicted Deaths/Month") %>%
dySeries(c("lwr", "fit", "upr"), label = "Deaths") %>%
dyOptions(drawGrid = input$showgrid)
})
}
shinyApp(ui = ui, server=server)
I am building a simple RShiny App that calculates sample size and power, but I keep getting this error message---
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
I couldn't figure out how to fix it. This is my first time using RShiny. If anyone can help, I really appreciate that! Thanks a lot!
library(shiny)
ui <- fluidPage(
headerPanel("Power and Sample Size Calculator"),
fluidRow(column(12,
wellPanel(
helpText("Two proportions (equal sample size in each group) power/sample size analysis"),
selectInput (inputId = "choice",
label = " Please Choose What You Want To Calculate",
c("Power","Sample Size"),selected = NULL,
multiple = FALSE,
selectize = TRUE, width = NULL, size = NULL)
)),
column(4,
wellPanel(
conditionalPanel(
condition = "input$choice = Power",
numericInput (inputId = "tau",
label = "Effect Size",
value = "0.2",
min = 0, max =1),
numericInput (inputId = "n",
label = "Sample Size in Each Group",
value = "200",
min = 0,
max = 100000000),
sliderInput (inputId = "alpha",
label = "Significance Level ⍺= ",
value = "0.05",
min = 0.001, max = 0.10)),
conditionalPanel(
condition = "input$choice=Sample Size",
numericInput (inputId = "tau",
label = "Effect Size",
value = "0.2",
min = 0, max =1),
sliderInput (inputId = "alpha",
label = "Significance Level ⍺= ",
value = "0.05",
min = 0.001, max = 0.10),
numericInput (inputId = "beta",
label = "Power",
value = "0.8",
min = 0,
max = 1))
)
),
column(8,
wellPanel(
htmlOutput("Result")
))
))
server <- function(input, output) {
choice <- switch (input$choice,
"Power" = 1, "Sample Size" = 2)
output$Result <- renderUI({
if(choice==1){
final=reactive({pwr.2p.test(h = input$tau, n = input$n, sig.level = input$alpha, power = )
})
}
if(choice==2){
final=reactive({pwr.2p.test(h = input$tau, n = , sig.level = input$alpha, power = input$beta)
})}
HTML(final)
}
)
}
shinyApp(ui=ui, server=server)
I don't think it is required to have reactive for final. try this below.
it works for me, except for pwr.2p.test, looks like that is some function you are trying to use. Also, I did not understand why you had HTML(final), use of renderUishould generate html by default. Let me know how did it go. Good luck
server <- function(input, output) {
choice <- reactive({
switch(input$choice,"Power" = 1,"Sample Size" = 2)})
output$Result <- renderUI({
if (input$choice == 'Power') {
pwr.2p.test( h = input$tau,
n = input$n,
sig.level = input$alpha,
power = input$beta
)}
if (input$choice == 'Sample Size') {
pwr.2p.test( h = input$tau,
n = ,
sig.level = input$alpha,
power = input$beta
)}
})
}
I've an R script for which I need to develop and intigrate a user-interface in shiny package in R.
My following is a part of R code that I'm trying to build the interface around:
# A random normal function to generate numbers with exact mean and SD
rnorm2 <- function(n,mean,sd) { mean+sd*scale(rnorm(n)) }
age <- rnorm2(n = 10000, mean = 55 , sd = 15)
cholestrol <- rnorm2(n = 10000, mean = 200 , sd = 30)
bp <- rnorm2(n = 10000, mean = 90 , sd = 25)
df <- cbind(age, cholestrol,bp)
Org_Data <- as.data.frame(df)
As there are 9 inputs (3 each for age, cholestrol and bp) I've created 9 input boxes in which user enters the input and then on a button click I want to run the rnorm2 function that I created.
My shiny app code is as follows:
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("function1"),
sidebarPanel(
#Age input
textInput(inputId = "n1",
label = h4("Enter n for Age:"),
value = ""),
textInput(inputId = "mean1",
label = h4("Enter mean for Age:"),
value = ""),
textInput(inputId = "sd1",
label = h4("Enter sd for Age:"),
value = ""),
#Cholestrol input
textInput(inputId = "n1",
label = h4("Enter n for Cholestrol:"),
value = ""),
textInput(inputId = "mean1",
label = h4("Enter mean for Cholestrol:"),
value = ""),
textInput(inputId = "sd1",
label = h4("Enter sd for Cholestrol:"),
value = ""),
#Blood Pressure input
textInput(inputId = "n1",
label = h4("Enter n for Blood Pressure:"),
value = ""),
textInput(inputId = "mean1",
label = h4("Enter mean for Blood Pressure:"),
value = ""),
textInput(inputId = "sd1",
label = h4("Enter sd for Blood Pressure:"),
value = ""),
actionButton(inputId = "input_action", label = "Show Inputs")),
mainPanel(
h2("Input Elements"), # title with HTML helper
textOutput("td"))
))
But I'm completely helpless at figuring out how to put the R code I mentioned at the beginning into the server.R file. Can I start with simply defining the function?? And then how to run that function on those inputs taken from the user and then save the output into each of theose variables: age, cholestrol and bp???
server.R:
library(shiny)
#defining a function
rnorm2 <- function(n,mean,sd) { mean+sd*scale(rnorm(n)) }
shinyServer(function(input, output){
#Don't know how run the function and save the output into the variables
age <-
cholestrol <-
bp <-
})
})
This is my first day with shiny and all the server.R code samples on the internet are kinda going over my head. But I really need to turn this around today. Please help!!!
The only dependency I added was library(DT) which is an exceptionally useful package.
You'll notice that you needed to make your input ids unique in the ui.R and use an eventReactive to instruct shiny to wait for the input button.
ui.R
library(shiny)
library(DT)
shinyUI(pageWithSidebar(
headerPanel("function1"),
sidebarPanel(
#Age input
numericInput(inputId = "n",
label = h4("Enter n:"),
value = ""),
numericInput(inputId = "mean1",
label = h4("Enter mean for Age:"),
value = ""),
numericInput(inputId = "sd1",
label = h4("Enter sd for Age:"),
value = ""),
#Cholestrol input
numericInput(inputId = "mean2",
label = h4("Enter mean for Cholestrol:"),
value = ""),
numericInput(inputId = "sd2",
label = h4("Enter sd for Cholestrol:"),
value = ""),
#Blood Pressure input
numericInput(inputId = "mean3",
label = h4("Enter mean for Blood Pressure:"),
value = ""),
numericInput(inputId = "sd3",
label = h4("Enter sd for Blood Pressure:"),
value = ""),
actionButton(inputId = "input_action", label = "Show Inputs")),
mainPanel(
h2("Input Elements"), # title with HTML helper
dataTableOutput("inputs"),
h2("Results"),
dataTableOutput("results")
)))
server.R
library(shiny)
library(DT)
rnorm2 <- function(n,mean,sd) { mean+sd*scale(rnorm(n)) }
shinyServer(function(input, output){
data <- eventReactive(input$input_action, {
matrix(
c(rnorm2(input$n, input$mean1, input$sd1),
rnorm2(input$n, input$mean2, input$sd2),
rnorm2(input$n, input$mean3, input$sd3)), byrow = FALSE,
ncol = 3)
})
inpts <- eventReactive(input$input_action, {
data.frame(Type = c("Age", "Cholestorol", "BP"),
N = c(input$n, input$n, input$n),
Mean = c(input$mean1, input$mean2, input$mean3),
SD = c(input$sd1, input$sd2, input$sd3))
})
output$inputs <- renderDataTable({
inpts()
})
output$results <- renderDataTable({
set <- as.data.frame(data())
colnames(set) <- c("Age", "BP", "Cholestorol")
set
})
})