What I do:
I have a shiny App that returns every column of my csv as a verbatim ouput. I attached my current code (UI.R and Server.R) and the csv-File below.
My Question: I need to write such an app for many different csv-files that all have a variing number of columns. How do I do this automatically without having to write
output$myColumn01 = renderPrint({
as.character(D$Names)
})
and
h1("Names"),
verbatimTextOutput("myColumn01"),
for every column manually?
-
Here is my csv ("myCSV.csv"):
Names;Pages;Scores;Numbers
George;T;3;5
Jim;I;4;23
Jack;T;6;12
Anna;R;4;3
Here is my server.R-File:
library(shiny)
library(dplyr)
library(shinydashboard)
server <- shinyServer(function(input, output, session) {
D = read.csv(file = "myCSV.csv", sep = ";")
output$myColumn01 = renderPrint({
as.character(D$Names)
})
output$myColumn02 = renderPrint({
as.character(D$Pages)
})
output$myColumn03 = renderPrint({
as.character(D$Scores)
})
output$myColumn04 = renderPrint({
as.character(D$Numbers)
})
})
Here is my ui.R-File:
library(shiny)
library(dplyr)
library(shinydashboard)
ui <- shinyUI(dashboardPage(
dashboardHeader(title = "Sessions"),
dashboardSidebar(
width = 350,
collapsed = TRUE,
""
),
dashboardBody(
h1("Names"),
verbatimTextOutput("myColumn01"),
h1("Pages"),
verbatimTextOutput("myColumn02"),
h1("Scores"),
verbatimTextOutput("myColumn03"),
h1("Numbers"),
verbatimTextOutput("myColumn04")
)
))
Is it what you expect ?
library(shiny)
library(dplyr)
library(shinydashboard)
server <- shinyServer(function(input, output, session) {
D = read.csv(file = "myCSV.csv", sep = ";")
lapply(1:ncol(D), function(i){
output[[sprintf("myColumn%02d",i)]] <-
renderPrint({
as.character(D[[colnames(D)[i]]])
})
})
output$ui <- renderUI({
lapply(1:ncol(D), function(i){
tagList(
h1(colnames(D)[i]),
verbatimTextOutput(sprintf("myColumn%02d",i))
)
})
})
})
ui <- shinyUI(dashboardPage(
dashboardHeader(title = "Sessions"),
dashboardSidebar(
width = 350,
collapsed = TRUE,
""
),
dashboardBody(
uiOutput("ui")
)
))
shinyApp(ui=ui, server=server)
Related
Is it possible to change the column names manually in rhandsontable? Also why cant I add a new row or column here?
## app.R ##
library(shiny)
library(shinydashboard)
library(rhandsontable)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
),
dashboardBody(
rHandsontableOutput('table')
)
)
server <- function(session,input, output) {
output$table <- renderRHandsontable({
rhandsontable(iris, width = 550, height = 300) %>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})
}
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 the following data:
> data
products id
1 P1 280386
2 P1 285184
3 P2 293154
4 P1 294245
I have built a simple shiny code. I first filter the table and then I want to download the filtered table. I write the following
library(shiny)
library(shinyWidgets)
library(tidyverse)
library(DT)
data <- read.csv("Desktop/data.csv")
products <- unique(data$products)
ui <- fluidPage(
fluidRow(
column(4,
selectInput("product", "Product", products,
multiple = TRUE),
downloadButton("download", "Download")),
column(8,
tableOutput("errorTable")
)
)
)
server <- function(input, output, session) {
output$errorTable <- renderTable({
subset(data, products == input$product)
}
)
output$download <- downloadHandler(
filename = function() {
paste("data-",Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(data, file)
}
)
}
shinyApp(ui, server)
However, this code only downloads the full table, not the filtered one. I have searched some question but none explained this case specifically. thanks in advance
Try this
library(shiny)
library(shinyWidgets)
library(tidyverse)
library(DT)
data <- read.csv("Desktop/data.csv")
products <- unique(data$products)
ui <- fluidPage(
fluidRow(
column(4,
selectInput("product", "Product", products,
multiple = TRUE),
downloadButton("download", "Download")),
column(8,
tableOutput("errorTable")
)
)
)
server <- function(input, output, session) {
#you need to create a reactive object with a NULL starting value
listofitems <- reactiveValues(data = NULL )
#observe the changes in input$product and update the reactive object
observeEvent( input$product, {
print("Hello: observeEvent for input$product is triggered")
#debug using browser()
listofitems$data <- subset(data, products == input$product)
showNotification("Products updated",
type = "message",
duration = 4,
closeButton = TRUE)
}, ignoreInit = T,ignoreNULL = TRUE)
output$errorTable <- renderTable({
listofitems$data
}
)
output$download <- downloadHandler(
filename = function() {
paste("data-",Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(listofitems$data, file)
}
)
}
shinyApp(ui, server)
Is there a way to make the Search bar of the datatable empty instead of having the 'setosa' inside it by default while keeping the 'setosa' highlighted inside the table? Or at least find another way to highlight or underline the 'setosa'?
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
),
dashboardBody(
DT::dataTableOutput("t")
)
)
server <- function(input, output) {
output$t <- renderDT(
datatable(iris, options = list(searchHighlight = TRUE, search = list(search = 'setosa')))
)
}
shinyApp(ui, server)
Ok, you can do something like this.
library(DT)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
),
dashboardBody(
DT::dataTableOutput("t")
)
)
server <- function(input, output) {
data <- reactive({
mydata <- iris
rownames(mydata) <- gsub("setosa",tags$span(style="color:red", "setosa"),rownames(mydata))
for(i in 1:ncol(mydata)){
mydata[,i] <- gsub("setosa",tags$span(style="color:red", "setosa"),mydata[,i])
}
mydata
})
output$t <- renderDT(
datatable(data(), options = list(searchHighlight = TRUE, search = list(search = '')), escape = F)
)
}
shinyApp(ui, server)
I'm trying to learn how to use shiny modules. I started with a simple app that is very similar to the one in the documentation. The app ask you to check a box, then you can upload a csv file, and it will show you a table with the data:
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(
checkboxInput("agree", p("I read ",
a("the very important stuff",
href="http://stackoverflow.com/",
target="_blank")), FALSE),
fileInput(
"chosenfile",
label = h4("File input"),
accept = ".csv"
))
# Body
body <- dashboardBody(
useShinyjs(),
box(
title = "Test",
width = 12,
solidHeader = TRUE,
status = "warning",
dataTableOutput('tbl')
)
)
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {
#Load the chosen dataset
data <- reactive({
dfile <-
input$chosenfile[1, 4] # <- filename with path is the [1,4] cell in obj
if (!is.null(dfile))
readr::read_csv(dfile)
})
output$tbl <- renderDataTable(data(),
options = list(scrollX = TRUE,
pageLength = 10,
searching = FALSE))
observe({
if (input$agree == T) {
# enable the download button
shinyjs::enable("chosenfile")
}
})
observe({
if (input$agree == F) {
# enable the download button
shinyjs::disable("chosenfile")
}
})
}
#run
shinyApp(ui, server)
I want to create a module that has the check the box, upload the file part of the app.
Right now I have this:
# Module
# Module UI function
csvFileInput <- function(id, label = "CSV file") {
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
checkboxInput(ns("agree"), p("I read ",
a("the very important stuff",
href="http://stackoverflow.com/",
target="_blank"))),
fileInput(ns("file"), label)
)
}
# Module server function
csvFile <- function(input, output, session) {
# The selected file, if any
userFile <- reactive({
# If no file is selected, don't do anything
validate(need(input$file, message = FALSE))
input$file
})
# The user's data, parsed into a data frame
dataframe <- reactive({
readr::read_csv(userFile()$datapath)
})
# We can run observers in here if we want to
observe({
msg <- sprintf("File %s was uploaded", userFile()$name)
cat(msg, "\n")
})
# Return the reactive that yields the data frame
return(dataframe)
}
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(
csvFileInput("datafile", "CSV file")
)
# Body
body <- dashboardBody(
useShinyjs(),
box(
title = "Test",
width = 12,
solidHeader = TRUE,
status = "warning",
dataTableOutput("table")
)
)
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {
datafile <- callModule(csvFile, "datafile")
output$table <- renderDataTable({
datafile()
})
}
#run
shinyApp(ui, server)
I'm not sure how to implement the the enable/disable part of the module.
I tried this, but the app crashes:
# Module
# Module UI function
csvFileInput <- function(id, label = "CSV file") {
# Create a namespace function using the provided id
ns <- NS(id)
tagList(
checkboxInput(ns("agree"), p("I read ",
a("the very important stuff",
href="http://stackoverflow.com/",
target="_blank"))),
fileInput(ns("file"), label)
)
}
# Module server function
csvFile <- function(input, output, session) {
# The selected file, if any
userFile <- reactive({
# If no file is selected, don't do anything
validate(need(input$file, message = FALSE))
input$file
})
# The user's data, parsed into a data frame
dataframe <- reactive({
readr::read_csv(userFile()$datapath)
})
# We can run observers in here if we want to
observe({
msg <- sprintf("File %s was uploaded", userFile()$name)
cat(msg, "\n")
})
# Return the reactive that yields the data frame
return(dataframe)
}
diable_button <- function(input, output, session, button, agree){
observe({
if (agree == T) {
# enable the download button
shinyjs::enable(button)
}
})
observe({
if (agree == F) {
# enable the download button
shinyjs::disable(button)
}
})
}
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(
csvFileInput("datafile", "CSV file")
)
# Body
body <- dashboardBody(
useShinyjs(),
box(
title = "Test",
width = 12,
solidHeader = TRUE,
status = "warning",
dataTableOutput("table")
)
)
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {
datafile <- callModule(csvFile, "datafile")
callModule(diable_button, "datafile",
button = input$chosenfile,
agree = input$agree)
output$table <- renderDataTable({
datafile()
})
}
#run
shinyApp(ui, server)