I am looking to build one interactive data visualisation.
My dataset contains 1244 obs and 9 variables
sharing a screenshot of data below:
Screenshot of sample Dataset
Flow of data visualisation:
Select the company name from an input box and it will give an output table (subset of that company from main dataset)
Select DIR of the above compary from an input box
After deleting the DIR, it will give an output of the company name (after checking the main dataset), if it is present.
Code which I have written is provided below, but it is not working. I will appreciate valuable input. Thanks in advance.
UI
navbarPage(
title = "SHELL COMPANY",
tabPanel("COMPANY INFO",
fluidRow(
column(4, selectInput("name","COMPANY NAME:", c("ALL", unique(as.character(cmp$`STD COMPANY NAME`))))),
column(4, DT::dataTableOutput("table")
))),
tabPanel("DIR INFO",
fluidRow(
column(4, selectInput("dir","DIRECTOR NAME:", sort(unique(as.character(cmp$`DIR NAME`)))))),
column(4, DT::dataTableOutput("table2"))
))
SERVER
function(input,output)
{
data <- cmp
rv <- reactiveValues()
observe({
rv$table <- cmp
if(input$name!="ALL"){
rv$table <- data[data$`STD COMPANY NAME`==input$name,]
}
})
output$table <- DT::renderDataTable(DT::datatable(
{
rv$table
}))
output$table2 <- DT::renderDataTable(DT::datatable(
{
data2 <- rv$table
data2 <- subset(rv$table, data$'DIR NAME'==input$dir, select=c(`STD COMPANY NAME`, `DIR NAME`))
data2
}))}
If the snippet that you provided is all you've got in the app concerning the error, it seems that you try to assign output$table to another variable inside output$table2 at data2 <- table. You can't assign output$... like that. Try creating separate table (?reactiveValues() might come in handy), and use it in both outputs, so the logic looks like this:
rv <- reactiveValues()
observe({
rv$table <- cmp
if(input$name!="ALL"){
rv$table <- data[data$`STD COMPANY NAME`==input$name,]
}
})
Then use it in both output$table and output$table2
Related
My goal is that user uploads an Excel file. Then, the user selects which sheets wants to be summarised, after the selection has been updated. I have managed to update selectInput with the name of the sheets but I have not been able to find\understand how to summarise based on what the sheet selected by the user. Thanks for any help.
library(shiny)
library(shinythemes)
library(data.table)
library(ggplot2)
library(dplyr)
library(readxl)
not_sel <- "Not Selected"
# Define UI for application that draws a histogram
ui <- fluidPage('MAIN TITLE',
theme = shinytheme('flatly'),
tabsetPanel(
sidebarLayout(
sidebarPanel(
fileInput('files','Import File', accept = c('.csv','.xlsx'),
multiple = F),
actionButton('boton1', 'Load', icon = icon('table')),
br(),
selectInput("indices", "Select SHEET:", choices = c(not_sel))
),
mainPanel(
tabsetPanel(
tabPanel('Data',
tableOutput('tabla'),
tableOutput('cabeza')),
tabPanel('Stats',
# selectInput('var01', 'Variable to summarise', choices = c(not_sel)),
tableOutput('stats')),
)
)
)
)
)
##############
server <- function(input, output, session) {
options(shiny.maxRequestSize=10*1024^2)
df <- eventReactive(input$boton1, {
req(input$files)
if(is.null(input$files))return(NULL)
# else{
read_excel(input$files$datapath)
# }
})
# Sheets of file uploaded
sheets_name <- reactive({
if (!is.null(input$files)) {
return(excel_sheets(path = input$files$datapath))
} else {
return(NULL)
}
})
# Update inputSelector with sheet names
observeEvent(df(),{
choices <- c(sheets_name())
updateSelectInput(inputId = "indices", choices = choices)
})
# DATA Tab
## This will show the name of the file
output$tabla <- renderTable({
input$files$name
})
## This Shows the head() but it is only showing the first sheet
output$cabeza <- renderTable({
tabla <- as_tibble(bind_cols(Date = format(as.Date(df()$Date),"%Y-%m-%d"),
Close.Price = df()$Close))
head(tabla)
})
# HERE is where I do not know how to calculate based on selection
# Table for STATS
output$stats <- renderTable({
datos <- df()
Value <- c(round(mean(datos$Close,na.rm = T),2)
)
Statistic <- c("Mean")
data.table(Statistic, Value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want to assume that by knowing how to calculate mean based on the sheet selected, I. can replicate the code for the top rows (head()) shown in the Data Panel.
If I missed a similar question asked, I would appreciate any link and I will try the solution proposed first.
As I cannot share the file, this is how the file would look:
After working with this answer I made my app work. If there is a 'cleaner'/'better' answer, I will be happy to read.
Following the recommendation in the linked answer my server ended up like this:
ui <-fluidPage{
#My UI stayed the same with the exception of adding
uiOutput("dropdownUI") #Whererever I needed to appear
}
server <- function(input, output, session) {
...ANSWER FROM THE LINK...
## STATS Tab
output$stats <- renderTable({
Values <- c(round(mean(Dat()[,2],na.rm = T),2)
)
Statistics <- c("Mean")
data.table(Statistics, Values)
})
}
I am new to shiny and trying to combine a couple features and having some trouble.
I want for the user to be able to select a CSV and then be presented with a random instance (in this case tweet) from that table. The following code worked when "tweetData" was a statically loaded csv using read_csv.
## function to return random row number from data set
getTweet <- function(){
tweetData[sample(nrow(tweetData), 1), ]
}
function(input, output, session) {
## set reactive values, get randomized tweet
appVals <- reactiveValues(
tweet = getTweet(),
ratings = data.frame(tweet = character(), screen_name = character(), rating = character())
)
I want to instead use a dynamically chosen csv for "tweetData", something like adding this??
csvName <- reactive(paste0('../folder_path/', input$file_name))
selectedData <- read.csv(csvName)
How can use reactively chosen csvs to fit into the structure of the first code chunk?
You might be looking for fileInput for giving user an option to upload a dataset.
This is a simple reproducible example -
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File"),
),
mainPanel(
tableOutput("contents")
)
)
)
server <- function(input, output) {
output$contents <- renderTable({
req(input$file1)
read.csv(input$file1$datapath)
})
}
shinyApp(ui, server)
I would like to use a Shiny app to load a file (tab-separated), dynamically create a checkboxGroupInput, after the loading of the file (using observeEvent) using the column headers, then subset the data frame that comes from the file based on the selected checkboxes. The data is then plotted using code I can't share right now.
All is working fine, apart from the last bit: subsetting the dataframe based on the selected checkboxes in checkboxGroupInput. The checkboxes all start selected, and the plot is created fine. If you un-select one of the checkboxes, the plot re-plots appropriately for a split second (so the subsetting is working fine) then the unselected checkbox re-selects itself and the plot goes back to the old plot.
This is the tiny problem I'm trying to solve, guessing it's one line of code. I'm assuming it's because of some reactivity that I don't understand and the checkbox constantly resetting itself.
Here is an example:
###
## Some functions I can't share
### Shiny app
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MagicPlotter"),
# Sidebar
sidebarLayout(
sidebarPanel(
fileInput(inputId = "myInputID",
label = "Your .csv file",
placeholder = "File not uploaded"),
uiOutput("mylist"),
uiOutput("submitbutton")
),
# Show a plot
mainPanel(
verticalLayout(
plotOutput("myPlot"))
)
)
)
# Define server
server <- function(input, output) {
output$myPlot <- renderPlot({
inputfile <- input$myInputID
if(is.null(inputfile))
{return()}
mydataframe <- read.table(file=inputfile$datapath, sep="\t", head=T, row.names = 1)
mydataframecolumnnames <- colnames(mydataframe[1:(length(mydataframe)-1)])
# the last column is dropped because it's not relevant as a column name
observeEvent(input$myInputID, {
output$mylist <- renderUI({
checkboxGroupInput(inputId="mylist",
label="List of things to select",
choices=mydataframecolumnnames,
selected=mydataframecolumnnames)
})
})
observeEvent(input$myInputID, {
output$submitbutton <- renderUI({
submitButton("Subset")
})
})
mysubset <- mydataframe[input$mylist]
myPlot(mysubset)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks all
I think there are a few things that might help...
One, you can move your observeEvent methods outside of your renderPlot.
Also, you can create a reactive function to read in the data table.
I hope this helps.
server <- function(input, output) {
myDataFrame <- reactive({
inputfile <- input$myInputID
if(is.null(inputfile))
{return()}
read.table(file=inputfile$datapath, sep="\t", head=T, row.names = 1)
})
output$myPlot <- renderPlot({
req(input$mylist)
mysubset <- myDataFrame()[input$mylist]
plot(mysubset)
})
observeEvent(input$myInputID, {
mydata <- myDataFrame()
mydataframecolumnnames <- colnames(mydata[1:(length(mydata)-1)])
output$mylist <- renderUI({
checkboxGroupInput(inputId="mylist",
label="List of things to select",
choices=mydataframecolumnnames,
selected=mydataframecolumnnames)
})
})
observeEvent(input$myInputID, {
output$submitbutton <- renderUI({
submitButton("Subset")
})
})
}
Instead of specifying separate fileInput variables, I'd like to use reactiveValues to store uploaded CSV dataframes, manipulate them in some way, and then store them for accession later. My design is to name each dataframe by its filename and append to the reactiveValue rvTL. My questions are,
How can I access individual dataframes under the list I created using reactiveValuesToList(rvTL)?
Next step, how to create a selectInput menu to access the individual dataframes uploaded by fileInput
To learn this concept, I am piggybacking off the answer from Dean Attali and made rvTL the same as his values variable.
R shiny: How to get an reactive data frame updated each time pressing an actionButton without creating a new reactive data frame?
I've gone over many example codes on reactiveValues, yet still at an incomplete understanding. Most examples are using some sort variation on reactiveValuesToList(input) R Shiny: Keep/retain values of reactive inputs after modifying selection, I'm really not seeing the logic here. Any help/suggestions would be appreciated!
library(shiny)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("amend data frame"),
mainPanel(
fileInput("file", "Upload file", multiple=T),
tabsetPanel(type="tabs",
tabPanel("tab1",
numericInput("Delete", "Delete row:", 1, step = 1),
actionButton("Go", "Delete!"),
verbatimTextOutput("df_data_files"),
verbatimTextOutput("values"),
verbatimTextOutput("rvTL"),
tableOutput("rvTL_out")
),
tabPanel("tab2",
tableOutput("df_data_out")
)
)))),
server = (function(input, output) {
values <- reactiveValues(df_data = NULL) ##reactiveValues
rvTL <- reactiveValues(rvTL = NULL)
observeEvent(input$file, {
values$df_data <- read.csv(input$file$datapath)
rvTL[[input$file$name]] <- c(isolate(rvTL), read.csv(input$file$datapath))
})
observeEvent(input$Go, {
temp <- values$df_data[-input$Delete, ]
values$df_data <- temp
})
output$df_data_files <- renderPrint(input$file$name)
output$values <- renderPrint(names(values))
output$rvTL <- renderPrint(names(reactiveValuesToList(rvTL))[1] )
output$rvTL_out <- renderTable(reactiveValuesToList(rvTL)[[1]])
output$df_data_out <- renderTable(values$df_data)
})
))
It really is as straightforward as you thought. You were close too, just fell into some syntax traps. I made the following changes:
that c(isolate(.. call was messing things up, I got rid of it. It was leading to those "Warning: Error in as.data.frame.default: cannot coerce class "c("ReactiveValues", "R6")" to a data.frame" errors.
Also you were reusing the rvTL name too often which is confusing and can lead to conflicts, so I renamed a couple of them.
I also added a loaded file name list (lfnamelist) to keep track of what was loaded. I could have used names(rvTL$dflist) for this but it didn't occur to me at the time - and I also this is a useful example of how to organize related reactive values into one declaration.
And then I added rendered selectInput so you can inspect what is saved in the reactiveValue list.
So here is the adjusted code:
library(shiny)
runApp(shinyApp(
ui=(fluidPage(
titlePanel("amend data frame"),
mainPanel(
fileInput("file", "Upload file", multiple=T),
tabsetPanel(type="tabs",
tabPanel("rvTL tab",
numericInput("Delete", "Delete row:", 1, step = 1),
uiOutput("filesloaded"),
actionButton("Go", "Delete!"),
verbatimTextOutput("df_data_files"),
verbatimTextOutput("values"),
verbatimTextOutput("rvTL_names"),
tableOutput("rvTL_out")
),
tabPanel("values tab",
tableOutput("df_data_out")
)
)))),
server = (function(input, output) {
values <- reactiveValues(df_data = NULL) ##reactiveValues
rvTL <- reactiveValues(dflist=NULL,lfnamelist=NULL)
observeEvent(input$file, {
req(input$file)
values$df_data <- read.csv(input$file$datapath)
rvTL$dflist[[input$file$name]] <-read.csv(input$file$datapath)
rvTL$lfnamelist <- c( rvTL$lfnamelist, input$file$name )
})
observeEvent(input$Go, {
temp <- values$df_data[-input$Delete, ]
values$df_data <- temp
})
output$df_data_files <- renderPrint(input$file$name)
output$values <- renderPrint(names(values))
output$rvTL_names <- renderPrint(names(rvTL$dflist))
output$rvTL_out <- renderTable(rvTL$dflist[[input$lftoshow]])
output$df_data_out <- renderTable(values$df_data)
output$filesloaded <- renderUI(selectInput("lftoshow","File to show",choices=rvTL$lfnamelist))
})
))
And here is a screen shot:
I'm very new to shiny and am having some trouble and have been searching all day, so hopefully someone can help me. Once an action button (actionButton, on UI) is selected by a user, I would like the server script to call a function (evenReactive in server) I wrote (myfunction, see below) that uses the input items from the UI and gets the right parameters I need to run myfunction and produce a n X2 data matrix that will be plotted as a table (renderTable in server, below). The data is a n X 2 matrix.
I have some sample code below. It's not the entre code, so you will not see the UI with the inputs I am putting in my function, or the server parts associated. But, it is the part I am trying to fix. I hope that's ok. I don't need the renderText, but when I take it out I get an error. Sorry for the formatting. Copy and pasting changed it a bit.
library(shiny)
ui <- shinyUI(fluidPage
(column(4,actionButton("gobutton", "Run"),verbatimTextOutput("ntext1")),
column(4, DT::dataTableOutput("table",width = "75%"))))
library(shiny)
shinyServer(function(input, output, session)
ntext1 <- eventReactive(input$gobutton, {
if (input$gobutton==1){
data=myfunction(input$checkbox,input$dateRange)}
})
output$ntext1 <- renderText({ntext1()})
output$table <- DT::renderDataTable(DT::datatable({
data
})
))
myfunction <-function(All,date1,date2,source_cd,tran_cd,airline_list,mag_level) {
print(All); print(date1); print(date2); print(source_cd);print(tran_cd);print(airline_list);print(mag_level)
setwd("C:/Users/TRomano/Documents/Projects/TrendAnalysis/Data")
data = read.csv("Airlines.csv",header = TRUE)
return(data)
}
For this type of problem I like to make use of reactiveValues()that are designed to store data in a reactive way.
Here is a simple app (single app, not split into server & ui) that demonstrates what I think you are trying to do
library(shiny)
library(DT)
ui <- shinyUI(
fluidPage(
column(width = 4,
actionButton("gobutton", "Run")
column(width = 4,
DT::dataTableOutput("table",
width = "75%"))))
server <- shinyServer(function(input, output, session){
rv <- reactiveValues()
rv$data <- NULL
observe({ ## will 'observe' the button press
if(input$gobutton){
print("here") ## for debugging
rv$data <- myfunction() ## store the data in the reactive value
rv$data
}
})
output$table <- DT::renderDataTable({
## The data has been stored in our rv, so can just return it here
rv$data
})
})
myfunction <- function(){
data <- data.frame(id = c(1,2,3),
val = letters[1:3])
return(data)
}
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Company Name"),
dashboardSidebar(sidebarMenu(
menuItem("Results Table", tabName = "ResultsTable", icon = icon
("ResultsTable")),
dashboardBody(
tabItems(
tabItem(tabName tabItem(tabName = "ResultsTable",
fluidPage(
headerPanel(
fluidRow(
column(4,
selectInput("sour",
"Source Type:",
c("All",
unique(as.character(data_source_cd)))), offset=2
),
column(4,
selectInput("tran",
"Transaction Type:",
c("All",
unique(as.character(tran_cd)))))),
# Create a new row for the table.
fluidRow(column(8, DT::dataTableOutput("table",width = "75%"),offset = 2))))))
library(shiny)
shinyServer(function(input, output, session) {
ntext1 <- eventReactive(input$gobutton, {
if (input$dateRange[2]<input$dateRange[1]){print("You selected the date range option;however, the end date entered occurs before the starting date")}else{
output$ntext1 <- renderText({print("Analysis complete...")});
observe({
if(input$gobutton){
rv$data <- myfunction() }
})
output$table <- DT::renderDataTable(DT::datatable({
data <- rv$data
if (input$sour != "All") {
data <- data[data[,5] == input$sour,]
}else{data}
if (input$tran != "All") {
data <-data[data[,6] == input$tran,]
}else{data}
}))
}})
Once an action button is selected on the main page of my dashboard(not shown), myfunction runs analysis with the inputs from the main dashboard page. On another tab, a table will show once the analysis is complete. There are drop down menus (input$tran, input$sour) that will reduce what is in the table depending on what the user selects. If there are any errors in the input, a warning of text comes up on the main dashboard page and the tab with the table will not be created until the correct inputs are selected.
The observe function allowed me to run my function and the output data of the function set to a variable I could later use to create the table (shown).
THis is my first time posting. Any questions feel free to ask.