How to connect the output from shiny selectInput with a datatable - r

I am relatively new to R and currently, I am trying to build a simple Shiny app.
I believe that the input is good, however, my output does not seem to work properly.
My app should allow users to select the number of ingredients they want to use and the output should give all the names of the recipes with that specific number of ingredients.
How can I connect the input to the desired output?
ui <- fluidPage(
titlePanel("Foodify"),
#Input
selectInput("number_of_ingredients", "How many ingredients would you like to use?",
choices = c(dt.ingredients.and.directions.recipe$dt.number.of.ingredients), selected = 5, selectize = TRUE),
mainPanel(textOutput("ingredients")
))
server <- function(input, output){
ingredients.data <- reactive({as.data.frame(dt.ingredients.and.directions.recipe)})
recipes <- reactive(ingredients.data()[which(row.names(ingredients.data()) == input$number_of_ingredients),])
output$ingredients <- renderPrint({ingredients.data()$Recipe_name})
}
shinyApp(ui = ui, server = server)

I think you could simplify your app.
You had your recipe data as reactive - does it need to be? If you have your data already present in a data frame, you can filter that in either a separate reactive block or in your output.
Here is a brief example that simplifies things (filtering your data frame in the output). If your input changes (different number of recipes) the text output will automatically update.
Will this meet your needs?
dt.ingredients.and.directions.recipe <- data.frame(
dt.number.of.ingredients = c(1,2,3),
Recipe_name = c("First", "Second", "Third"),
stringsAsFactors = F
)
ui <- fluidPage(
titlePanel("Foodify"),
#Input
selectInput("number_of_ingredients", "How many ingredients would you like to use?",
choices = unique(dt.ingredients.and.directions.recipe$dt.number.of.ingredients),
selected = 1,
selectize = TRUE),
mainPanel(textOutput("ingredients")
)
)
server <- function(input, output){
output$ingredients <- renderPrint({
dt.ingredients.and.directions.recipe[dt.ingredients.and.directions.recipe$dt.number.of.ingredients == input$number_of_ingredients, "Recipe_name"]
})
}
shinyApp(ui = ui, server = server)
If you want to use a separate reactive block to filter you can also do the following:
server <- function(input, output){
recipes <- reactive({
dt.ingredients.and.directions.recipe[dt.ingredients.and.directions.recipe$dt.number.of.ingredients == input$number_of_ingredients,]
})
output$ingredients <- renderPrint({
recipes()$Recipe_name
})
}
Edit (3/1/20):
There is flexibility in how your recipe results can appear. Right now, this was using renderPrint which just captures any print output and converts it to a string.
There are a number of alternative ways to show your data. One way is to use renderTable instead (and in your ui replace with tableOutput instead of textOutput. Also would take a look at the DT package in shiny.
This will display the recipe results in a single column:
library(shiny)
dt.ingredients.and.directions.recipe <- data.frame(
dt.number.of.ingredients = c(7,2,7,8,6),
Recipe_name = c("Jam Toaster Tarts", "Oven-Dried Strawberries", "Fried Whole Fish", "Veggie Italian Hoagies", "Buttered Tomatoes with Ginger"),
stringsAsFactors = F
)
ui <- fluidPage(
titlePanel("Foodify"),
#Input
selectInput("number_of_ingredients", "How many ingredients would you like to use?",
choices = sort(unique(dt.ingredients.and.directions.recipe$dt.number.of.ingredients)),
selected = 1,
selectize = TRUE),
mainPanel(tableOutput("ingredients")
)
)
server <- function(input, output){
output$ingredients <- renderTable({
data.frame(Recipe = dt.ingredients.and.directions.recipe[dt.ingredients.and.directions.recipe$dt.number.of.ingredients == input$number_of_ingredients, "Recipe_name"])
})
}
shinyApp(ui = ui, server = server)

Related

Dataframe - R - Shiny

i have a question regarding Shiny and the usage of Data frames.
I think i understood that i need to create isolated or reactive environmentes to interact with, but if i try to work with the Dataframe i get an error message:
Error in pfData: konnte Funktion "pfData" nicht finden
i tried to manipulate the dataframe by this code:
server <- function(input, output) {
observeEvent(input$go,
{
pf_name <- reactive({input$pfID})
pf_date <- reactive({input$pfDate})
if (pf_name()!="please select a PF") {
pfData <- reactive(read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=","))
MDur <- pfData()[1,15]
pfData <- pfData()[3:nrow(pfData()),]
Total = sum(pfData()$Eco.Exp...Value.long)
}
})
}
If i manipulate my Dataframe in the console it works just fine:
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
can you help me?
Edit:
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
choices = list("please select a PF","GF25",
"FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
input$go
if (pf_name()!="please select a PF") {
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
MDur <- pfData[1,15]
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
output$selected_var <- renderText({paste(MDur)})
}
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Thank you
Stefan
Without a working example, it's imposible to be sure what you're trying to do, but it sounds like you need a reactive rather than using observeEvent.
Try something like
pfDataReactive <- reactive({
input$go
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
})
And then use pfDataReactive() in your Shiny app's server function wherever you would refer to pfData in your console code.
The standalone reference to input$go ensures the reactive will update whenever input$go changes/is clicked/etc.
Update
There are still significant issues with your code. You've added an assignment to an output object as the last line of the reactive I gave you, so the reactive always returns NULL. That's not helpful and is one of the reasons why it "doesn't active at all"...
Second, you test for the existence of an reactive/function called pf_name when the relevant input object appears to be input$pfID. That's another reason why the reactive is never updated.
Note the change to the definition of input$pfID that I've made to improve the readability of the pfDataReactive object. (This change also probably means that you can do away with input$go entirely.)
As you say, I don't have access to your csv file, so I can't test your code completely. I've modified the body of the pfDataReactive to simply return the mtcars dataset as a string. I've also edited the code I've commented out to hopefully run correctly when you use it with the real csv file.
This code appears to give the behaviour you want,. Though, if I may make a subjective comment, I think the layout of your GUI is appaling. ;=)
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
# Modified to that "Pleaseselect a PF" returns NULL
choices = list("please select a PF"="","GF25", "FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
# Don't do anything until we have a PF csv file
req(input$pfID)
input$go
# Note the change to the creation of the file name
# pfData <- read.csv(file =paste(input$pfID,".csv",sep=""),sep=";",dec=",")
# pfData <- pfData[3:nrow(pfData),]
# Total = sum(pfData$Eco.Exp...Value.long)
# Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
# pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
# MDur <- pfData[1,15]
# If you want to print MDur in the selected_var output, MDur should be the retrun value from this reactive
# MDur
mtcars
})
output$selected_var <- renderText({
print("Yep!")
as.character(pfDataReactive())
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Next time, please, please, make more effort to provide a MWE. This post may help.
This is a good introduction to Shiny.

Download a table created in Shiny

I need to give users a set of 60 observations. I have a master table that I want to to subset these 60 observations from. So, (1) I host the master table as a published csv file on google drive. (2) Write a shiny code to subset 60 values in R studio. The user will have to enter a group ID that I use as set.seed and ensure that the user sees the same subset every time he / she attempts to get the 60 observations. And, it also helps me keep track of the observations that the user has.
The code works fine and I am able to show the subset table. But, I am not able to get the download to work. I saw a post that says renderTable create an HTML table that cannot be downloaded and I should create the table outside it. I tried using reactive to do this, but it did not work and kept giving various errors. For example:
"cannot coerce class ‘c("reactiveExpr", "reactive", "function")’ to a data.frame"
Will appreciate any help of this - even if someone can please point out to what I should read and try to make this work.
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
output$table <- renderTable({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])})
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(output$table, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Create your table once, and then use it in your renderTable and downloadHandler. Create it as a reactive, so its available everywhere.
Note that downloadHandler doesn't work in RStudio's preview, view it in a browser instead. There is a button labelled 'Open in Browser' that will do this.
Here is your code with that applied:
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
#Create dataframe
mytable <- reactive({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])
})
#Display dataframe in table
output$table <- renderTable({
mytable()
})
#Download dataframe
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(mytable(), file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)

How to update DT datatable in Shiny when within a module and the selection criteria are changed

I try to make a shiny module to present data from dataframes using the DT package. I would like to use a module to have a standard set up of DT-table options like language and others.
I want the user to be able to select different subsets of the data interactively and thereafter be able to see the data as a DT-table. The selection of the subset will be generated outside the module because I would like the subset to be available for other uses, for example to be exported to a csv-file.
This works as intended when I don't use a module for making the DT table. When I put the code inside a module, a table is produced when the app starts. But when the selection criteria are changed, the table don't update.
I have included an app illustrating the problem. Table 1 is generated without using shiny module and updates as expected when the selection changes. Table 2 is output using the module and don't update when the selection is changed.
I'm running R-studio 1.1.463, R version 3.5.2 and DT version 0.5.
require("DT")
require("shiny")
# module for presenting data using DT
showDTdataUI <- function(id) {
ns <- NS(id)
tagList(
DT::dataTableOutput(ns("table"))
)
}
showDTdata <- function(input, output, session, DTdata) {
output$table <- renderDataTable({
DT::datatable(DTdata)
})
}
# User interface
ui <-
fluidPage(
sidebarLayout(
sidebarPanel(id="DT",
width = 4,
helpText(h4("Select")),
selectInput("selectedSpecies", label = "Species",
choices = c("setosa","versicolor","virginica"),
selected = "versicolor")
),
mainPanel(
h3("Table 1. Presenting selected data from Iris" ),
DT::dataTableOutput("table"),
h5(br("")),
h3("Table 2. Presenting selected data from Iris using shiny module"),
showDTdataUI(id="testDTModule")
)
)
)
# Define server logic ----
server <- function(session, input, output) {
selectedIris <- reactive ( {
selected <- iris[which(iris$Species==input$selectedSpecies),]
selected
})
output$table <- renderDataTable({
DT::datatable(selectedIris())
})
callModule(showDTdata, id="testDTModule", DTdata=selectedIris())
}
# Run the app ----
shinyApp(ui = ui, server = server)
You have to pass the reactive conductor in showDTdata:
showDTdata <- function(input, output, session, DTdata) {
output$table <- renderDataTable({
DT::datatable(DTdata()) # not datatable(DTdata)
})
}
callModule(showDTdata, id="testDTModule", DTdata=selectedIris) # not DTdata=selectedIris()
Does this do what you want? I removed your functions and added the selection ='multiple' to table 1 (tableX) so that we can then listen to tableX_rows_selected
P.S.: I have noticed that if you first load DT and then shiny, that the whole app won't work anymore. This is a bit weird since we call all datatable functions with DT::... but, you do get a warning message that some parts of DT are masked by shiny or viceversa.
require("shiny")
require('DT')
# User interface
ui <-
fluidPage(
sidebarLayout(
sidebarPanel(id="DT",
width = 4,
helpText(h4("Select")),
selectInput("selectedSpecies", label = "Species",
choices = c("setosa","versicolor","virginica"),
selected = "versicolor")
),
mainPanel(
h3("Table 1. Presenting selected data from Iris" ),
DT::dataTableOutput("tablex"),
br(),
h3("Table 2. Presenting selected data from Iris using shiny module"),
DT::dataTableOutput("table2")
)
)
)
# Define server logic ----
server <- function(session, input, output) {
values <- reactiveValues(rowselect = numeric())
selectedIris <- reactive ( {
selected <- iris[which(iris$Species==input$selectedSpecies),]
selected
})
output$tablex <- renderDataTable({
DT::datatable(selectedIris(), selection = 'multiple')
})
IrisSelected <- reactive({
df <- iris[c(input$tablex_rows_selected), ]
df
})
output$table2 <- renderDataTable({
req(nrow(IrisSelected()) > 0)
DT::datatable( IrisSelected())
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Without knowing of the shiny module approach, I would have probably written it like a normal function. The app below works but I am curious now after seeing the answer by #Stephane what the advantages are of using callModule approach over regular function approach
require("DT")
require("shiny")
makeTable <- function(dataframe) { DT::datatable(dataframe) %>%
formatStyle(names(dataframe), background = '#fff')
}
# User interface
ui <-
fluidPage(
sidebarLayout(
sidebarPanel(id="DT",
width = 4,
helpText(h4("Select")),
selectInput("selectedSpecies", label = "Species",
choices = c("setosa","versicolor","virginica"),
selected = "versicolor")
),
mainPanel(
dataTableOutput('Table1')
)
)
)
# Define server logic ----
server <- function(session, input, output) {
selectedIris <- reactive ( {
selected <- iris[which(iris$Species==input$selectedSpecies),]
selected
})
output$Table1 <- renderDataTable(makeTable(selectedIris()))
}
# Run the app ----
shinyApp(ui = ui, server = server)

Using quote() and substitute() for conditions within a shiny app

I'm trying to use quote/substitute as a method to apply a condition in shiny. I'm not very familiar with either quote/substitute or shiny - so it is definitely possible that I'm not going about this problem in the right way.
I've created a simple example below that I illustrates the problem I get.
#Create test dataframe
test<-data.frame(x=c(0:10), y=c(rep(1,5),rep(2,6)), z=c("A","A","A","B","B","B","C","C","C","C","C"))
#example of what I would like to do outside shiny app
test[test$x > 5,]
#or using quote and eval
test[eval(quote(test$x > 5)),]
All of the above code works. But now lets say I want to apply it within a shiny app (and allow the user to choose the condition):
#create simple shiny app
require(shiny)
# Server
server <- function(input, output) {
# subset of nodes
df <- reactive({
#eliminate certain observations
x <- test[eval(input$condition),]
})
output$table <- renderTable({
df <- df()
})
}
# UI
ui <- fluidPage(
radioButtons("conditon", "Condition", choices = c("cond_1" = substitute(test$x > 5), "cond_2" = substitute(test$x<5))),
tableOutput("table")
)
# Create app
shinyApp(ui = ui, server = server)
But this gives the error "All sub-lists in "choices" must be names"). I'm not sure how to interpret this, and so am stuck. I looked at the answers in Shiny - All sub-lists in "choices" must be named? but did not find them helpful.
Would appreciate a way to solve this, or suggestions of a better approach (though note that I can't create the subsets ahead of time, as for my more complex actual example this creates issues).
A quick fix could be to wrap with deparse and then use eval(parse. It is not entirely clear why the input needs to be expressions. If this is just for subsetting, there are easier ways to accomplish the same
library(shiny)
-ui
ui <- fluidPage(
radioButtons("conditon", "Condition",
choices = list(cond_1 = deparse(substitute(test$x > 5)),
cond_2 = deparse(substitute(test$x<5))),
selected = deparse(substitute(test$x > 5)) ),
tableOutput("table")
)
-server
server <- function(input, output) {
# subset of nodes
df <- reactive({
#eliminate certain observations
test[eval(parse(text=input$conditon)),, drop = FALSE]
})
output$table <- renderTable({
df()
})
}
-Create app
shinyApp(ui = ui, server = server)
-output

R shiny matrix or table input

I want to create a matrix or table as input for user to interact with in Shiny.
For example:
sample name number of tests
350292 3
... ...
I want to automatically generate tabs in the mainPanel for user to input data for the different samples.
This is possible with matrixInput in the shinyIncubator package, but the matrixInput function does not support column names.
Is there a better way to do this?
Update
I tried the rhandsontable package.
Code:
library(shiny)
library(rhandsontable)
DF <- data.frame(name=c(350292, 360765), run=c(3,2))
colnames(DF) <- c("sample name", "number of tests")
ui <- fluidPage(
headerPanel("test"),
mainPanel(rHandsontableOutput("sample"))
)
server <- function(input, output) {
output$sample <- renderRHandsontable({
rhandsontable(DF, rowHeaders = NULL) %>%
hot_col(c("sample name", "number of tests"), format = "0")
})
}
shinyApp(ui = ui, server = server)
How can I call values using the reactive() and rhandsontable?
I want to create tabs based on sample name and test number.

Resources