How can I resize the HTML table to fit the screen of the computer? This is how my shiny app looks currently, I have tried using fluid row columns but it not giving me the right result. I guess I am missing something here.
Here is my shiny server and ui
UI.R
library("shiny")
library(daff)
library(dplyr)
library(shinythemes)
setwd("PATH")
ui <- fluidPage(theme = shinytheme("cerulean"),
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))
),
mainPanel(
uiOutput('contents'))
)
)
)
Html table is in the output section.
SERVER.R
library(shiny)
library(dplyr)
library(daff)
library(shinythemes)
setwd("PATH")
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 comparison table (reactive as both of its elements are reactive)
diff <- reactive({
x <- render_diff(diff_data(data_ref=dataset1(), data=dataset2()),use.DataTables=TRUE)
x
})
#Output
output$contents <- renderUI({
HTML(diff())
})
}
The expected result is my table to be fully seen on screen not extended that I have to scroll to see whole of it outside screen
Try use this
mainPanel(
HTML("<div style ='overflow:auto; ' >"),
uiOutput('contents'),
HTML("</div>")
)
or try set the height or set the width with css
mainPanel(
HTML("<div style ='overflow:auto; height:500px ' >"),
uiOutput('contents'),
HTML("</div>")
)
Related
I have this Shiny App, and so far it works great but the data when it is uploaded does not look as nice as I would have hoped. How do I limit it so each page only has 5 rows, and how can I get rid of the clear background of the table (right now it alternates between white and no background for the rows)
Thank you!
library(shiny)
library(dplyr) # alternatively, this also loads %>%
library(shinyWidgets)
regex_to_apply <- "\\bMASTER DATA\\b|\\bSOURCE LIST\\b|\\bVALIDITY DATES\\b|\\bMRP CONTROLLER\\b|\\bPSV\\b|\\bELIGIBILITY\\b|\\bCOST\\b|\\bMARKETING EXCLUSION\\b|\\bEFFECTIVITY\\b|\\bMISSING\\b|\bbBLANK\\b"
ui <- fluidPage(
# use a gradient in background, setting background color to blue
setBackgroundColor(
#https://rdrr.io/cran/shinyWidgets/man/setBackgroundColor.html used this website for help on background color
color = c("#F7FBFF", "#2171B5"),
gradient = "radial",
direction = c("top", "left")
),
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
tags$hr(),
checkboxInput("header", "Header", TRUE),
# Button
downloadButton("downloadData", "Download"),
actionButton('apply_regex', 'Apply Regex')
),
mainPanel(
dataTableOutput("contents")
)
)
)
server <- function(input, output) {
rv <- reactiveValues()
observe({
req(input$file1)
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
rv$data <- read.csv(inFile$datapath, header = input$header, encoding = "UTF-8")
})
output$contents <- renderDataTable({
rv$data
})
output$downloadData <- downloadHandler(
filename = function() {
paste("myfile",Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(rv$data, file, row.names = FALSE)
}
)
observeEvent(input$apply_regex, {
rv$data <- rv$data %>%
mutate(close_notes = close_notes %>% as.character() %>% toupper()) %>%
filter(grepl(regex_to_apply, close_notes))
})
}
shinyApp(ui, server)
How do I limit it so each page only has 5 rows. Set 'options' argument of renderDataTable. Here is a reproducible example:
library(shiny)
library(DT)
ui <- fluidPage(
br(),
DT::dataTableOutput(outputId = "t1")
)
server <- function(input, output, session) {
output$t1 <- DT::renderDataTable(iris, options = list(pageLength = 5))
}
shinyApp(ui, server)
I need the selected checkbox labels to fill in the "[,c("checkbox1","checkbox2")]" field (where both "checkbox1" and "checkbox2" are written). Thank you.
This is my code.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(readxl)
library(stringr)
ui <- fluidPage(
br(),
fileInput("archive", "Upload file", accept = c(
".xlsx")),
# Itens Selection
checkboxGroupInput("additem", "Select Items", choices = NULL)
)
box(
width = 2000,
verbatimTextOutput("calfa")
)
server <- function(input, output, session) {
# Upload Data Sheet
csv <- reactive({
req(input$archive)
inFile <- input$archive
df <- read_xlsx(inFile$datapath)
return(df)
})
#reactive value that will hold the name of the file
reactive_my_path <- reactive({
# Test if file is selected
req(input$archive)
return(sub(".xlsx$", "", basename(input$archive$name)))
})
observe({
input$archive
# update the choices in input$additem
updateCheckboxGroupButtons(session,
"additem",
paste('Column names in:', reactive_my_path()),
choices = names(csv()))
})
# Alpha
output$calfa <-
renderPrint({
int<-csv()[,c("checkbox1","checkbox2")]
int <- na.omit(int)
psych::alpha(int, check.keys = TRUE)
})
}
# App
shinyApp(ui, server)
You can use input$additem to include all the checkbox that are selected. Also I have included another condition to run the psych::alpha code only when there is more than one column.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(readxl)
library(tidyverse)
library(readxl)
library(stringr)
ui <- fluidPage(
br(),
fileInput("archive", "Upload file", accept = c(
".xlsx")),
# Itens Selection
checkboxGroupInput("additem", "Select Items", choices = NULL),
box(
width = 2000,
verbatimTextOutput("calfa")
)
)
server <- function(input, output, session) {
# Upload Data Sheet
csv <- reactive({
req(input$archive)
inFile <- input$archive
df <- read_xlsx(inFile$datapath)
return(df)
})
#reactive value that will hold the name of the file
reactive_my_path <- reactive({
# Test if file is selected
req(input$archive)
return(sub(".xlsx$", "", basename(input$archive$name)))
})
observe({
input$archive
# update the choices in input$additem
updateCheckboxGroupButtons(session,
"additem",
paste('Column names in:', reactive_my_path()),
choices = names(csv()))
})
# Alpha
output$calfa <-
renderPrint({
req(length(input$additem) > 1)
int<-csv()[,input$additem]
int <- na.omit(int)
psych::alpha(int, check.keys = TRUE)
})
}
# App
shinyApp(ui, server)
I have two multiple CSV files and I am comparing 2 each using a package called
Daff(https://github.com/edwindj/daff). Now I do want to select CSV from two dropdowns on the shiny app. The CSV is stored in the data folder
I have tried this code but I get an error
No file in directory
Error in file: cannot open the connection
UI.R
library("shiny")
library(daff)
library(dplyr)
ui <- fluidPage(
fluidPage(
titlePanel("Automated Data Dictionary Comparison"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'csv1',
label = 'Choose First Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
selectInput(inputId = 'csv2',
label = 'Choose Second Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE))
),
mainPanel(
dataTableOutput('contents')
)
)
)
)
server.R
library(shiny)
library(dplyr)
library(daff)
server <- function(input, output) {
# Parse first file
dataset1 <- reactive({
infile <- input$csv1
if (is.null(infile)){
return(NULL)
}
x <- read.csv(infile[[1]])
x
})
# Parse second file
dataset2 <- reactive({
infile <- input$csv2
if (is.null(infile)){
return(NULL)
}
x <- read.csv(infile[[1]])
x
})
# Create comparison table (reactive as both of its elements are reactive)
diff <- reactive({
x <- render_diff(diff_data(data_ref=dataset1(), data=dataset2()))
x
})
#Output
output$contents <- renderDataTable({
diff()
})
}
Expected result is html output of differences between the old and current csv
Please change your two cases of read.csv code to the below:
x <- read.csv(paste0("./data/", infile[[1]]))
Update
Full solution:
ui
library("shiny")
library(daff)
library(dplyr)
ui <- fluidPage(
fluidPage(
titlePanel("Automated Data Dictionary Comparison"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'csv1',
label = 'Choose First Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
selectInput(inputId = 'csv2',
label = 'Choose Second Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE))
),
mainPanel(
uiOutput('contents')
)
)
)
)
server
library(shiny)
library(dplyr)
library(daff)
server <- function(input, output) {
# Parse first file
dataset1 <- reactive({
infile <- input$csv1
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Parse second file
dataset2 <- reactive({
infile <- input$csv2
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Create comparison table (reactive as both of its elements are reactive)
diff <- reactive({
x <- render_diff(diff_data(data_ref=dataset1(), data=dataset2()))
x
})
#Output
output$contents <- renderUI({
HTML(diff())
})
}
Run App
shinyApp(ui, server)
I want to print data set values in R shiny web app. But below code is printing the name of dataset in UI output. How can I print values of dataset?
library(MASS)
library(shinythemes)
library(shiny)
library(ggplot2)
mass.tmp <- data(package = "MASS")[3]
mass.datasets <- as.vector(mass.tmp$results[,3])
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Linear Regression Modelling"),
sidebarLayout(
sidebarPanel(
selectInput("dsname", "Dataset:",choices = c(mass.datasets))
,
uiOutput("x_axis")
,
tableOutput("tab")
),
mainPanel(
tags$br(),
tags$br()
)
)
)
server <- function(input, output) {
num_ds <- function(ds)
{
nums <- sapply(ds,is.numeric)
num_ds <- ds[,nums]
return(num_ds)
}
ds_ext <- reactive({ num_ds(input$dsname) })
output$tab <- renderTable({ eval(input$dsname) })
# output$x_axis <- renderUI({
# col_opts <- get(ds_ext())
# selectInput("x_axis2", "Independent Variable:", choices = names(col_opts))
# })
}
shinyApp(ui = ui, server = server)
This is full code. I am trying to display data set from MASS package as you see in the code above.
I am building an app in shiny (R). At the beginning the user can upload a file to use (I am doing a sort data analysis). My goal is to be able to use files without knowing how many columns this file has, and how the data exactly looks like.
So now I have to select the columns by number, and I made a small preview app for this to select columns and then display them next to the original:
library(shiny)
ui <-fluidPage(
headerPanel("Select data"),
sidebarLayout(
sidebarPanel(
fileInput("uploadFile", "XLSX file"),
textInput('vec1', 'Choose training columns', "3,4"),
actionButton("choose","choose data")
),
mainPanel(
fluidRow(
column(6,tableOutput("data_raw")),
column(6,tableOutput("data_selected"))
)
)
)
)
server <- function(input, output) {
output$data_raw <- renderTable({
inFile <- input$uploadFile
if (is.null(inFile))
return(NULL)
data_raw <<-read.xlsx(inFile$datapath, 1)
})
observe({
if(input$choose>0){
selectvec <- as.numeric(unlist(strsplit(input$vec1,",")))
output$data_selected <- renderTable(
data_selected<- data_raw[,selectvec]
)
}
})
}
shinyApp(ui,server)
Now I would like to be able to select the columns to use on basis of their header.
It feels unnatural: changing the app while running.. but in a reactive environment.. why not?
QUESTION: How can I change the UI while it is allready running, with values originating from the input?
kind regards,
Pieter
To make me feel not as dirty for answering this...I didn't debug or handle reactives properly. But here ya go. You need to respond to the file that is uploaded on the server side, extract the column names, and append thosed to the choices in a select input that then passes down to the table function as a column filter.
upload_app <- function(){
library(shiny)
ui <- bootstrapPage(
tags$div(class = "container",
column(3,
fluidRow(
fileInput(inputId = 'user_data',
label = 'Upload Data (csv)',
multiple = FALSE,
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
))
),
fluidRow(
uiOutput('column_vars')
)
),
column(9,
tableOutput('filtered_table'))
)
)
server <- function(session, input, output){
var_table <- reactive({
var_data <- input$user_data
read.csv(var_data$datapath, header = TRUE,sep = ",", quote = '')
})
output$column_vars <- renderUI({
if(!is.null(var_table())){
selectInput(inputId = 'cols',
choices = colnames(var_table()),
multiple = T,
label = "Choose Columns")
}
})
output$filtered_table <- renderTable({
if(!is.null(var_table())){
if(length(input$cols)>0){
get_these <- input$cols
new_table <- var_table()[,c(get_these)]
}else {
new_table <- var_table()
}
}else {
new_table <- data.frame(data = 'Waiting')
}
return(new_table)
})
}
shinyApp(ui, server)
}