I have a shiny-app that displays a datatable using the DT-package. What I want is to be able to format columns in a custom way. For example I want a currency value to be displayed like this: 1,234.50€ instead of the DT-way, which displays it like this $1,234.5 (notice the change in the symbol, the position of the currency-symbol as well as the numbers after the decimal-point).
An MWE looks like this:
library(shiny)
library(DT)
shinyApp(
# UI
ui = fluidPage(DT::dataTableOutput('tbl')),
# SERVER
server = function(input, output) {
dat <- data.frame(cur = 1234.5, # supposed to be displayed as: 1,234.50€ | Bad!
# displayed as $1,234.5
perc = 0.123456, # 12.34% | Good!
num = 1000) # 1,000 | Bad! displayed as 1000
# render DT
output$tbl = DT::renderDataTable(
datatable(dat) %>%
formatCurrency(c('cur'), "$") %>%
formatPercentage('perc', 2) %>%
formatRound('num', digits = 0)
)
}
)
It does a fairly good job, however, when changing the currency-symbol to €, the symbol disappears. When inserting another character like "E", the character is still displayed at the beginning not at the end. Furthermore, the numeric value does not get a "big-mark".
Any ideas?
You can change the position of the currency symbol in the .js file from the datatable package.
Edit the line of the DTWidget.formatCurrency function
$(thiz.api().cell(row, col).node()).html(currency + markInterval(d, interval, mark));
to simply
$(thiz.api().cell(row, col).node()).html(markInterval(d, interval, mark) + currency);
in the DT/htmlwidgets/datatables.js file in the directory of your R librarys.
As for the € Symbol,
formatCurrency(c('cur'), currency = "\U20AC", interval = 3, mark = ",", digits = 2)
does work for me, thats what you tried and you don't see any symbol?
Related
I am trying to design a reactive Shiny Application. I am using a Double Headed Slider Input for picking up multiple values and to display it's corresponding other column values in a data table in Shiny App. The issue which I am facing is for example lets take the range as 1 to 3, Where my data has values for 1, 2 and 3. When I place one Input dot in 1 and another Input dot in 3, the general expectation is, it should pick up the values for 2 also, as it is present in the range of 1 to 3. But the values of 2 are not getting displayed. Kindly find the code which I used to create a Slider Input.
sliderInput(
"key",
"Key Value",
min = 1,
max = 3,
value = c(1,3),
step=1
)
And in the Shiny App the Slider Input values are selected like this.
The Output which I am getting is
But I should be getting the values of 2 also.
Can someone please help me on this.
Thanks in Advance.
I expect that the error is not in your slider, but in the way you filter. Note that a slider returns the minimum and maximum values selected, and not all values in its range. So here,input$key would return an array with the numbers and 1 and 3, and not 2. If you would then subsequently apply the filter df$Key %in% input$key, only 1's and 3's would be selected. If you want all numbers within the range, you should filter for the numbers in between, for example
df$Key >= input$key[1] & df$Key <= input$key[2]
or
df$Key %inrange% input$key,
with %inrange% from the data.table package.
A working example is given below, hope this helps!
library(shiny)
library(DT)
library(data.table)
df <- data.frame(Key=c(1,1,2,2,3,3))
ui <- fluidPage(
sliderInput("key","Key Value",min = 1,max = 3,value = c(1,3),step=1),
dataTableOutput('my_dt')
)
server <- function(input, output, session) {
output$my_dt <- renderDataTable({
# produces wrong result; only 1 and 3.
# df <- df[df$numbers %in% input$key,,drop=FALSE]
# produces correct result; 1,2 and 3.
# df <- df[df$Key %inrange% input$key,,drop=FALSE]
# Also produces correct result; 1,2 and 3. No data.table needed.
df <- df[df$Key >= input$key[1] & df$Key <= input$key[2],,drop=FALSE]
})
}
# Run the application
shinyApp(ui = ui, server = server)
In Shiny App, I want to read a table from my local, display it as an rhandsontable, and overwrite one of the columns with Sys.Date(), and display the updated table as rhandsontable.
the table function_table looks like this.
client fun agency loading_site last_update_on_DB
IKEA mean NA Paris 2018-08-01
Nestle sum NA Berlin 2018-08-02
Toyota mean NA Munich 2018-07-01
: : : : :
Here is my server.R
# read a table
func_path <- '/...[FILE PASS].../function_table.csv'
function_table <- reactive({read.csv(func_path, header = T, sep = ',', stringsAsFactors = F)})
# convert table to rhandsontable object to display in the app
hot_func <- reactive({function_table() %>%
rhandsontable(width = 1000, height = 1000) %>%
hot_cols(readOnly = T) %>%
hot_table(stretchH = "all" )})
# do some computations and overwrites the table
# ui.R has an action button (id = compute)
observeEvent({
input$compute
},{
# some computations...
# overwrite last_update_on_DB column with Sys.Date()
function_table()[function_table()$client == input$client,]$last_update_on_DB <- Sys.Date()
})
But the error reads:
Reactives: invalid (NULL) left side of assignment
I also followed this page like below, but got another error:
# read a table
values <- reactiveValues()
func_path <- '/...[FILE PASS].../function_table.csv'
values$function_table <- reactive({read.csv(func_path, header = T, sep = ',', stringsAsFactors = F)})
# convert table to rhandsontable object to display in the app
hot_func <- reactive({values$function_table() %>%
rhandsontable(width = 1000, height = 1000) %>%
hot_cols(readOnly = T) %>%
hot_table(stretchH = "all" )})
# do some computations and overwrites the table
# ui.R has an action button (id = compute)
observeEvent({
input$compute
},{
# some computations...
# overwrite last_update_on_DB column with Sys.Date()
values$function_table <- values$function_table()
values$function_table[values$function_table$client == input$client, ]$last_update_on_DB <- Sys.Date()
})
Warning: Error in eval: tentative d'appliquer un objet qui n'est pas une fonction
(it's telling me that in the line of hot_func, values$function_table() is not a function)
Any solutions?
Focusing on your first example:
You are trying to assign a value to a reactive object. function_table is a reactive, so you can only get its value not set its value via function_table()[....] <- .....
It is difficult to know exactly how to fix this as you have not posted a minimal reproducible example.
One way to resolve this using a reactive value. This is a value that can be assigned to and changed within the server. Here is an example:
server = function(input, output, session){
current = reactiveValues()
current$rhandsontable = read.csv(....) # your own code here to load the file on start up
observeEvent(input$compute,{
tmp = isolate(current$rhandsontable)
tmp[tmp$client == input$client,]$last_update_on_DB <- Sys.Date()
current$rhandsontable <- tmp
}
}
The use of isolate(...) may be unnecessary. It is used to prevent reactive values being re-evaluated in the retrieval of its contents.
This example assumes you are loading a fixed/known file at the beginning of your server. If you are loading your file dynamically you will probably need to use an observer to set the current value. For example (pseudo-code):
current = reactiveValues()
current$rhandsontable = NULL
observe(file_name,current$rhandsontable = read.csv(file_name))
I wrote a shiny app which will be used for searching and downloading a quite large dataset. The app works and is nearly done, but some functionalities do not work as I want:
I tried several ways of adding a function in order to download the chosen data as .csv-file. All of them failed and I was only able to download all data instead of the displayed ones.
I was not able to include a function to round data and show some columns as percentage instead of numbers. The formatRound() function within datatable() works well and I would like to use it, but the problem is that I was not able to include it in the server function. Since the user should get the whole number (with all numbers also behind the comma) for his or her work, the data should only be rounded when displayed. If I would be able to fix the rounding, the percentage problem will also be solved, since I would use the similar function formatPercentage().
I made an example using the mtcars-data and removed all wrong or not-working codes for the download and rounding problem. Any hints how I could solve my problem would be extremely appreciated! Thanks in advance!
EDIT3: Rounding problem solved with the code below thanks to #Claud H. The download function exports an empty file (no file-type) named download. Do you have any idea where the error is?
EDIT4: problems solved thanks to #Claud H. I changed mt_cars_filtered()[, c(input$results_columns_selected)]into mt_cars_filtered()[, input$indicator]. Also, I didn't know first that I had to open the web browser to download the data.
library(tidyverse)
library(shiny)
library(shinythemes)
library(DT)
library(ggthemes)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width=3,
h3("title", align = 'center'),
checkboxGroupInput("cylinder", "Cylinder", choices = c(4,6), selected = c(4)),
checkboxGroupInput('indicator', label = 'Indicators', choices = colnames(mtcars)[1:7],
selected = colnames(mtcars)[c(1:7)]),
fluidRow(p(class = 'text-center', downloadButton('download', label = 'Download')))),
mainPanel(
tabsetPanel(
tabPanel('Table',
DT::dataTableOutput('results'))
)
)
))
server <- function(input, output){
mtcars_filtered <- reactive({
mtcars %>%
filter(cyl %in% input$cylinder)
})
# Output Table
output$results <- DT::renderDataTable({
columns = input$indicator
mtcars_filtered()[, columns, drop = FALSE] %>%
datatable(style = 'bootstrap', selection = list(target = 'column'), options = list(paging = FALSE, dom = 't')) %>%
formatRound(input$indicator[grep('t', input$indicator)], 2)
})
# Download Data
output$download <- downloadHandler(
filename = function() { paste('filename', '.csv', sep = '') },
content = function(file) {
write.csv(mtcars_filtered()[,input$indicator], file, row.names = FALSE)
})
}
shinyApp(ui = ui, server = server)
Suggest looking at ?"%>%" from magrittr package
Also, check this and this answers on SO.
Your table should be fine with this kind of syntax
output$results <- DT::renderDataTable({
columns = input$indicator
mtcars_filtered()[, columns, drop = FALSE] %>%
datatable() %>%
formatCurrency( input your code here) %>%
formatPercentage( and so on ... )
}, style = 'bootstrap', options = list(paging = FALSE, dom = 't'))
Also, I didnt quite get the question about downloading. If you want to download a data FROM server, use downloadHandler() function. Something like:
output$save_data <- downloadHandler(
filename = function() { paste("filename", '.csv', sep = '') },
content = function(file) {
write.csv(mydata(), file, row.names = FALSE)
})
and downloadButton("save_data", "download") in ui.R
edit: as per your changes, download isn't working because you got wrong columns selected: there is no table called tableId, and you need to take the columns from the table called results:
write.csv(mtcars_filtered()[, c(input$results_columns_selected)], file, row.names = FALSE)
as of rounding problem, you can use your indicator variable to see if column is selected input$indicator %in% c('drat', 'qsec', 'wt') then use subsetting to select only columns with TRUE, if there are any: formatRound(input$indicator[input$indicator %in% c('drat', 'qsec', 'wt')], 2)
edit2
Seems I've understood everything you wanted to do right.
To select columns in the downloadHandler function based on your checkboxes , use indicator variable to filter it:
mtcars_filtered()[, input$indicator]
Otherwise, if you want to select them from the table itself with the mouse clicks, use input$results_columns_selected, like this:
mtcars_filtered()[, c(input$results_columns_selected)]
When a row in a DataTable is clicked, I would like an image in a different panel to be loaded but, I keep getting an error and not.
**Warning in widgetFunc() :
renderDataTable ignores ... arguments when expr yields a datatable object; see ?renderDataTable
Error in basename(file) : a character vector argument expected**
output$image1 <- renderImage({
s = input$table1_rows_selected
if (length(s)) list(src=paste0(imagePath,"/peak",s,".png"))},deleteFile=FALSE)
The function below works however,
output$image1 <- renderImage({list(src=paste0(imagePath,"/peak1.png"))},deleteFile=FALSE)
Here is a full version of the code:
server.R
writeLines("Please select ANY image")
imagePath = file.choose()
# break up the character vector, delete the last word
imagePath = dirname(imagePath)
server = function(input, output) {
output$table1 = renderDataTable({
# the peak table
datatable(peaksTable,
# when rowname is false each row does not have a numeric # associated with it
rownames = FALSE,
# specify the name of the column headers
colnames = c("Seqnames", "Start", "End","Width","Strand","P","Q","Effectsize",
"FDR","Keep","Gene_name","Gene.nearest","Count","Count.pred",
"Coverage","Local.mut.density","Base.context.GC","Tn.Context.TpC",
"Tn.context.CpG","Dnase","Activechrom","Hetchrom","Rept"))
},
escape = FALSE)
# render an Image based on which rows are clicked on.
output$image1 <- renderImage({
s = input$table1_rows_selected
if (length(s)) list(src=paste0(imagePath,"/peak",s,".png"))},deleteFile=FALSE)
ui.R
shinyUI(navbarPage(
title = " Nanoproject",
# first panel , create table of the peaksTable dataframe
tabPanel('Peak Table' ,
dataTableOutput('table1')),
# second panel
tabPanel('Peak Images' ,
imageOutput("image1",width = "auto",height = "auto")
))
I'm not sure where I'm going wrong.
Like it's been pointed out, without a reproducible example it's hard to help.
My guess is that your code is not dealing with the case where no rows are selected. If that's true, something like this should fix the problem:
server.R
output$image1 <- renderImage({
s <- input$table1_rows_selected
# print(s)
if(is.null(s)) return(NULL)
list(src = paste0(imagePath,"/peak",s,".png"))
}, deleteFile=FALSE)
Printing out s could help you understand better whats going on.
I would like to sort a DataTable column that is formatted with dollars (and thus is a character). I have used scales::dollar() for formatting. This converts the field to a character which causes sorting problems (for instance, "$8" > "$10").
How can I sort the field as if it were numeric? Alternatively, can I keep the field as numeric and just print with dollar formatting?
app.R (requires Shiny 0.10.2)
server <- function(input, output) {
output$foo_table <- renderDataTable({
x <- seq(8000, 12000, by = 1000)
x <- scales::dollar(x)
d <- data.frame(x, stringsAsFactors = FALSE)
d
})
}
ui <- shinyUI(fluidPage(
mainPanel(dataTableOutput("foo_table"))
)
)
shinyApp(ui = ui, server = server)
A bit late, but the DT Package now has format functions, including formatCurrency:
# format the columns A and C as currency, and D as percentages
datatable(m) %>% formatCurrency(c('A', 'C')) %>% formatPercentage('D', 2)
From the Functions page:
Under the hood, these formatting functions are just wrappers for the rowCallback option to generate the appropriate JavaScript code.
Similarly, there is a formatDate() function that can be used to format date/time columns. It has a method argument that takes values from a list of possible conversion methods: toDateString, toISOString, toLocaleDateString, toLocaleString, toLocaleTimeString, toString, toTimeString, toUTCString.
As of DataTables 1.10 you should be able to sort with currency http://datatables.net/reference/option/columns.type. In options it should suffice to give a type = 'num-fmt' to column index zero. This would correspond to columnDefs = list(list(targets = c(0), type = "num-fmt")) in `options.
The following should work but does not for me:
library(shiny)
server <- function(input, output) {
output$foo_table <- renderDataTable({
x <- seq(8000, 12000, by = 1000)
x <- scales::dollar(x)
d <- data.frame(x)
d
}
, options = list(
columnDefs = list(list(targets = c(0), type = "num-fmt"))
)
)
}
ui <- shinyUI(fluidPage(
mainPanel(dataTableOutput("foo_table"))
)
)
shinyApp(ui = ui, server = server)
Maybe #yihui can shed some light on the issue.
The mixedsort and mixedorder functions in package gtools can do that:
x <- seq(8000, 12000, by = 1000)
x <- scales::dollar(x)
d <- data.frame(x)
mixedsort(d$x) # not much of a test but also give same results with mixedsort(rev(d$x))
[1] $8,000 $9,000 $10,000 $11,000 $12,000
Levels: $10,000 $11,000 $12,000 $8,000 $9,000
Notice that your data.frame call created factors. You might not want that and if not should include stringsAsFactors=FALSE. I do not see any mention in the help page about commas and so you might want to apply a gsub("[,]", "", d$x) before the mixedsort.