I would like to download the modified version of the table when I use the filter option in the table. Since the table is reactive based on the columns, only the chosen columns will be included in the downloaded dataset, however, every row is also included.
So for example, I choose 4 different columns and filter the dataset based on the columns and get only 2 rows. Is there a way to download this specific version of the table after the filter, instead of downloading the whole dataset?
library(shiny)
library(DT)
ui <- fluidPage(
title = "DataTables",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.dataset == "cars"',
selectInput('col', ' ',choices = names(cars),multiple = TRUE,selected = c("price", "Mileage", "Cylinder")),
downloadButton("download_cars", "Download data")
)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("cars",
DT::dataTableOutput("mytable1"),
)
)
)
))
server <- function(input, output) {
car_data <- eventReactive(input$col, {
df <- cars[, input$col, drop = FALSE]
df
})
output$mytable1 <- DT::renderDataTable({
DT::datatable(car_data(), filter = "top", options = list(
orderClasses = TRUE
)
)
})
output$download_car <- downloadHandler(
filename = function() {paste("All_cars.csv", Sys.Date(), ".csv", sep = "")},
content = function(file){
write.csv(car_data(), file, row.names = FALSE)
}
)
}
shinyApp(ui, server)
Related
I'm trying to implement a shiny app that contains some optional checkboxes. I would like to know how do I perform an analysis with a certain selection only if it is selected and, with that, the table with the analysis made from the selection also appears on the screen.
I would like the objects inside the rbind function (below) to be included only if they are selected in the checkboxes:
ameacadas <- rbind(ameacadas_BR,ameacadas_BR2, ameacadas_pa)
External files can be found at: https://github.com/igorcobelo/data_examples (The 'minati.csv' file is the input data).
My code is presented below:
# global
library(shiny)
library(tidyverse)
# ui
ui <- navbarPage(title = "Minati Flora.",
tabPanel(title = "Home",
br(),
hr(),
# Upload csv file
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "csvFile",
label = "Upload",
accept = c(".csv")
),
checkboxInput('BR1','Federal1'),
checkboxInput('BR2','Federal2'),
checkboxInput('PA','Pará'),
downloadButton("download", "Download")
),
mainPanel(
tableOutput("modifiedData")
)
)
),
tabPanel(title = "About"),
inverse = T)
# server
server <- function(input, output) {
rawData <- eventReactive(input$csvFile, {
req(input$csvFile)
df <- read.csv(input$csvFile$datapath,sep=';',check.names = F,fileEncoding = "Latin1")
#read extern files
ameacadas_BR <- read.csv("ameacadas_BR.csv",sep=';',check.names = F,fileEncoding = "Latin1")
legis_BR <- "Portaria MMA N. 148/2022"
ameacadas_BR2 <- read.csv("ameacadas_BR2.csv",sep=';',check.names = F,fileEncoding = "Latin1")
legis_BR2 <- "Decreto Federal N. 5.975/2006"
ameacadas_pa <- read.csv("ameacadas_PA.csv",sep=';',check.names = F,fileEncoding = "Latin1")
legis_pa <- "Resolucao COEMA/PA N. 54/2007"
#Rbind all files selected
ameacadas <- rbind(ameacadas_BR,ameacadas_BR2, ameacadas_pa)
#General calculate
colnames(df)[1] <- "Especie" #coluna especies
ameacadas <- ameacadas %>%
group_by(Especie) %>%
mutate(Categoria_Ameaca = toString(Categoria_Ameaca),
Legislacao = toString(Legislacao))
ameacadas <- ameacadas[!duplicated(ameacadas[,1]),]
arv_com_ameacadas <- df %>% left_join(ameacadas, by = "Especie")
})
output$modifiedData <- renderTable({rawData() })
output$download <- downloadHandler(
filename = function() {paste("Minati_Flora_", Sys.Date(), ".csv", sep = "")},
content = function(file){
write.csv(rawData(), file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
I want to upload two csv files and print both tables out.
Here is the code I wrote:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(inputId = "files", label = "Choose CSV File", multiple = TRUE,accept = c(".csv")
)
),
mainPanel(
fluidRow(tableOutput("Policy1")),
fluidRow(tableOutput("Policy2")),
)
)
)
server <- function(input, output) {
data <- reactiveValues(file1 = NULL,
file2 = NULL)
output$Policy1 <- renderTable({
if(!is.null(input$files$datapath[1]))
data$file1 <- read.csv(input$files$datapath[1], header = TRUE)
data$file1
})
output$Policy2 <- renderTable({
if(is.null(input$files$datapath[2])) {return(1)}
else{return(NULL)}
})
}
shinyApp(ui, server)
and for the output$Policy2 part, I want to test when the is.null(input$files$datapath[2]) is true. I thought it should be true when I only upload one file or don't upload anything but
if I only upload one csv file, it didn't print out the table 1, which means is.null(input$files$datapath[2]) is false in this case.I don't know why this is the case.
And as a result, if I change the code to ask shiny print two tables for me and only upload one file, there will be an error, here is the code:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(inputId = "files", label = "Choose CSV File", multiple = TRUE,accept = c(".csv")
)
),
mainPanel(
fluidRow(tableOutput("Policy1")),
fluidRow(tableOutput("Policy2")),
)
)
)
server <- function(input, output) {
data <- reactiveValues(file1 = NULL,
file2 = NULL)
output$Policy1 <- renderTable({
if(!is.null(input$files$datapath[1]))
data$file1 <- read.csv(input$files$datapath[1], header = TRUE)
data$file1
})
output$Policy2 <- renderTable({
if(!is.null(input$files$datapath[2]))
data$file2 <- read.csv(input$files$datapath[2], header = TRUE)
data$file2
})
}
shinyApp(ui, server)
where I only change a little part and here is the error :
which I assume is because I should return NULL when only one file inputed in, how can I fix this problem, thanks for any help
The value won't be NULL if it's missing. It's better to check that there are enough values checking the length of the vector or something. For example
output$Policy2 <- renderTable({
if(!is.null(input$files) && length(input$files$datapath)>=2)
data$file2 <- read.csv(input$files$datapath[2], header = TRUE)
data$file2
})
Here is my shiny app. Now I cant be able o share data for running it but basically this app has multiple csvs saved in ./data folder. What I am trying to do is compare each csv in two pairs of each. Now when I select CSV files from the dropdown menu and compare I have some result table with column names messed up and that means I am supposed to delete the column names and replace them with the first row of the data, Then I still have other results that I get after comparing other files and I get right column names that I don't have to replace.
library("shiny")
library(daff)
library(dplyr)
library(shinythemes)
library("DT")
library(readr)
library(stringr)
library(tidyr)
library(purrr)
library(janitor)
library(data.table)
library(magrittr)
library(plyr)
setwd("path")
ui = fluidPage(
titlePanel("Automated Data Dictionary Comparison"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'Dic1',
label = 'Choose First Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
selectInput(inputId = 'Dic2',
label = 'Choose Second Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
actionButton("do", "Replace columns"),
tags$hr(),
# This one is linked by the id 'download'
downloadButton('download',"Download the data")
),
mainPanel (
tabsetPanel(
tabPanel('Html Table',
HTML("<div style ='overflow:auto; height:500px; width:800px ' >"),
uiOutput('contents'),
HTML("</div>")
),
tabPanel('Diff Table',
fluidRow(
column(div(DT::dataTableOutput("mytable"), style = "font-size: 75%; width: 75%"),width = 12)
)
),
tabPanel("Modified table",
fluidRow(
column(div(DT::dataTableOutput("modified"), style = "font-size: 75%; width: 75%"),width = 12)
)
),
tabPanel("Added table",
fluidRow(
column(div(DT::dataTableOutput("added"), style = "font-size: 75%; width: 75%"),width = 12)
)
)
)
)
)
)
server = function(input, output){
# Parse first file
dataset1 <- reactive({
infile <- input$Dic1
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Parse second file
dataset2 <- reactive({
infile <- input$Dic2
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Create difference table then save
diff1 <- reactive( {
dd <- diff_data(data_ref=dataset1(), data=dataset2())
write_diff(dd, "./data/diffrev.csv")
diff_df <- readr::read_csv("./data/diffrev.csv")
ft <-as.data.frame(lapply(diff_df, iconv, from = 'UTF-8', to = 'UTF-8'), stringsAsFactors = FALSE)
ft
})
output$mytable <- renderDataTable({
diff1()
},options = list(scrollX = TRUE))
output$download <- downloadHandler(
filename = function(){"thename.csv"},
content = function(fname){
write.csv(thedata(), fname)})
}
shinyApp(ui = ui, server = server)
My first question is how can I smartly delete and replace column names with the first row once I display the diff1 table output? I am thinking of using an action button which I can be able to delete those tables with unwanted columns but it will still delete wanted columns from the output.
What I expect is once I see unwanted columns in the output , I can replace them but once I see wanted columns in the output, I should choose to keep them
I need to render a table based on user input which will be one of two possible tables. I have defined the first table filedata by the user selecting a .csv file to upload. The second table, data_ranked_words, has the same dimensions.
What I want is for the output to switch between the two tables. I defined each table in a reactive(). However, I know that the data_ranked_words reactive is never being triggered. How do I trigger both of these reactives when the user uploads a file? In my code the issue is with the two reactive() statements at the beginning of server.R.
library(shiny)
library(markdown)
library(DT)
library(D3TableFilter)
options(shiny.maxRequestSize=50*1024^2)
setwd('~/Desktop/DSI/Topic Model App Interface')
# ui.R
#-------------------------------------------------------------------------------------
ui <- shinyUI(
navbarPage("Start",
tabPanel("From Data",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
tabPanel("From CSV",
sidebarLayout(
sidebarPanel(
# Define what's in the sidebar
fileInput("file",
"Choose CSV files from directory",
multiple = TRUE,
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
h5(div(HTML('Use the radio butons to toggle between the <em>Word View</em> and
<em>Probability View</em>.'))),
radioButtons('toggle', 'Choose one:', list('Word View', 'Probability View')),
p(div(HTML('<strong>Note:</strong> The <em>Probability View</em> will
<u>not</u> yield the top X number of words. It will instead
return the first X columns. You can then sort each column in
ascending or descending order. Keep in mind that it will only
sort from the rows that are displayed, <u>not</u> all rows.'))),
br(),
sliderInput('slider', div(HTML('How many rows to display?')), 1, 100, 20),
br(),
h5('Use the buttons below to quickly show large numbers of rows.'),
radioButtons('rowIdentifier', 'Show more rows:',
list('[ Clear ]', '200', '500', '1000', '5000', '10000', 'All Rows')),
p(div(HTML('<strong>Warning:</strong> Printing all rows to the screen may
take a while.'))),
h3('Tips:'),
p("You can copy and paste the table into Excel. If you only want to
copy one column, use the 'Show/Hide' function at the top-right of the table
to hide all the undesired columns."),
p(div(HTML('Sorting by column is available in <em>Probability View</em> but
not <em>Word View</em>.')))
),
# Define what's in the main panel
mainPanel(
title = 'Topic Model Viewer',
# How wide the main table will be
fluidRow(
column(width = 12, d3tfOutput('data'))
)
)
)
),
navbarMenu("More",
tabPanel("temp"
),
tabPanel("About",
fluidRow(
column(6
),
column(3
)
)
)
)
)
)
# server.R
#-------------------------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
# Set up the dataframe for display in the table
# Define 'filedata' as the .csv file that is uploaded
filedata <- reactive({
infile <- input$file
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
temp = read.csv(infile$datapath)
# Save data as RDS file, which is much faster than csv
saveRDS(temp, file = 'data.rds')
# Read in data file
data = readRDS('data.rds')
# Transpose data for more intuitive viewing. Words as rows, topics as cols
data = t(data)
# Convert to data frame
data = as.data.frame(data)
# Return this
data
})
# The ranked and ordered csv file
data_ranked_words <- reactive({
data = filedata()
# Sort each column by probability, and substitute the correct word into that column
# This will essentially rank each word for each topic
# This is done by indexing the row names by the order of each column
temp = matrix(row.names(data)[apply(-data, 2, order)], nrow(data))
temp = as.data.frame(temp)
# Define column names (same as before) for the new data frame
colnames(temp) = paste0(rep('topic', ncol(data)), 1:ncol(data))
# Return this
temp
print('Success')
})
output$data <- renderD3tf({
# Define table properties. See http://tablefilter.free.fr/doc.php
# for a complete reference
tableProps <- list(
rows_counter = TRUE,
rows_counter_text = "Rows: ",
alternate_rows = TRUE
);
# Radio buttons
# The reason why the extensions are in this if() is so that sorting can be
# activated on Probability View, but not Word View
if(input$toggle=='Word View'){
df = data_ranked_words
extensions <- list(
list( name = "colsVisibility",
text = 'Hide columns: ',
enable_tick_all = TRUE
),
list( name = "filtersVisibility",
visible_at_start = FALSE)
)
} else if(input$toggle=='Probability View'){
df = filedata()
extensions <- list(
list(name = "sort"), #this enables/disables sorting
list( name = "colsVisibility",
text = 'Hide columns: ',
enable_tick_all = TRUE
),
list( name = "filtersVisibility",
visible_at_start = FALSE)
)
}
# Radio button options for more row viewing options
if(input$rowIdentifier=='Clear'){
num_rows = input$slider
} else if(input$rowIdentifier==200){
num_rows = 200
} else if(input$rowIdentifier==500){
num_rows = 500
} else if(input$rowIdentifier==1000){
num_rows = 1000
} else if(input$rowIdentifier==5000){
num_rows = 5000
} else if(input$rowIdentifier==10000){
num_rows = 10000
} else if(input$rowIdentifier=='All Rows'){
num_rows = nrow(df)
} else{
num_rows = input$slider
}
# Create table
if(is.null(filedata())){
} else{
d3tf(df,
tableProps = tableProps,
extensions = extensions,
showRowNames = TRUE,
tableStyle = "table table-bordered")
}
})
# This line will end the R session when the Shiny app is closed
session$onSessionEnded(stopApp)
})
# Run app in browser
runApp(list(ui=ui,server=server), launch.browser = TRUE)
I'm building a simple shiny app which will take inputs from the user and fetch data from a table in the DB and take the number of records to be downloaded as an input and provide a download file option.
Everything below works just fine. My only concern is the textInput bar( variable : uiOutput("text") in the ui and output$text in the server) appears only after the datatableOutput is displayed. I do not understand why this happens.
Ideally, I want the textInput bar ('uiOutput("text")') object to be displayed once the leaf(i.e. input$leaf1 is not null) is selected and then I want the datatableOutput to be displayed and then the Download Button should come up.
Is there a way I can achieve this? Thanks
library(shiny)
library(shinydashboard)
#library(stringr)
library(DT)
#library(shinyBS)
ui <- dashboardPage(
dashboardHeader(title = strong("DASHBOARD"),titleWidth = 240),
dashboardSidebar(
sidebarMenu(
selectizeInput("x", "Choose a number:", choices = sort(unique(lftable$x)), multiple = TRUE),
uiOutput("leaf_categ")
)
),
dashboardBody(
fluidRow(
uiOutput("text"),
dataTableOutput("lm_df"),
downloadButton('downloadData', 'Download')
)))
server <- function(input, output){
output$leaf_categ <- renderUI(
selectizeInput("leaf1", "Choose leaf categories:",
choices = reactive(unique(lftable[lftable$num %in% input$x, c("X_NAME")]))(),
multiple = TRUE)
)
#### creates a text input box
#### number of records to be downloaded is provided as input
output$text <- renderUI({
if(is.null(reactive(input$leaf1)())){
return()
}else{
textInput("var1", label = "Enter the number of records to be downloaded", value = "")
}
})
#### fetches data from DB
lm <- reactive({
if(is.null(input$leaf1)){
return()
}else{
leaf_id <- unique(lftable[lftable$X_NAME %in% input$leaf1, c("leaf_id")])
query_str <- paste('select * from table1 where current_date between start_dt and end_dt and score_num >= 0.1 and x in (' , input$x, ')', ' and X_ID in (', leaf_id, ')', ';', sep = "")
}
lm_data <- getDataFrmDW(query_str)
})
###creates a download tab
output$downloadData <- downloadHandler(
filename = function() { paste("lm_user_data", '.csv', sep='') },
content = function(file) {
lm_df <- lm()
lm_df <- lm_df[1:(as.integer(input$text)),]
print(dim(lm_df))
write.csv(lm_df, file, row.names = F)
})
output$lm_df <- DT::renderDataTable(lm())
}
shinyApp(ui, server)