I have below code:
t_af_ts_outcomes <- datatable( data = cars
, options = list( bFilter = 0
, bLengthChange = 0
, paging = F
, info = F
)
)
output$v_af_ts_outcomes <- renderDataTable( t_af_ts_outcomes )
And it gives below output:
Is there anyway I can remove the row numbers?
Set argument rownames = FALSE inside datatable() function.
Related
I am trying to add sparklines to multiple columns of a Data Table in R. I am able to get a single Sparkline column to render correctly, but when I try to render a sparkline in a second column based on different underlying data than the first, the same sparkline is displayed in the second column. I imagine there is some snippet of code needed in the fnDrawCalback option, but I have not been able to find much out there addressing my issue.
Here is a reproducible example for both a single sparkline (works) and a two sparklines (just repeats the first sparkline in both columns)
# create data with single sparkline column
library(sparkline)
library(DT)
spark_data <- data.frame(
id = c('spark1', 'spark2'),
spark = c(
spk_chr(values = 1:3, elementId = 'spark1'),
spk_chr(values = 3:1, elementId = 'spark2')
)
)
tbl <- datatable(spark_data, escape = F,
rownames = F
, options = list(fnDrawCallback = htmlwidgets::JS('function(){
HTMLWidgets.staticRender();
}'))
)
spk_add_deps(tbl)
# create data with two sparkline columns
library(sparkline)
library(DT)
spark_data <- data.frame(
id = c('spark1', 'spark2'),
spark = c(
spk_chr(values = 1:3, elementId = 'spark1'),
spk_chr(values = 3:1, elementId = 'spark2')
),
second_spark = c(spk_chr(values = 3:1, elementId = 'spark1'),
spk_chr(values = 1:3, elementId = 'spark2'))
)
tbl <- datatable(spark_data, escape = F,
rownames = F
, options = list(fnDrawCallback = htmlwidgets::JS('function(){
HTMLWidgets.staticRender();
}'))
)
spk_add_deps(tbl)
I am trying to create a function for DT table where just specifying the columns name in the parameter, the column should get hidden
dt_table <- function(data,
colhidden = c(a)){
datatable(data,
options = list(
columnDefs = list(
list(visible=FALSE, targets=colhidden)
)
))
}
dt_table(iris,colhidden = c('Species'))
But unfortunately, the column is not getting hidden. Can anyone help me?
targets needs the column number which you can get with match. Try -
library(DT)
dt_table <- function(data, colhidden) {
datatable(data,
options = list(
columnDefs = list(
list(visible=FALSE, targets=match(colhidden, colnames(data))))
)
)
}
dt_table(iris,colhidden = c('Species'))
dt_table(iris,colhidden = c('Species', 'Sepal.Length'))
I'm dealing with json and have found using lists to be great so that I can use Map and whatnot. It's a more declarative approach, but I can't find a nice solution to optionally add a list element.
The nested list (ie "list(list(...))") style is necessary for creating the json that the api requires.
library(jsonlite)
# optionally add mydoc
mydoc <- NULL # mydoc <- 1
jelist <- list(
JournalEntry = list(
list(
trxdate = '2019-01-01',
docnum = mydoc,
line = list(
# 2 lines for 1 dr and 1 cr
list(
debitcredit = 'debit',
accountref = 1
),
list(
debitcredit = 'credit',
accountref = 2
)
)
)
)
)
# it's added when I don't want it
toJSON(jelist,pretty = T,auto_unbox = T)
I can take it out afterward, but I'd like it to be a declarative approach instead of procedural. What if I want to embed it in a Map, or there's 50 to grok, remember, and maintain?
jelist$JournalEntry[[1]]$docnum <- NULL
# correct output
toJSON(jelist,pretty = T,auto_unbox = T)
quick simplify for the rest of the examples
Keeping this in might prevent false positive solutions that can handle simple lists but not nested lists.
linelist <- list(
# 2 lines for 1 dr and 1 cr
list(
debitcredit = 'debit',
accountref = 1
),
list(
debitcredit = 'credit',
accountref = 2
)
)
things I've tried
set as null, NA, logical(0)
jelist <- list(
JournalEntry = list(
list(
trxdate = '2019-01-01',
docnum = NULL, # or NA or logical(0)
line = linelist
)
)
)
toJSON(jelist,pretty = T,auto_unbox = T)
if stmt
jelist <- list(
JournalEntry = list(
list(
trxdate = '2019-01-01',
if(is.null(mydoc)){}else{docnum = mydoc}),
line = linelist
)
)
toJSON(jelist,pretty = T,auto_unbox = T)
Filter
I'd like the option to just declare it inline anyway if I want it removed or not. What if I actually do want to send a NULL as an update?
jelist <- list(
JournalEntry = list(
list(
trxdate = '2019-01-01',
docnum = mydoc,
line = linelist
)
)
)
toJSON(Filter(Negate(is.null),jelist),pretty = T,auto_unbox = T)
messing with c, list, etc.
jelist <- list(
JournalEntry = list(
list(
trxdate = '2019-01-01',
as.list(c(docnum = NULL)),
line = linelist
)
)
)
toJSON(jelist,pretty = T,auto_unbox = T)
I tried unlist/relist, but I'm not too familiar with using those. Again, hoping I can have it optional inline.
Tried changing lists around to using c() and as.list() with some promising things but not success. Somehow c() renames my 2 Lines with Line1 and Line2.
Any other ideas?
plyr::compact will remove NULL from lists. By default, it operates on an already-constructed list. To be able to use it declaratively, you need to lift its domain from list to dots.
mylist <- purrr::lift_ld( plyr::compact )
## For example,
mylist( a=1, b=NULL, c=3 )
# $a
# [1] 1
#
# $c
# [1] 3
Now simply replace every call to list() with a call to the newly defined mylist:
jelist <- mylist(
JournalEntry = mylist(
mylist(
trxdate = '2019-01-01',
docnum = mydoc,
line = mylist(
# 2 lines for 1 dr and 1 cr
mylist(
debitcredit = 'debit',
accountref = 1
),
mylist(
debitcredit = 'credit',
accountref = 2
)
)
)
)
)
toJSON(jelist, pretty = TRUE, auto_unbox = TRUE) ## Works as desired
I am trying to select the cell in the DataTable and show the corresponding position/value.
But it seems not working... I ran the code from the example cell code from Yihui but still showing the same error as I got from my code:
Warning: Error in match.arg: 'arg' must be NULL or a character vector
Stack trace (innermost first):
76: match.arg
75: datatable
74: widgetFunc
73: func
72: renderFunc
71: output$x16
4:
3: do.call
2: print.shiny.appobj
1:
Below are part of my code.
biTableMatrix function - It assign the values to a certain position in the matrix/df by the xpos (row) and ypos (column). Firstly it returned a matrix, but I thought the error might be caused by the object type (matrix instead of data.frame from the example), so I convert it to data.frame - not much help thou...
# The following are in helper.R
travelMeans <- c('02', '04')
prepareTwoMeans <- function(travelMeans) {
listx <- subset(geodata[geodata$MeanCode==travelMeans[1],], select = -c( AreaFull,MeanName,MeanFull))
listx <- listx[order(listx$Percentage),]
listy <- subset(geodata[geodata$MeanCode==travelMeans[2],], select = -c( AreaFull,MeanName,MeanFull,AreaCode))
listy <- listy[order(listy$Percentage),]
listx$xpos <- seq(length=nrow(listx))
listy$ypos <- seq(length=nrow(listy))
listx <- merge(listx, listy, by.x = c("AreaName"), by.y = c("AreaName"), all=TRUE)
return(listx)
}
# This function generates the two-way table of two travel means
biTableMatrix <- function(travelMeans) {
fullList <- prepareTwoMeans(travelMeans)
len <- length(fullList$AreaName)
biTableMat <- matrix(data = "", nrow = len, ncol = len, dimnames = list(seq(length = len), seq(length = len)))#,
for (n in 1:len) {
x <- fullList$xpos[n]
y <- fullList$ypos[n]
biTableMat[x,y] <- as.character(fullList$AreaName[n]) #fullList$AreaCode[n]
}
return(as.data.frame(biTableMat) )
}
# The following are in server.R
biTable <- reactive({
return(biTableMatrix(input$travelMeans))
})
output$biTable <- DT::renderDataTable({
DT::datatable(
biTable()
, selection = list(mode = "single", target = "cell")
, extensions = list("Scroller", "RowReorder")
, options = list(
scrollX = 500
, scrollY = 700
, rowReorder = FALSE
)
)}
, options = list(
searchHighlight = TRUE
)
)
output$biTableText <- renderPrint(input$biTable_cells_selected$value)
For reference, here is my ui.R
#Definte UI for the application
ui <- fluidPage(
sidebarPanel(
# The following part is groupCheckBox format for the travelMeans
checkboxGroupInput(
"travelMeans"
, label = "Select the mean below:"
, choices = meanChoices
, selected = NULL
)
, br()
),
#Show the map
mainPanel(
tabsetPanel(#type = "tabs",
tabPanel("Single-Mean Table", DT::dataTableOutput("onetable"), hr())
, tabPanel("Two-way table", DT::dataTableOutput("biTable"), hr(), verbatimTextOutput("biTableText"))
)
, position="center"
, height= "auto"
)
)
Any help would be much appreciated!!
Thanks!!
devtools::install_github('rstudio/DT')
Do not use the cran DT.
How do I define number format for datatable in Shiny? I would like to display 2 decimal digits only for some columns, but do not understand where it should be defined in my application. In server.R or ui.R? In server.R, this what I have in renderDataTable:
output$woeTable <- renderDataTable({
input$tryTree
input$threshold
# The following returns data frame with numeric columns
get(input$dfDescr)[['variables']][[input$columns]][['woe']]
},
options=list(
paging = FALSE,
searching = FALSE)
)
How do I format 2nd and 3rd column to display only two decimal digits?
just use round command:
output$woeTable <- renderDataTable({
input$tryTree
input$threshold
# The following returns data frame with numeric columns
A = get(input$dfDescr)[['variables']][[input$columns]][['woe']]
A[,2] = round(x = A[,2],digits = 2)
A[,3] = round(x = A[,3],digits = 2)
A
},
options=list(
paging = FALSE,
searching = FALSE)
)
you can also use fnRowCallback option in renderDataTable function if you insist to keep data with more digit and just change representation in output:
output$woeTable <- renderDataTable({
input$tryTree
input$threshold
# The following returns data frame with numeric columns
get(input$dfDescr)[['variables']][[input$columns]][['woe']]
},
options=list(
paging = FALSE,
searching = FALSE,
fnRowCallback = I("function( nRow, aData, iDisplayIndex, iDisplayIndexFull ) {ind = 2; $('td:eq('+ind+')', nRow).html( (aData[ind]).toFixed(2) );}"))
)
update for DT 1.1:
you should change
fnRowCallback = I("function( nRow, aData, iDisplayIndex, iDisplayIndexFull ) {ind = 2; $('td:eq('+ind+')', nRow).html( (aData[ind]).toFixed(2) );}"))
to
rowCallback = I("function( nRow, aData) {ind = 2; $('td:eq('+ind+')', nRow).html( parseFloat(aData[ind]).toFixed(2) );}"))