Raw Message

Message-ID: <7876cd2d-2855-fee4-2839-2821361fa85d@syonic.eu>
Date: 2021-09-14T17:18:47Z
From: Leonard Mada
Subject: [R Code] Split long names in format.ftable

Dear List members,


I wrote some code to split long names in format.ftable. I hope it will 
be useful to others as well.


Ideally, this code should be implemented natively in R. I will provide 
in the 2nd part of the mail a concept how to actually implement the code 
in R. This may be interesting to R-devel as well.


### Helper function

# Split the actual names

split.names = function(names, extend=0, justify="Right", blank.rm=FALSE, 
split.ch = "\n", detailed=TRUE) {
 ??? justify = if(is.null(justify)) 0 else pmatch(justify, c("Left", 
"Right"));
 ??? str = strsplit(names, split.ch);
 ??? if(blank.rm) str = lapply(str, function(s) s[nchar(s) > 0]);
 ??? nr? = max(sapply(str, function(s) length(s)));
 ??? nch = lapply(str, function(s) max(nchar(s)));
 ??? chf = function(nch) paste0(rep(" ", nch), collapse="");
 ??? ch0 = sapply(nch, chf);
 ??? mx? = matrix(rep(ch0, each=nr), nrow=nr, ncol=length(names));
 ??? for(nc in seq(length(names))) {
 ??? ??? n = length(str[[nc]]);
 ??? ??? # Justifying
 ??? ??? s = sapply(seq(n), function(nr) paste0(rep(" ", nch[[nc]] - 
nchar(str[[nc]][nr])), collapse=""));
 ??? ??? s = if(justify == 2) paste0(s, str[[nc]]) else 
paste0(str[[nc]], s);
 ??? ??? mx[seq(nr + 1 - length(str[[nc]]), nr) , nc] = s;
 ??? }
 ??? if(extend > 0) {
 ??? ??? mx = cbind(mx, matrix("", nr=nr, ncol=extend));
 ??? }
 ??? if(detailed) attr(mx, "nchar") = unlist(nch);
 ??? return(mx);
}

### ftable with name splitting
# - this code should be ideally integrated inside format.ftable;
ftable2 = function(ftbl, print=TRUE, quote=FALSE, ...) {
 ??? ftbl2 = format(ftbl, quote=quote, ...);
 ??? row.vars = names(attr(ftbl, "row.vars"))
 ??? nr = length(row.vars);
 ??? nms = split.names(row.vars, extend = ncol(ftbl2) - nr);
 ??? ftbl2 = rbind(ftbl2[1,], nms, ftbl2[-c(1,2),]);
 ??? # TODO: update width of factor labels;
 ??? # - new width available in attr(nms, "nchar");
 ??? if(print) {
 ??? ??? cat(t(ftbl2), sep = c(rep(" ", ncol(ftbl2) - 1), "\n"))
 ??? }
 ??? invisible(ftbl2);
}

I have uploaded this code also on Github:

https://github.com/discoleo/R/blob/master/Stat/Tools.Data.R


B.) Detailed Concept
# - I am ignoring any variants;
# - the splitting is actually done in format.ftable;
# - we set only an attribute in ftable;
ftable = function(..., split.ch="\n") {
 ?? [...]
 ?? attr(ftbl, "split.ch") = split.ch; # set an attribute "split.ch"
 ?? return(ftbl);
}

format.ftable(ftbl, ..., split.ch) {
if(is.missing(split.ch)) {
 ?? # check if the split.ch attribute is set and use it;
} else {
 ?? # use the explicitly provided split.ch: if( ! is.null(split.ch))
}
 ?? [...]
}


C.) split.names Function

This function may be useful in other locations as well, particularly to 
split names/labels used in axes and legends in various plots. But I do 
not have much knowledge of the graphics engine in R.


Sincerely,


Leonard