Update of the variable by constant in shiny - r

The community helped me in developing this code
library(shiny)
server <- shinyServer(function(input, output, session) {
values <- reactiveValues()
values$df <- data.frame(N = numeric(0), A = numeric(0), C = numeric(0))
newEntry <- observeEvent(input$update,{
gr <- 10 + input$n
newLine <- isolate(c(input$n, input$nr1, gr))
values$df[nrow(values$df) + 1,] <- c(input$n, input$nr1, gr)
})
output$table1 <- renderTable({values$df})
})
ui <- shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("nr1", "Give a number: ", min = 0, max = 100, value = 0, step = 2),
sliderInput("n", "N:", min = 10, max = 1000, value = 200, step = 10),
actionButton("update", "Update Table"))),
column(6, tableOutput("table1"))
)
))
shinyApp(ui, server)
And I come to a new problem with that.
Now, I'd like that the app do like this: on click on the update, the variable A should always add a 5 i.e. if I have starting value of 5 than on the next click it should be 10 than 15, 20 etc?
Now when I click update the same number appears continously

Is this what you want? Also you dont need the isolate in there.
rm(list = ls())
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("nr1", "Give a number:", min = 1, max = 100, value = 1, step = 1),
sliderInput("n", "N:", min = 10, max = 1000, value = 200, step = 10),
actionButton("update", "Update Table"))),
column(6, tableOutput("table1"))
)
))
server <- shinyServer(function(input, output, session) {
values <- reactiveValues()
values$df <- data.frame(N = numeric(0), A = numeric(0), C = numeric(0))
newEntry <- observeEvent(input$update,{
if(!is.null(input$nr1) & is.null(values$A)){
values$A <- input$nr1
}
if(nrow(values$df) > 0){
values$A <- values$A + 5
}
gr <- 10 + input$n
values$df[nrow(values$df) + 1,] <- c(input$n, values$A, gr)
})
output$table1 <- renderTable({values$df})
})
shinyApp(ui, server)

Related

Can you have two interdependent inputs in R Shiny that rely on other inputs?

I'm looking at having two sliders that should update together, based on some function. For example, one slider is the square root of the other. I want to be able to change either slider and for the other one to update reactively.
The following does work:
library(shiny)
server = function(input, output) {
f = reactive(function(x) x^2)
finv =reactive(function(x) sqrt(x))
output$x <- renderUI({
slider_s.value <- input$s
default.slider_x <- if (is.null(slider_s.value)) 1 else f()(slider_s.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
output$s <- renderUI({
slider_x.value <- input$x
default.slider_s <- if (is.null(slider_x.value)) finv()(1) else finv()(slider_x.value)
sliderInput("s", "Select s:",
min = 0, max=10,
value = default.slider_s, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
}
ui = fluidPage(
titlePanel("One Way Reactive Slider"),
fluidRow(
column(3,
wellPanel(
h4("Slider Inputs"),
uiOutput('s'),
uiOutput('x')
))
)
)
shinyApp(ui = ui, server = server)
However, this doesn't.
library(shiny)
server = function(input, output) {
g = reactive(function(x) x^2 - input$slider)
ginv =reactive(function(x) sqrt(x+ input$slider))
output$slider <- renderUI({
sliderInput("slider", "Slider input:",
min = 1, max = 100, value = 2)
})
output$x <- renderUI({
slider_s.value <- input$s
default.slider_x <- if (is.null(slider_s.value)) 1 else g()(slider_s.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
output$s <- renderUI({
slider_x.value <- input$x
default.slider_s <- if (is.null(slider_x.value)) ginv()(1) else ginv()(slider_x.value)
sliderInput("s", "Select s:",
min = 0, max=10,
value = default.slider_s, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})
}
ui = fluidPage(
titlePanel("One Way Reactive Slider"),
fluidRow(
column(3,
wellPanel(
h4("Slider Inputs"),
uiOutput('slider'),
uiOutput('s'),
uiOutput('x')
))
)
)
shinyApp(ui = ui, server = server)
It messes up when the "Slider Input" is changed. Is there some way that I can get round this? I've seen other posts on here about constraining sliders but none seem to rely on other inputs like this.
Note that I want x = g(s) and s = ginv(x) which should be okay since g and ginv are inverses of each other!
Some changes are required in output$x <- RenderUI code block to fix the slider values flickering issue.
output$x <- renderUI({
slider_slider.value <- input$slider
default.slider_x <- if (is.null(slider_slider.value)) 1 else g()(slider_slider.value)
sliderInput("x", "Select x:",
min = 0, max=100,
value = default.slider_x, step = 0.01,
animate = animationOptions(interval = 600, loop = TRUE))
})

Extract a value from reactive data frame in shiny

I am not sure how I extract a value from a reactive data frame and use it for calculation. The reactive output did not show up so I could not calculate what I want it the end. When I run the script below, I got an error as "$ operator is invalid for atomic vector"
Exercise<-c(A,B,C)
Var1<-c(60,90,50)
Var2<-c(0.5,0.7,0.3)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(numericInput(inputId = "Time1",
label = "Duration:",
min = 0,
max = 120,
value = 1),
selectInput(
inputId = "Drill1",
label = "Drill1",
choices = Exercise,
selected = "1")
),
mainPanel(h3(textOutput("Power"))
)
)
)
server <- function(input, output) {
d<- reactive({
res<-T1 %>%
filter(Exercise == input$Drill1)
res
})
output$Power <- renderPrint({
dataset <-d()
Int<-dataset$Var1[dataset$Exercise == input$Drill1]
results<-Time1*Int
results
})
}
I really appreciate your help in advance.
I tidied up your code a little bit and ran it in a new R session. Unfortunately, I couldn't reproduce this issue. The app below runs fine on my machine.
library(shiny)
library(dplyr)
T1 <- data.frame(
Exercise = c("A", "B", "C"),
Var1 = c(60, 90, 50),
Var2 = c(0.5, 0.7, 0.3)
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(
inputId = "Time1",
label = "Duration:",
min = 0,
max = 120,
value = 1
),
selectInput(
inputId = "Drill1",
label = "Drill1",
choices = T1$Exercise
)
),
mainPanel(h3(textOutput("Power")))
)
)
server <- function(input, output) {
d <- reactive({
filter(T1, Exercise == input$Drill1)
})
output$Power <- renderPrint({
dataset <- d()
Int <- dataset$Var1[dataset$Exercise == input$Drill1]
input$Time1*Int
})
}
shinyApp(ui, server)

Shiny: How to print in log the name of updated object?

I try to print in log an input which has been updated by a user in an app. Something very close can be done with observeEvent.
observeEvent(c(input$integer, input$decimal, input$range), {
flog.info(glue::glue('The user updated a value!'))
})
But I want to see in log the name of updated object without its containing values. How is it possible to do?
if (interactive()) {
library(shiny)
library(futile.logger)
library(glue)
ui <- fluidPage(
titlePanel("Sliders"),
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000,
value = 500),
sliderInput("decimal", "Decimal:",
min = 0, max = 1,
value = 0.5, step = 0.1),
sliderInput("range", "Range:",
min = 1, max = 1000,
value = c(200,500))
),
mainPanel(
tableOutput("values")
)
)
)
# Define server logic for slider examples ----
server <- function(input, output) {
observeEvent(c(input$integer, input$decimal, input$range), {
flog.info(glue::glue('The user updated a value!'))
})
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
data.frame(
Name = c("Integer",
"Decimal",
"Range"),
Value = as.character(c(input$integer,
input$decimal,
paste(input$range, collapse = " "))),
stringsAsFactors = FALSE)
})
# Show the values in an HTML table ----
output$values <- renderTable({
sliderValues()
})
}
# Create Shiny app ----
shinyApp(ui, server)
}
A solution with the help of the shiny:inputchanged event:
library(shiny)
js <- "
$(document).on('shiny:inputchanged', function(e) {
if(e.name != 'updated' && e.name != '.clientdata_output_values_hidden'){
Shiny.setInputValue('updated', e.name, {priority: 'event'});
}
});"
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
titlePanel("Sliders"),
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000, value = 500),
sliderInput("decimal", "Decimal:",
min = 0, max = 1, value = 0.5, step = 0.1),
sliderInput("range", "Range:",
min = 1, max = 1000, value = c(200,500))
),
mainPanel(
tableOutput("values")
)
)
)
server <- function(input, output) {
observeEvent(input$updated, {
# do something with the name of the updated input,
# e.g flog.info(glue::glue(input$updated))
print(input$updated)
})
sliderValues <- reactive({
data.frame(
Name = c("Integer",
"Decimal",
"Range"),
Value = as.character(c(input$integer,
input$decimal,
paste(input$range, collapse = " "))),
stringsAsFactors = FALSE)
})
output$values <- renderTable({
sliderValues()
})
}
shinyApp(ui, server)

Initial scaling in shiny

I've got a problem using the shiny package in R. I'm trying to insert income. debt and bonus entered in the slider that I've built into the original data set so the algorithm can scale i.e. normalise the data to make the calculation. Right now I can only make the calculation as-is i.e. when you enter the data it calculates it however, as I indicated, I want the data entered to go back into the original data set so I can scale it before making the calculation. I have the below code for the shiny package.
library(shiny)
shinyUI(fluidPage(
headerPanel("Calculating fwbs"),
sidebarPanel(
sliderInput("Income", "Please Select Income: ", min=0, max=5000,
value=2500, step=100),
sliderInput("Debt", "Please Select Debt: ", min = 0, max=2500,
value=1250, step = 100),
sliderInput("Bonus", "Have you received any bonus: ", min=0, max= 1000,
value=500, step =100)
),
mainPanel(
textOutput("fwbi")
)
))
shinyServer(function(input, output, session){
output$fwbi <- renderText({
income2<- input$Income
debt2<- input$Debt
bonus2<- input$Bonus
paste("Your fwbi is: ", income2 + debt2 + bonus2)
})
})
Many thanks
If you want to be able to add an arbitrary number of rows to the original data, you can use a reactiveValues list:
Dframe <- data.frame(income = rnorm(5),
debt = rnorm(5),
bonus = rnorm(5))
library(shiny)
shinyApp(
ui =
shinyUI(
fluidPage(
headerPanel("Calculating fwbs"),
sidebarPanel(
sliderInput("Income", "Please Select Income: ", min=0, max=5000,
value=2500, step=100),
sliderInput("Debt", "Please Select Debt: ", min = 0, max=2500,
value=1250, step = 100),
sliderInput("Bonus", "Have you received any bonus: ", min=0, max= 1000,
value=500, step =100),
actionButton(inputId = "btn_add_to_data",
label = "Add To Data")
),
mainPanel(
textOutput("fwbi"),
tableOutput("data")
)
)
),
server =
shinyServer(function(input, output, session){
# Store the original data at start up.
Data <- reactiveValues(
Source = Dframe
)
# Every time you click "Add Data", it will add the user-input to Data$Source
observeEvent(
input$btn_add_to_data,
{
new_row <- data.frame(income = input$Income,
debt = input$Debt,
bonus = input$Bonus)
Data$Source <- rbind(Data$Source,
new_row)
}
)
output$fwbi <- renderText({
income2<- input$Income
debt2<- input$Debt
bonus2<- input$Bonus
paste("Your fwbi is: ",
scale(Data$Source$income) +
scale(Data$Source$debt) +
scale(Data$Source$bonus))
})
output$data <- renderTable({
Data$Source
})
})
)
If you want to limit the user to only adding one row, you can use an eventReactive
Dframe <- data.frame(income = rnorm(5),
debt = rnorm(5),
bonus = rnorm(5))
library(shiny)
shinyApp(
ui =
shinyUI(
fluidPage(
headerPanel("Calculating fwbs"),
sidebarPanel(
sliderInput("Income", "Please Select Income: ", min=0, max=5000,
value=2500, step=100),
sliderInput("Debt", "Please Select Debt: ", min = 0, max=2500,
value=1250, step = 100),
sliderInput("Bonus", "Have you received any bonus: ", min=0, max= 1000,
value=500, step =100),
actionButton(inputId = "btn_add_to_data",
label = "Add To Data")
),
mainPanel(
textOutput("fwbi"),
tableOutput("data")
)
)
),
server =
shinyServer(function(input, output, session){
NewData <- eventReactive(
input$btn_add_to_data,
{
new_row <- data.frame(income = input$Income,
debt = input$Debt,
bonus = input$Bonus)
rbind(Dframe,
new_row)
}
)
output$fwbi <- renderText({
income2<- input$Income
debt2<- input$Debt
bonus2<- input$Bonus
paste("Your fwbi is: ",
scale(NewData()$income) +
scale(NewData()$debt) +
scale(NewData()$bonus))
})
output$data <- renderTable({
NewData()
})
})
)
We can change the codes to
library(shiny)
library(DT
-create a function
fscale <- function(data = NULL) {
ui <- fluidPage(
headerPanel(title = "Calculating fwbs"),
sidebarPanel(
sliderInput("Income", "Please Select Income: ", min=0, max=5000,
value=2500, step=100),
sliderInput("Debt", "Please Select Debt: ", min = 0, max=2500,
value=1250, step = 100),
sliderInput("Bonus", "Have you received any bonus: ", min=0, max= 1000,
value=500, step =100),
numericInput("n", "Number of rows to scale:", 10, min = 1, max = 100)
),
mainPanel(
textOutput("fwbi"),
dataTableOutput("data"))
)
server <- function(input, output, session){
dat_scale <- reactive({
n1 <- seq_len(input$n)
data[["Income"]][n1] <- (data$Income[n1] - input$Income)/data$Income[n1]
data[["Debt"]][n1] <- (data$Debt[n1] - input$Debt)/data$Debt[n1]
data[["Bonus"]][n1] <- (data$Bonus[n1] - input$Bonus)/data$Bonus[n1]
data
})
output$data <- renderDataTable({
dat_scale()
})
output$fwbi <- renderText({
income2<- input$Income
debt2<- input$Debt
bonus2<- input$Bonus
paste("Your fwbi is: ", income2 + debt2 + bonus2)
})
}
shinyApp(ui= ui, server = server)
}
-run the function
fscale(df1)
-output
data
set.seed(24)
df1 <- data.frame(Income = sample(0:5000, 25, replace = TRUE),
Debt = sample(0:2500, 25, replace = TRUE),
Bonus = sample(0:1000, 25, replace = TRUE))

Table output of values Shiny

I am trying to generate a table/list in Shiny of the values sampled from a probability distribution ( a list of the sampled values in a table format). I'm new to coding so this is like a foreign language to me. There is probably a lot of errors in the code although I can get it to run just not show the table.
library(shiny)
ui <- fluidPage(
sidebarPanel(
selectInput("dis","Please Select Probability Distribution Type:",
choices = c("Normal")),
sliderInput("sampleSize","Please Select Sample Size:",
min = 0,max = 5000,value = 1000,step = 100),
sliderInput("bins","Please Select Number of Bins:",
min = 1,max = 50,value = 10),
numericInput("sampleMean","Please Enter Sample Mean:",
min = 0,max = 5000,value = 2500,step = 10),
numericInput("sampleSd","Please Enter Standard Deviation:",
min = 0,max = 5000,value = 2,step = 10)
),
fluidRow(
column(12,
dataTableOutput("table"))
),
mainPanel(
plotOutput("histogram")
)
)
server <- function(input, output){
output$histogram <- renderPlot({
distType <- input$dis
n <- input$sampleSize
bins <- seq(min(input$bins), max(input$bins), length.out = input$bins + 1)
if(distType=="Normal"){
randomVec <- rnorm(n,mean = as.numeric(input$sampleMean),sd=as.numeric(input$sampleSd))
}
hist(randomVec,breaks=input$bins,col="red")
})
output$table <- renderDataTable({
distType <- input$dis
n <- input$sampleSize
if(distType=="Normal"){
randomVec <- rnorm(n,mean = as.numeric(input$sampleMean),sd= as.numeric(input$sampleSd))
}
sample(randomVec,100,replace = TRUE)
})
}
shinyApp(ui = ui, server = server)
From ?renderDataTable :
Arguments
expr An expression that returns a data frame or a matrix.
So you can do this:
output$table <- renderDataTable({
distType <- input$dis
n <- input$sampleSize
if(distType=="Normal"){
randomVec <- rnorm(n,mean = as.numeric(input$sampleMean),sd= as.numeric(input$sampleSd))
}
data.frame(sample(randomVec,100,replace = TRUE))
})

Resources