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.
Related
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)
I am working on a shiny app where users can upload their own data and get some plots and statistics back. However, I also want to include an example dataset that gets used instead if the user presses a specific button. Importantly, the plots should be reactive so that users get updated plots whenever they click on the "use example data instead" button or upload a new file. I tried to recreate my current approach of overwriting the data object as best as I could here, but simply defining the data object twice doesn't overwrite the data in the way I hoped it would. Any suggestions are appreciated.
library(shiny)
# UI
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput("Upload", "Upload your own Data"),
actionButton("Example", "Use Example Data instead")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("hist")
)
)
)
# Server Logic
server <- function(input, output) {
data <- eventReactive(input$Upload,{input$Upload})
data <- eventReactive(input$Example, {faithful$eruptions})
output$hist <- renderPlot({hist(data())})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use a reactiveVal like this:
server <- function(input, output) {
my_data <- reactiveVal()
observeEvent(input$Upload, {
tmp <- read.csv(input$Upload$datapath)
## do whatever is needed to parse the data
my_data(tmp)
})
observeEvent(input$Example, {
my_data(faithful)
})
output$hist <- renderPlot({
dat <- as.data.frame(req(my_data()))
dat <- dat[, sapply(dat, is.numeric), drop = FALSE]
validate(need(NCOL(dat) > 1, "No numeric columns found in provided data"))
hist(dat[,1])
})
}
Depending on upload or button click, you store your data in my_data which is a reactive value. Whenever this value changes, the renderPlot function fires and uses the correct data.
You can use a reactive value to access whether the user has chosen to use an example dataset or use their own dataset. The user can choose to switch between the active dataset using an input from your UI.
Here's the official explanation on reactive values from RStudio: link
This would go in your ui.R:
radioButtons("sample_or_real",
label = h4("User data or sample data?"),
choices = list(
"Sample Data" = "sample",
"Upload from user data" = "user",
),
selected = "user"
)
This would go in your server.R:
data_active <- reactive({
# if user switches to internal data, switch in-app data
observeEvent(input$sample_or_real_button, {
if(input$sample_or_real == "sample"){
data_internal <- sample_data_object
} else {
data_internal <- uploaded_data_object
}
})
Note, that when using a reactive value in your server.R file, it must have parentheses () at the end of the object name. So, you call the data_internal object as data_internal().
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)
I am trying to create a shiny app that has a rhandsontable in it. I want rhandsontable to be able to update its values in one of its columns if the corresponding values in another column is selected/ checked. So far, I have been able to use reactive / observe events to change the output values between two objects but i am unable to wrap my head around it , i.e, how do i make once column of rhandsontable reactive to another column in the same table ?
Here is a simple example of what i am trying to build:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
rHandsontableOutput('table')
)
server <- function(input,output,session)({
data <- data.frame(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0), select= as.logical( c(FALSE,FALSE,FALSE)))
output$table <- renderRHandsontable({
rhandsontable(data)
})
})
shinyApp(ui = ui, server = server)
So if i check the column 'Select', column 'diff' should produce the difference between column c1 & c2
From what I understand, your goal is to do some calculation depending on the values of some other column. So if for example a box of the third column is checked, you might want to compute the difference between elements of column 1 and 2.
If you had just a data frame, that would be easy, wouldn't it? Well, this is possible using reactive values. The main idea is that you can store the rhandsontable in a data frame in the backend, modify the data frame and then render the modified data frame once again back in the handsontable.
I hope this helps:
For a more detailed example on reactive values you can see
this: http://stla.github.io/stlapblog/posts/shiny_editTable.html
and this : https://www.youtube.com/watch?v=BzE1JmC0F6Q&list=PL6wLL_RojB5wXR3NR3K38sIvexZ_45alY&index=3
library(rhandsontable)
library(shiny)
ui <- fluidPage(
mainPanel(
rHandsontableOutput("hot")
)
)
server = function(input, output, session){
df<- data.frame(c1=c(5,10,15), c2=c(3,6,9) , diff=c(0,0,0), select= as.logical( c(FALSE,FALSE,FALSE)))
values <- reactiveValues(data = df)
observe({
if(!is.null(input$hot)){
values$data <- as.data.frame(hot_to_r(input$hot))
isolate(values$data[,'diff'] <- ifelse(values$data[,'select'], values$data[,'c1']-values$data[,'c2'] ,0))
print(values$data)
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
})
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
shinyApp(ui, server)
Consider the following R Shiny code that outputs a table of values:
library(shiny)
# Define UI ----
ui <- fluidPage(
fluidRow(column(12, numericInput("someVar1", "Var1", value = 30000)),
column(12, numericInput("someVar2", "Var2", value = 584000)),
tableOutput("myDataTable")
)
)
# Define server logic ----
server <- function(input, output) {
myDataTable <- reactive({
myDataTable <- data.frame("Var1" = formatC(c(input$someVar1, input$someVar2), format = "d", big.mark = ","))
return(myDataTable)
})
output$myDataTable <- renderTable(myDataTable())
}
# Run the app ----
shinyApp(ui = ui, server = server)
There appear to be a number of ways of formatting the data in the output table to achieve comma-separated values with or without decimal places using functions such as 'formatC', 'format', 'prettyNum', etc.
However, all of these appear to left-justify the results (after much experimentation). How can I format the numeric data in (all of) the columns of a data frame that is output to an R Shiny app with specific formatting but still maintain right-justification?
For example, instead of:
1,000.5
34,000.00
...I wish to have:
1,000
34,000
There is "align" option in the renderTable() function you are using. Please see Rshiny documentation: https://shiny.rstudio.com/reference/shiny/1.0.5/renderTable.html
output$myDataTable <- renderTable(myDataTable(), align="r")