How to hide digits from a rhandsontable element in Shiny - r

I understood that rhandsontable is based on the general handsontable JS libary itself using the numebro JS library.
However it seems that numebro does not allow to round the display in R of a figure in a hot table such as 13.4 to 13 and 13.6 to 14 (e.g. hidding digits, just in the display, not in the actual underlying data) which is a quite basic need and something DT can manage quite well. Is there a way to handle the hot display without modifying underlying data? I think this is the same question as this. Using the 'a' format is not a solution since for instance 1,154,521.5 will apear as 1.1m.
Below an example from jrowen's github official page:
DF = data.frame(int = 1:10, float = rnorm(10), cur = rnorm(10) * 1E5,
lrg = rnorm(10) * 1E8, pct = rnorm(10))
rhandsontable(DF, width = 550, height = 300) %>%
hot_col("float", format = "0.0") %>%
hot_col("cur", format = "$0,0.00") %>%
hot_col("lrg", format = "0a") %>%
hot_col("pct", format = "0%")
How to make the float 0.2 simply 0 until we edit the cell? Or the -13.18% simply -13%?

Related

keeping same height of row for DT table in output

I want to set the height of row constant or fixed for DT table output. for the table below you can see difference in height of rows.
so the scenario is when the number of character increases for eg second row in this case in first col then height should get adjust as same for all rows.
df <- data.frame(`quote` = c("the trader belongs to","trader have long ralationship withthe same market with my opinion on thaw its implemented mmnnhhh sdfghj fghj kjhgf tyui cvbnm",
"types of trads happens everytime when market slow","trades have leverage with",
"market is continious with the same platform trades"),
`share`= c(43,65,92,23,73),
`times` = c(86,98,55,12,08),
`parts`=c(4,7,4,8,3))
df<-datatable(df,
options = list(columnDefs =
list(list(className = 'dt-center',
targets = "_all"))),rownames = FALSE)
df
like in flextable i can do something like below but looking for fixed solution or any function for DT tables.
(ncols %in% c(4,5)) {
fl<-width(flxtable, width = d*0.3, j = 1)
fl<-width(flxtable, width = (d*0.7)/(ncols-1), j = 2:ncols)
d is left and right margin of docs template
I had success with this in the past:
DT::datatable(df) %>%
DT::formatStyle(names(df),lineHeight='80%')
Kudos to the post that helped me, however I fail to find it back now.

Additional tooltip information in highcharter stock

I am currently building an app and I want to have tooltips in a highcharter stock with additional information.
#Data
df <- data.frame(time = seq(as.Date("2021-03-10"), length = 10, by = "days"),
values = 1:10,
additionalInfo1 = LETTERS[1:10],
additionalInfo2 = letters[1:10])
#Packages
library(highcharter) #plots
library(xts) #conversion for stock-highchart
library(dplyr) #piping-operator
I know how to add additional information to a tooltip when using type="line". This can be done via
highchart_line <- hchart(df, "line", hcaes(x = time, y = values),
tooltip = list(headerFormat = "<b> Some Tooltipheader </b> <br/>",
pointFormat = paste0("index: {point.index} <br/>",
"time: {point.time} <br/>",
"additional1: {point.additionalInfo1} <br/>",
"additional2: {point.additionalInfo2}")))
and shows everything fine. The nice thing is that one can supply the whole data and hence has access to the columnnames.
When creating a type="stock", I need to convert the data to an xts while only using the times and the values:
stockdata_xts <- xts(x = df$values, order.by = df$time)
highchart_stock <- highchart(type="stock") %>%
hc_add_series(stockdata_xts, name = "someData",
tooltip = list(pointFormat = paste0(
"point.x: {point.x} <br/>",
"point.y: {point.y} <br/>",
"point.index: {point.index} <br/>"
))) %>%
hc_rangeSelector(enabled = FALSE)
Is there a way to put additional data for the tooltip in the stock-highchart such that the tooltip looks like the one in the linechart above? Maybe some functionality of the xts-object including more attributes for it which I don't know.
The reason why I want to use the stock-highchart is the navigator-bar. If there is a way to include the navigator-bar in the line-highchart, I would also be thankful. There is also a function highcharter::hc_navigator, but the documentation says that it is only applicable to highstocks. (see https://cloud.r-project.org/web/packages/highcharter/highcharter.pdf , page 50)
Yes, the navigator works in stockChart. For such tooltip customization, I think it will be best to use the dedicated formatter API function: https://api.highcharts.com/highstock/tooltip.formatter
Here you can find an article that can help you use JS code in R:
https://www.highcharts.com/blog/tutorials/working-with-highcharts-javascript-syntax-in-r/?fbclid=IwAR1Em2yNUsIJunTRS4IEbUwGksb5PC7LfZATLcyvb7uLS7ZvV7v4-e0L0

Dynamic Reporting in R

I am looking for a help to generate a 'rtf' report from R (dataframe).
I am trying output data with many columns into a 'rtf' file using following code
library(rtf)
inp.data <- cbind(ChickWeight,ChickWeight,ChickWeight)
outputFileName = "test.out"
rtf<-RTF(paste(".../",outputFileName,".rtf"), width=11,height=8.5,font.size=10,omi=c(.5,.5,.5,.5))
addTable(rtf,inp.data,row.names=F,NA.string="-",col.widths=rep(1,12),header.col.justify=rep("C",12))
done(rtf)
The problem I face is, some of the columns are getting hide (as you can see last 2 columns are getting hide). I am expecting these columns to print in next page (without reducing column width).
Can anyone suggest packages/techniques for this scenario?
Thanks
Six years later, there is finally a package that can do exactly what you wanted. It is called reporter (small "r", no "s"). It will wrap columns to the next page if they exceed the available content width.
library(reporter)
library(magrittr)
# Prepare sample data
inp.data <- cbind(ChickWeight,ChickWeight,ChickWeight)
# Make unique column names
nm <- c("weight", "Time", "Chick", "Diet")
nms <- paste0(nm, c(rep(1, 4), rep(2, 4), rep(3, 4)))
names(inp.data) <- nms
# Create table
tbl <- create_table(inp.data) %>%
column_defaults(width = 1, align = "center")
# Create report and add table to report
rpt <- create_report("test.rtf", output_type = "RTF", missing = "-") %>%
set_margins(left = .5, right = .5) %>%
add_content(tbl)
# Write the report
write_report(rpt)
Only thing is you need unique columns names. So I added a bit of code to do that.
If docx format can replace rtf format, use package ReporteRs.
library( ReporteRs )
inp.data <- cbind(ChickWeight,ChickWeight,ChickWeight)
doc = docx( )
# uncomment addSection blocks if you want to change page
# orientation to landscape
# doc = addSection(doc, landscape = TRUE )
doc = addFlexTable( doc, vanilla.table( inp.data ) )
# doc = addSection(doc, landscape = FALSE )
writeDoc( doc, file = "inp.data.docx" )

Map over data frame columns, apply function to data if column meets condition

I'm pulling data from the Google Analytics API, processing it locally, then knitting an .Rmd file into text, tables, and visualisations. As part of the knitting/tabling process, I'm doing some basic formatting (e.g. rounding off percentages and adding % signs).
For this question, I have toPercent(), which works fine if used like this:
toPercent <- function(percentData){
percentData <- round(data, 2)
percentData <- mapply(toString, percentData)
percentData <- paste(percentData, "%", sep="")
}
devices <- toPercent(devices$avgSessionDuration)
However, manually setting the function for every table is time-intensive. I created the percentCheck() to look for columns that matched my criteria:
percentCheck <- function(data){
data[,grep("rate|percent", names(data), ignore.case=TRUE)] <- toPercent(data[,grep("rate|percent", names(data), ignore.case=TRUE)])
}
devices <- percentCheck(devices)
But I know this doesn't work on a dataset with multiple matches (e.g. a column for exitRate and a column for bounceRate).
Q1: Have I written toPercent() in a way that won't return multiple values to one entry?
Q2: How can I structure percentCheck() to map over the dataset and only apply toPercent() if the column name includes a given string?
Version/Packages:
R version 3.1.1 (2014-07-10) -- "Sock it to Me"
library(rga)
library(knitr)
library(stargazer)
Data:
> dput(devices)
structure(list(deviceCategory = c("desktop", "mobile", "tablet"
), sessions = c(817, 38, 1540), avgSessionDuration = c(153.424888853179,
101.942758538617, 110.270988142292), bounceRate = c(39.0192297391397,
50.2915625371891, 50.1343873517787), exitRate = c(25.3257456030279,
32.0236280487805, 29.0991902834008)), .Names = c("deviceCategory",
"sessions", "avgSessionDuration", "bounceRate", "exitRate"), row.names = c(NA,
-3L), class = "data.frame")
How about this modification:
percentCheck <- function(data){
idx <- grepl("rate|percent", names(data), ignore.case=TRUE)
data[idx] <- lapply(data[idx], function(x) paste0(sprintf("%.2f", round(x,2)), "%"))
return(data)
}
Here, I first used grepl to create and index of columns which meet the specified criteria. Then, this index is used in lapply to apply it to all these columns and the function that is applied is similar to your toPercent function, only I found it a bit more compact like this.
Now you can apply it to your whole data set in one go:
percentCheck(devices)
# deviceCategory sessions avgSessionDuration bounceRate exitRate
#1 desktop 817 153.4249 39.02% 25.33%
#2 mobile 38 101.9428 50.29% 32.02%
#3 tablet 1540 110.2710 50.13% 29.10%

Produce pretty table for print that shows which point estimates differ significantly using R

I want to create a table of point estimates from a sample for print in the following format
variable group1 group2 group3 etc
age 18.2 18.5 23.2
weight 125.4 130.1 117.1
etc
I also have confidence intervals for each point estimate, but displaying them will cause too much clutter. Instead, I'd like to use text attributes (italics, bold, underline, font) to signal which point estimates in a row differ significantly. So, in the first row, if 23.2 differed significantly from the other two, it would be displayed in bold (for example). I'm not sure if such a display would appear bewildering, but I'd like to try.
Could anyone suggest a table formatting library in R that would allow me to accomplish this? Perhaps one that allows me to supply text attributes in the data table for each point estimate?
Another solution could be to use ReporteRs package using FlexTable API and send the object to a docx document :
library( ReporteRs )
data = iris[45:55, ]
MyFTable = FlexTable( data = data )
MyFTable[data$Petal.Length < 3, "Species"] = textProperties( color="red"
, font.style="italic")
MyFTable[data$Sepal.Length < 5, 1:4] = cellProperties( background.color="#999999")
MyFTable[ , 1:4] = parProperties( text.align="right" )
doc.filename = "test.docx"
doc = docx( )
doc = addFlexTable( doc, MyFTable )
writeDoc( doc, file = doc.filename )
I believe you can do something like this with the xtable() package - if you have xtable output your table, you can use knitr/pandoc to convert it to word, HTML, etc. or you can just paste the LaTeX output into a document and compile it.
Here's a demo:
library(xtable)
# original data frame
df <- data.frame(var=c("age", "weight", "etc"), group1=c("18.2", "125.4", "3"), group2=c("18.5", "130.1", "3"), group3=c("23.2", "117.1", "3"), etc=c("1", "2", "3"))
# data frame in similar format indicating significance
significant <- data.frame(var=c("age", "weight", "etc"), group1=c(F, T, F), group2=c(T, F, T), group3=c(F, T, F))
library(reshape2)
# transform everything into long form to apply text formatting
df.melt <- melt(df, id.vars = 1, variable.name="group", value.name="value")
sig.melt <- melt(significant, id.vars=1, variable.name = "group", value.name="sig")
# merge datasets together
tmp <- merge(df.melt, sig.melt)
tmp$ans <- tmp$value
# apply text formatting using LaTeX functions
tmp$ans[tmp$sig] <- paste0("\\textit{", tmp$ans, "}")[tmp$sig]
# transform dataset back to "wide form" for table output
df2 <- dcast(tmp, var~group, value.var="ans")
# output table in LaTeX format
print(xtable(df2), include.rownames=FALSE, sanitize.text.function=identity)
A qucik demo based on the OP-mentioned pander package:
Load it:
library(pander)
Create some dummy data, which I will import from the rapport package this time:
df <- rapport::ius2008
Compute a basic cross table:
t <- table(df$dwell, df$net.pay)
Identify those cells with high standardized residuals and emphasize those:
emphasize.cells(which(abs(chisq.test(t)$stdres) > 2, arr.ind = TRUE))
Do not split the markdown table:
panderOptions('table.split.table', Inf)
Print the markdown table:
pander(t)
Resulting in:
----------------------------------------------------------------------------
parents school/faculty employer self-funded other
---------------- --------- ---------------- ---------- ------------- -------
**city** 276 14 26 229 *20*
**small town** 14 1 1 11 *4*
**village** 13 1 0 13 2
----------------------------------------------------------------------------

Resources