If statement with variable to be used in multiple places - if-statement

I am trying to build a shiny dashboard where i have to use an if statement to determine how a variable should be treated. in this case, the if statement assigns a multiple (either 1 or 0) which is then multiplied by multiple variables later in the code. I am unable to get an IF statement to work outside a renderUI function for some reason. I have tried to make it a reactive function but that did not work either.
server <- function(input, output, session) {
LinerCost <- reactive ({ input$LLDPE_Liner/100 * DirectRM_Cost$Rs_KG[15] +
input$Other_Additive_Liner/100 * DirectRM_Cost$Rs_KG[20]})
reactive({if (input$lamination == "lam_yes") {
lam_rm_multiple = 1} else {
lam_rm_multiple = 0
}})
LamCost <- reactive({ LamCost * lam_rm_multiple })
LinerCost <- reactive ({LinerCost * liner_rm_multiple})
Weight <- reactive ({
as.numeric(input$final_lam_weight) * lam_rm_multiple
})
RMcost <- reactive({
((as.numeric(input$final_unlam_weight) / CombinedWeight()) * UnLamCost())
})
}
shinyApp(ui, server)
Here, I want the lam_rm_multiple to be assigned a value of either 0 or 1 and it is then multiplied to variables and force them to 0 as required. Currently, i get an error in shiny saying - Warning: Error in : object 'lam_rm_multiple' not found

Related

Display a subset of a data frame in a Shiny app

New to Shiny, I am trying to create a very simple app respecting the following sequence of events:
(1) Upload a dataframe,
(2) Wait until the user set the filtering parameter (Category in the example below),
(3) Press a Go! button,
(4) Display the first rows of the subset data frame.
Let's say I have a file df.tab to upload and process.
df <- data.frame(Category=c("A","A","A","B","B","B"), X=c(1,2,3,1,2,3), Y=c(1,2,3,34,21,1))
df
Category X Y
1 A 1 1
2 A 2 2
3 A 3 3
4 B 1 34
5 B 2 21
6 B 3 1
write.table(df, file="df.tab", row.names=F, quote=F, sep="\t")
My app.R looks like:
library(shiny)
# Define UI ----
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("input_df",label=h4("Dataset")),
selectInput("category",h4("Category"), choices = list("A" = 1,"B" = 2),selected = 1),
actionButton("goButton",label = "Go!")
),
mainPanel(
tableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output) {
data <- eventReactive(
input$input_df,
{
File <- input$input_df
if(is.null(File)){
return(NULL)
}else{
df <- read.table(File$datapath, header = T, sep = "\t")
}
}
)
data_sub <- eventReactive(
input$category,
{
df_sub <- subset(data(), Category == input$category)
}
)
output$view <- renderTable(
{
head(data_sub())
}
)
}
# Run the app ----
shinyApp(ui = ui, server = server)
However, the app is either not responsive or does not display any rows.
Note that I created 2 distinct reactive events data and data_sub in order to avoid loading the file every time I select a different category (and potentially to avoid stack errors with a recursive function).
Any help would be greatly appreciated.
Here is a working server function. Use reactive, not eventReactive and it is quite straightforward.
NOTE that your example assumes you have a Category column, I modified below to make it work with anything.
# Define server logic ----
server <- function(input, output) {
dataset <- reactive({
File <- input$input_df
req(File)
read.table(File$datapath, header = TRUE, sep = "\t")
})
data_sub <- reactive({
if("Category" %in% names(dataset())){
subset(dataset(), Category == input$category)
} else {
dataset()
}
})
output$view <- renderTable({
head(data_sub())
})
}

Rhsiny: Automatically update an output object based on updated rhandsontable object

I have an app with two tables. One table is a renderhandsontable object and the other is just a rendertable object. I would like for when I update my renderhandsontable object for it to automatically update my rendertable object. My renderhandontable object is created by data elsewhere in the app using a number of filters.
I have referenced several very useful posts here to help me get this far in creating a reactive table that could be used in multiple output objects such as
How to render multiple output from the same analysis without executing it multiple time? (Shiny)
Get selected rows of Rhandsontable
Handsontable : how to change cell value in render function
but I cannot seem to get past this last hurdle. I also tried adding a button (using eventReactive) so the table would update when I pressed it rather than automatically, but had no luck there (and automatic would definitely be preferred).
I have created an overly simplified version of my server code below.
#dummy data
x = c('A','A','A', 'B','B', 'c')
y = c('G1', 'G1', 'G1', 'G2', 'G2','G3')
z = c('100', '200', '300', '400','500','600')
b=data.frame('Category' = x,
'Group' = y,
'Total' = z)
#create reactive object to be used in multiple places
test <- reactive({
t <-filter(b, b$Category %in% input$cat & b$Group %in% input$group)
return(t)
})
output$test_table <- renderTable({
tbl = data.frame(matrix(0, ncol = 4, nrow = 4))
#I know something needs to be done prior to this step to get updated values #of test()
tbl[1,1] <- test()[1,3]
return(tbl)
})
output$contents <- renderRHandsontable({
rhandsontable(test())
})
I can get my tables to appear properly and the data to update initially, but once I make an update to my table, it is not reflected in my second table.
I have really been struggling with this for quite some time so any help or hints would be greatly appreciated !
Please read this. You can access the rhandsontable params via input$my_id. To get the current data use input$my_id$params$data.
Here is what I think you are after:
library(shiny)
library(rhandsontable)
ui <- fluidPage(rHandsontableOutput("contents"),
tableOutput("test_table"),
tableOutput("test_table_subset"))
server <- function(input, output) {
# dummy data
x = c('A', 'A', 'A', 'B', 'B', 'C')
y = c('G1', 'G1', 'G1', 'G2', 'G2', 'G3')
z = c('100', '200', '300', '400', '500', '600')
b = data.frame('Category' = x,
'Group' = y,
'Total' = z)
# create reactive object to be used in multiple places
test <- reactive({
t <- b # dplyr::filter(b, b$Category %in% input$cat & b$Group %in% input$group)
return(t)
})
output$contents <- renderRHandsontable({
rhandsontable(test())
})
contentsTableDat <- reactive({
req(input$contents)
hot_to_r(input$contents)
})
output$test_table <- renderTable({
contentsTableDat()
})
output$test_table_subset <- renderTable({
contentsTableDat()[1, 3]
})
}
shinyApp(ui = ui, server = server)

Shiny browser(), giving no logic results with if sentence

I am creating a Shiny application and when I am debugging with the browser() function I have errors with the if-statement
For example, if I write this (complete example below):
if(1 < 2)
{
h <- 5
}
And I receive this:
debug at #3: h <- 5
What could be wrong? It looks that if-statment doesn't work inside the browser.
Thanks
library(shiny)
# Global variables can go here
n <- 200
# Define the UI
ui <- bootstrapPage(
numericInput('n', 'Number of obs', n),
plotOutput('plot')
)
# Define the server code
server <- function(input, output) {
browser()
if(1 < 2)
{
h <- 5
}
output$plot <- renderPlot({
hist(runif(input$n))
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)

How to save previous interaction using reactiveValues

I am developing a table which does some calculations each time that an action button is used. One column of my table depends on its previous value,
C_new <- C_old + B_new - A_new
For instance, if A=4, B=A+2 and C= C(-1) + B - A my expected results are
A B C
1 2 3
4 6 5
I have tried to save the previous value of column C using reactiveValue, as mentioned in How to “remember” information from the previous iteration when using reactiveTimer in Shiny?, but it doesn't work. I don't know where I am getting wrong.
Here is my code
library(shiny)
ui <- fluidPage(
sidebarPanel(textInput("c1","Example"),
actionButton("update", "Update Table")),
mainPanel(tableOutput("example"))
)
server <- function(input, output) {
C_old <- reactive(x=3)
values <- reactiveValues(df = data.frame(A=1, B=2, C=3))
newEntry <- observeEvent(input$update,{
A_new <- as.numeric(input$c1)
B_new <- A_new + 2
C_new <- isolate (C_old$x + B_new - A_new)
C_old$x <<- C_new
new <- data.frame(A=A_new,B=B_new, C=C_new)
# attach the new line to the old data frame here:
values$df <- rbind(values$df, new)
})
# Print the content of values$df
output$example <- renderTable({
return(values$df)
})
}
shinyApp(ui = ui, server = server)
Important to know, observeEvents (similar to observes) don't have outputs. You just observe a change and do something in their body, but nothing is supposed to be returned (this is different to reactive({ }), which also observes changes but has return values), useful link.
Isolate is not needed in observeEvent , because nothing triggers an update except for input$update (this is different to observe and reactive, where all changeable items in the body trigger an update).
Below is the solution to your problem. I used reactiveVal which stores one single updateable value (see ?reactiveVal for help). After clicking the action button, I retrieve the old table by calling values(), calculate all new values (beware, I need to use tail to get only the last C value) and attach the result to the old value before storing the extended table into values by calling values(new_df):
library(shiny)
ui <- fluidPage(
sidebarPanel(numericInput("c1","Example", 0),
actionButton("update", "Update Table")),
mainPanel(tableOutput("example"))
)
server <- function(input, output) {
# stores the current data frame, called by values() and set by values(new_data_table)
values <- reactiveVal(data.frame(A=1, B=2, C=3))
# update values table on button click
observeEvent(input$update,{
old_values <- values()
A_new <- input$c1
B_new <- A_new + 2
C_new <- tail(old_values$C, 1) + B_new - A_new # tail to get the last C value
new_values <- data.frame(A=A_new, B=B_new, C=C_new)
# attach the new line to the old data frame here:
new_df <- rbind(old_values, new_values)
#store the result in values variable
values(new_df)
})
# Print the content of values$df
output$example <- renderTable({
return(values())
})
}
shinyApp(ui = ui, server = server)

shiny: manipulating global variables to input back into shiny

I have made a shiny app the removes outlying experimental artefacts:
df=data.frame(seq(-1000,1000), rnorm(2001)) #not real data
ui <- basicPage(
plotOutput("plot1", click = "plot_click", brush = "plot_brush"),
verbatimTextOutput("info"),
plotOutput("tab")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(df[,1], df[,2])
})
data_new<-eventReactive(input$plot_brush,{
da=df
rowmin <- which(da[,1] == round(as.numeric(input$plot_brush$xmin)))
rowmax <- which(da[,1] == round(as.numeric(input$plot_brush$xmax)))
da[rowmin:rowmax,2] = mean(da[,2])
da=isolate(da)
#writeToDatabase(da)
})
#output$zoom<-renderable({plot(data_new()[,1], data_new()[,2])})
output$tab=renderPlot({plot(data_new()[,1], data_new()[,2])})
}
shinyApp(ui, server)
This works fine but it is inconvenient that I can not permanently remove the artefacts i.e. I was wondering is there any way to make the values of the non-reactive variable permanently retain the changes made rather than the original incorrect data frame being replotted each time?
I have tried using a function that corrected the faulty data-variable 'df':
change=reactive(function(d){
rowmin <- which(d[,1] == round(as.numeric(input$plot_brush$xmin)))
rowmax <- which(d[,1] == round(as.numeric(input$plot_brush$xmax)))
d[rowmin:rowmax,2] = mean(d[,2])
return(isolate(d))
})
isolate(change(df))
but I get the following error:
Listening on http://127.0.0.1:6183
Warning: Error in change: unused argument (df)
Stack trace (innermost first):
52: change
51: is.data.frame
50: write.table
43: isolate
42: server [/Users/Downloads/test.R#20]
1: runApp
Error in change(df) : unused argument (df)
This was a starter test to see if I could dynamically update the variable. All of this is with the aim of being able to successively view and eliminate each of the sharp error peaks in my data shown above- rather than the code re-running on the same immutable (from shiny's perspective) variable each time??
You probably want to use reactiveValues:
server <- function(input, output) {
my <- reactiveValues(df=data.frame(seq(-1000,1000), rnorm(2001))) # Initialize df
output$plot1 <- renderPlot({plot(my$df[,1], my$df[,2])})
observeEvent(input$plot_brush,{
rowmin <- which(my$df[,1] == round(as.numeric(input$plot_brush$xmin)))
rowmax <- which(my$df[,1] == round(as.numeric(input$plot_brush$xmax)))
my$df[rowmin:rowmax,2] <- mean(my$df[,2]) # Update df
})
}