Is it possible to adjust the output of the Excel output?
I would like to be able to do the following things in descending urgency.
Add a Header to the table that includes some text "This table is based on the iris dataset and uses input$width as minimum"
Add an Thick bottom border to the column names header
Add a left border after the first column
Add an empty row above the header
Where I could write stuff into some merged cells, i.e. I would like to write "Petal Sizes" above the four columns of length, width,...
Thats a MWE using the button extension. I found some information for the original javascrtip DT here, but that is a bit too hard for me to transfer into R.
rm(list=ls())
library(shiny)
library(datasets)
library(DT)
library(data.table)
DT<-data.table(iris)
server<-shinyServer(function(input, output) {
output$view <- DT::renderDataTable(
DT[Sepal.Width<=input$width,.SD],extensions = c( 'FixedHeader','Buttons'),
options=list(pageLength=60,fixedHeader = TRUE,dom = 'Bfrtip',buttons = c( 'csv', 'excel' )))
})
ui<-shinyUI(fluidPage(
titlePanel("Shiny MWE"),
sidebarLayout(
sidebarPanel(
sliderInput("width", label = h3("Min width"),
min=min(DT$Sepal.Width), max=max(DT$Sepal.Width), value=mean(DT$Sepal.Width),
)),
mainPanel(
DT::dataTableOutput("view")
)
)
))
runApp(list(ui=ui,server=server))
I also realized that I had to abandon the 'button' extension, for other reasons as well. For instance, the excel download button only exports the view on the app, not the whole data set. (which can be fixed with the option server=FALSE, which is too slow for larger data sets)
I opted for the openxlsx package, which needs Rtools to be installed, which I had some difficulties with (found a solution to add it to the windows path ([Error: zipping up workbook failed when trying to write.xlsx)
So my posted code mostly does what I wanted or I can continue using the openxlsx commands. There are alternatives with the xlsx package or others, which I also had trouble installing.
rm(list=ls())
library(shiny)
library(datasets)
library(DT)
library(data.table)
library(openxlsx)
DT<-data.table(iris)
# Style created for openxlsx see help
hs <- createStyle(textDecoration = "BOLD", fontColour = "#FFFFFF", fontSize=12,
fgFill = "#177B57",border="Bottom",borderStyle=c("thick"))
#Server
server<-shinyServer(function(input, output) {
output$view <- DT::renderDataTable(
DT[Sepal.Width<=input$width,.SD],extensions = c( 'FixedHeader'),
options=list(pageLength=20,fixedHeader = TRUE,dom = 'frtip'))
#Include DownloadHandler
output$downloadData <- downloadHandler(
filename = function() { paste0("test.xlsx") },
content = function(file) {
wb<-createWorkbook() # Create wb in R
addWorksheet(wb,sheetName="Output") #create sheet
#Creates a Data Table in Excel if you want, otherwhise only use write Data
writeDataTable(wb,1, DT[Sepal.Width<=input$width,.SD], colNames = TRUE, headerStyle = hs,startRow=2,tableStyle = "TableStyleLight1")
mergeCells(wb,sheet = "Output", cols=1:5, rows=1)
writeData(wb,1, "Include text also based on reactive function and in merged cells" )
saveWorkbook(wb, file = file, overwrite = TRUE)
},
contentType= "excel/xlsx")
})
ui<-shinyUI(fluidPage(
titlePanel("Shiny MWE"),
sidebarLayout(
sidebarPanel(
sliderInput("width", label = h3("Min width"),
min=min(DT$Sepal.Width), max=max(DT$Sepal.Width), value=mean(DT$Sepal.Width),
),
downloadButton('downloadData', 'Download')),
mainPanel(
DT::dataTableOutput("view")
)
)
))
runApp(list(ui=ui,server=server),launch.browser=T) # Download button only works in browser
Related
I try to create a shiny app in which one can choose from different dfs. Then one can edit values in the table. At last I would like to download the edited table.
Each step for itself , edit and download, select and download is no problem. All three together: great despair.
I don't seem to understand how Shiny updates the reactive values and how you can cut it off with isolate.
library(shiny)
library(DT)
ui <- fluidPage(
# App title ----
titlePanel("Downloading Data"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Choose dataset ----
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars"), multiple=T),
actionButton(inputId = "goButton",
label = "Run Report"),
# downloadbutton
downloadButton("downloadData", "Download")
),
# Main panel for displaying outputs ----
mainPanel(
DTOutput("x1")
)
)
)
#df <- cars #if this is taken instead of the first "eventReactive" it works
server <- function(input, output) {
eventReactive({
# Take a dependency on input$goButton
input$goButton
# Use isolate() to avoid dependency on input$obs
df <- isolate(input$dataset)
})
#render the editable DT
output[["x1"]] <- renderDT({
datatable(
df,
selection = "single",
editable = TRUE
)
})
# Creating a DF with the edited info
aniRoi2 <- reactiveVal(df)
#Creating proxy
proxy <- dataTableProxy("x1")
#storing edited df in proxy
observeEvent(input[["x1_cell_edit"]], {
info <- input[["x1_cell_edit"]]
newAniroi2 <-
editData(aniRoi2(), info, proxy, rownames = TRUE, resetPaging = FALSE)
aniRoi2(newAniroi2)
saveRDS(newAniroi2, "data_entry_form.rds") # save rds
})
#download the proxy
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(aniRoi2(), file)
}
)
}
shinyApp(ui, server)
Here I try to select a dataset, that only gets loaded by press of a button. Then it should behave like a normal data.frame or tibble.
If I take out the possibilty of selection of dataframes and call between "ui" and "server" "df <- cars" then it works as intended.
As of now I get the error message:
Listening on http://127.0.0.1:4060
Warnung: Error in is_quosure: Argument "expr" fehlt (ohne Standardwert)
52: is_quosure
51: exprToQuo
50: eventReactive
49: server [#2]
3: runApp
2: print.shiny.appobj
1:
Error in is_quosure(expr) : Argument "expr" fehlt (ohne Standardwert)
Thank you very much, any help would be much appreciated. It feels as if I am so close (but it feels like that since a week).
I also tried this download edited data table gives warning in shiny app it uses observe to wrap the selection. But in the shiny-app I get the familiar "Error 'data' must be 2-dimensional (e.g. data frame or matrix)"
PS: If you would forgive a bonus question: How do you debug shiny? I mean how can you see inside of what is happening, how the environment looks like and which processes are working?
There are some issues with your code. First, input$dataset is a character string with the name of the chosen dataset, not the dataset itself. To get the dataset use e.g. get(input$dataset). Second, the way you use eventReactive is interesting. (; Overall I would go for an observeEvent to init your reactiveVal aniRoi2 with the chosen dataset. Finally I have set multiple=FALSE in your selectInput as choosing multiple df's breaks your code and allowing the user to select multiple dfs makes no sense to me. (I guess that you have done this to get rid of the pre-selected value?? )
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Downloading Data"),
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "pressure", "cars"), multiple = FALSE
),
actionButton(
inputId = "goButton",
label = "Run Report"
),
downloadButton("downloadData", "Download")
),
mainPanel(
DTOutput("x1")
)
)
)
server <- function(input, output) {
aniRoi2 <- reactiveVal()
observeEvent(input$goButton, {
aniRoi2(get(input$dataset))
})
output[["x1"]] <- renderDT({
datatable(
aniRoi2(),
selection = "single",
editable = TRUE
)
})
proxy <- dataTableProxy("x1")
observeEvent(input[["x1_cell_edit"]], {
info <- input[["x1_cell_edit"]]
newAniroi2 <-
editData(aniRoi2(), info, proxy, rownames = TRUE, resetPaging = FALSE)
aniRoi2(newAniroi2)
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep = "")
},
content = function(file) {
write.csv(aniRoi2(), file)
}
)
}
shinyApp(ui, server)
I need to give users a set of 60 observations. I have a master table that I want to to subset these 60 observations from. So, (1) I host the master table as a published csv file on google drive. (2) Write a shiny code to subset 60 values in R studio. The user will have to enter a group ID that I use as set.seed and ensure that the user sees the same subset every time he / she attempts to get the 60 observations. And, it also helps me keep track of the observations that the user has.
The code works fine and I am able to show the subset table. But, I am not able to get the download to work. I saw a post that says renderTable create an HTML table that cannot be downloaded and I should create the table outside it. I tried using reactive to do this, but it did not work and kept giving various errors. For example:
"cannot coerce class ‘c("reactiveExpr", "reactive", "function")’ to a data.frame"
Will appreciate any help of this - even if someone can please point out to what I should read and try to make this work.
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
output$table <- renderTable({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])})
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(output$table, file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Create your table once, and then use it in your renderTable and downloadHandler. Create it as a reactive, so its available everywhere.
Note that downloadHandler doesn't work in RStudio's preview, view it in a browser instead. There is a button labelled 'Open in Browser' that will do this.
Here is your code with that applied:
library(shiny)
db1 <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS94xYLix6bDUNNXAgHejdQ-CcWi-G4t25nfxuhRZF57TloC8NwVgnperBB9-U-IuDvMcOnvdc9iavU/pub?gid=0&single=true&output=csv")
# Define UI
ui <- fluidPage(
# Application title
titlePanel("MnM"),
# Sidebar to take input of group ID
sidebarLayout(
sidebarPanel(
numericInput("seed","Group ID:", value = 100, min = 100, max = 999),
downloadButton("downloadData", "Download")
),
# Show the table
mainPanel(
tableOutput("table")
)
)
)
# Define server logic for the table
server <- function(input, output) {
#Create dataframe
mytable <- reactive({
set.seed(input$seed)
zz <- sample(1:nrow(db1), size = 60, replace = TRUE)
data.frame(db1[zz,])
})
#Display dataframe in table
output$table <- renderTable({
mytable()
})
#Download dataframe
output$downloadData <- downloadHandler(
filename = "test.csv",
content = function(file) {
write.csv(mytable(), file, row.names = FALSE)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Im trying to follow the examples (https://yihui.shinyapps.io/DT-edit/) for editing a DT table in R shiny, but cannot seem to get it to update correctly. Below is a toy example. As a test, table edits should print to the main panel when hitting "go," but the edits are not passed along. I am not sure what I am doing wrong.
Second, I would like to be able to work with the table as an R object that I can pass along to other aspects of the code (e.g., pass one of the columns as a vector to something else). But I am not 100% sure how to do this. Ideally this might be something like "hot_to_r" in the rhandsontable package, but I am not sure how this might be done for DT. Thank you in advance for your help.
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("use DT package"),
sidebarLayout(
sidebarPanel(
h4('A Table Using Server-side Processing'),
fluidRow(
column(2),
column(8, DT::dataTableOutput('tb')),
column(2)
),
actionButton("go", "go")
),
mainPanel(
verbatimTextOutput("test"), #to test if the table updates
)))
server <- (function(input, output, session) {
DF <- data.frame(Original_Name = rep("place holder", 3), New_Name = rep("place holder", 3), stringsAsFactors = FALSE)
output$tb <- renderDT(DF, selection = "none", server = TRUE, editable = "all")
# update edited cells ("all")
observeEvent(input$tb_cell_edit, {
DF <<- editData(DF, input$tb_cell_edit, 'tb')
})
#print the table to test that it works
#but what I really want is to create an R object that I can use
#to extract column "Original_Name" and "New_Name"
observeEvent(input$go,{
output$test<-renderPrint(DF)
})
})
runApp(list(ui=ui,server=server), launch.browser=TRUE) #launch in browser
I am trying to use the diffR function to accept two .R files to compare the differences in a shiny app. Where someone can upload two R files and then it will utilize diffR to output.
I can run my code locally where I define my file one and file two as directories locally and then I'll get a side by side output of the code to show the differences. It highlights differences and then adjustments can be made.
server <- function(input, output, session) {
output$contents <- renderPrint({
info_old <- input$old_file
if(is.null(info_old))
return(null)
df_old <- readLines(info_old$datapath)
df_old
})
output$new_contents <- renderPrint({
info_new <- input$new_file
if(is.null(info_new)){return()}
df_new <- readLines(info_new$datapath)
df_new
})
output$exdiff <- renderDiffr({
diffr(info_old(), info_new(), wordWrap = input$wordWrap,
before = "Original_File", after = "New File")
})
}
I know this simple where both the old_file and the new_file are generated side. This stack answer shows exactly what I am looking for:
In R, find whether two files differ
Where the diffr package is used. I just want the user to have the ability to upload the two R files so do the side by side comparison instead of defining file a and b globally.
You can use the datapath given by the uploaded files: input$files[[1, 'datapath']].
If you like, a small remark on your (good) attempt. The diffr() function demands the connection to the file not the content itself. I ran into the same trap as well. So if you remove the readLines() in your code you should be pretty close.
You might want to include a test, that the length of uploaded files is not smaller or greater than 2, to ensure the app doesnt crash if e.g. only one file is given.
Reproducible example:
write.csv2(
x = "diff same",
file = "test.csv"
)
write.csv2(
x = "diffhere same",
file = "test2.csv"
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "files",
label = "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
)
),
mainPanel(
tableOutput("contents"),
diffrOutput("exdiff")
)
)
)
server <- function(input, output) {
output$exdiff <- renderDiffr({
req(input$files)
diffr(
file1 = input$files[[1, 'datapath']],
file2 = input$files[[2, 'datapath']],
wordWrap = TRUE,
before = "f1",
after = "f2"
)
})
}
shinyApp(ui, server)
I created an app with shiny and shinyTable. It reads a csv file as data.frame and saves changes or new rows.
If I add a new row, it is saved but not shown in the table. I can only see the row in the table when I restart the app. How can I make sure that the submit button adds the row without restarting the app?
EDIT: I can generate this functionality with shiny and a "normal" table with renderTable, but I can't manage to get this working with shinyTable.
What I basically want to achieve is this functionality with shinyTable to have an editable table where I can add rows.
app.R
require(shiny)
datafile<-read.csv("data.csv", header=TRUE, sep=",", quote="")
runApp(
list(
ui = fluidPage(
headerPanel('Title'),
sidebarPanel(
textInput("fielda", label="fielda", value=""),
textInput("fieldb", label="fieldb", value=""),
actionButton("addButton", "insert data")
),
mainPanel(
tableOutput("table"))
),
server = function(input, output) {
datafile_sample <- datafile[sample(nrow(datafile)),]
row.names(datafile_sample) <- NULL
values <- reactiveValues()
values$df <- datafile_sample
addData <- observe({
if(input$addButton > 0) {
newLine <- isolate(c(input$fielda, input$fieldb))
isolate(values$df <- rbind(as.matrix(values$df), unlist(newLine)))
write.csv(values$df, file = "data.csv", row.names=F, quote=F)
}
})
output$table <- renderTable({values$df}, include.rownames=F)
}
)
)
data.csv
fielda,fieldb
1,2
3,4
I think I would approach this a little bit differently. As you've written your example, your data frame resulting from the read.csv shouldn't be called outside of the server. It should, itself, be reactive. In the code below, I've put it in a reactive values call, and initialized it with read.csv.
Then, when you add data to it, you can use write.table to add it to the existing file, and then update the reactive object. This should set all the pieces in motion to update automatically, regardless of what table type you use? (I'm not familiar with shinyTable, so didn't experiment with it much).
There are a few variants you can take on this. For starters, is it really necessary to write the new data to the file? Perhaps you could just append the new data to the existing data frame using rbind. (The write/read combination is going to be slow in comparison).
Even if it is necessary to write the new data, it's probably better to write the new data and use rbind to update the data frame in your app.
library(shiny)
D <- "fielda,fieldb\n1,2\n3,4"
write(D, file = "data.csv")
runApp(
list(
ui = fluidPage(
headerPanel('Title'),
sidebarPanel(
textInput("fielda", label="fielda", value=""),
textInput("fieldb", label="fieldb", value=""),
actionButton("addButton", "insert data")
),
mainPanel(
tableOutput("table"))
),
server = function(input, output) {
data <- reactiveValues(
file = read.csv("data.csv",
header=TRUE,
sep=",",
quote="")
)
addData <- observeEvent(
input$addButton,
{
newLine <- data.frame(fielda = input$fielda,
fieldb = input$fieldb)
write.table(newLine,
file = "data.csv",
col.names = FALSE,
row.names=FALSE,
quote=FALSE,
append = TRUE,
sep = ",")
data$file <- read.csv("data.csv",
header=TRUE,
sep=",",
quote="")
}
)
output$table <-
renderTable(data$file, include.rownames=FALSE)
}
)
)