Nothing
R/rbsa1.code.r
In rbsa: Ancillary Functions for R Programming
Defines functions
form3join
form3split
form3justify
form3repeat
form3frame
form3crop
form3indent
form3names
form3numbering
form3line
form3title
form3parag
form3display
name8list
Documented in
form3crop
form3display
form3frame
form3indent
form3join
form3justify
form3line
form3names
form3numbering
form3parag
form3repeat
form3split
form3title
name8list
####### rbsa1.code.r ########################
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3join <- function(vcara,none="-",
OPA="{",CPA="}",
opa="(",cpa=")",sep="+",
imp=FALSE,cr=imp)
#TITLE formats a series of names or a similar list
#DESCRIPTION returns a scalar character of the components
# of a \samp{character} surrounded by any kind of parenthesis
# (each and the whole)
# separated with the same separator.\cr
# Easy to undestand when applying the examples.
#DETAILS
#KEYWORDS print format
#INPUTS
#{vcara}<<Character vector to be considered.>>
#[INPUTS]
#{none}<< The internal result when \samp{vcara} is length zero.
# When it is \samp{character(0)} then the
# global parenthesis are not given contrary
# when it is \samp{""}.>>
#{OPA}<< The opening parenthesis to surround the entire list.>>
#{CPA}<< The closing parenthesis to surround the entire list.>>
#{opa}<< The opening parenthesis to surround each component.>>
#{cpa}<< The closing parenthesis to surround each component.>>
#{sep}<< The symbol to separate each component.>>
#{imp}<< Must the result be printed (with cat) or returned?>>
#{cr}<< Must a line feed be added at the end?>>
#VALUE
# A character string or nothing when imp is TRUE
#EXAMPLE
# form3join(letters[1:4])
# form3join(NULL);
# form3join(NULL,NULL);
# form3join(NULL,character(0));
# form3join(NULL,"");
#REFERENCE
#SEE ALSO form3split
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_06_25
#REVISED 08_10_30
#--------------------------------------------
{
vcara <- as.character(vcara);
vide <- (length(vcara) == 0);
if (length(vcara) == 1) { if (vcara == "") {
vide <- TRUE;
}}
if (vide) {
res <- none;
if (length(none)==0) {
OPA <- CPA <- "";
}
} else {
for (hd in bf(vcara)) {
hdc <- paste0(opa,vcara[hd],cpa);
if (hd == 1) { res <- hdc;
} else { res <- paste0(res,sep,hdc);}
}
}
res <- paste0(OPA,res,CPA);
if (cr) { res <- paste0(res,"\n");}
if(!imp) { return(res);}
cat(res);
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3split <- function(cara,none="-.-",
OPA="{",CPA="}",
opa="(",cpa=")",sep="+",
monitor=rbsa0$monitor$v)
#TITLE inverse function of form3join
#DESCRIPTION returns a vector character of the names
# from a character string generated by \samp{form3join}.
#DETAILS
# Of course, it is implicitely supposed that the
# inversion is unambiguous.\cr
# The syntax (consistent use of the parentheses and
# separators) is checked: an error is issued when
# not correct. The possible \samp{\\n} added by \samp{form3join}
# is taken into account and removed.
# For the moment, sep cannot be an empty string.
#KEYWORDS print format
#INPUTS
#{cara}<<Character to be considered.>>
#[INPUTS]
#{none}<< idem as in form3join.>>
#{OPA}<< idem as in form3join.>>
#{CPA}<< idem as in form3join.>>
#{opa}<< idem as in form3join.>>
#{cpa}<< idem as in form3join.>>
#{sep}<< idem as in form3join.>>
#{monitor} << List of monitoring constants, see \samp{rbsa0$monitor$v} to
# know its structure.>>
#VALUE
# A character vector
#EXAMPLE
# uu <- form3join(letters[1:4]);
# form3split(uu);
#REFERENCE
#SEE ALSO form3join
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_10_30
#REVISED 08_10_30
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(cara,"character",1);
}
# removing the possible "\n"
nl <- nchar(cara);
if (nl > 2) {
fin <- substr(cara,nl,nl);
if (fin=="\n") { cara <- substr(cara,1,nl-1);}
}
# removing the external braces
n1 <- nchar(OPA); n2 <- nchar(CPA);
if (n1 > 0) {
ax <- substr(cara,1,n1);
if (ax!=OPA) {
erreur(c(OPA,ax),"Non consistent OPA and cara arguments.");
}
cara <- substr(cara,1+n1,nchar(cara));
}
if (n2 > 0) {
nn <- nchar(cara);
ax <- substr(cara,nn-n2+1,nn);
if (ax!=CPA) {
erreur(c(CPA,ax),"Non consistent OPA and cara arguments.");
}
cara <- substr(cara,1,nn-n2);
}
# removing the separator and constituting the vector
if (cara==none) { res <- character(0);
} else {
# splitting
if (nchar(sep)==0) {
erreur(cara,"Sorry by the function does not act properly for empty separators");
}
res <- strsplit(cara,sep,fixed=TRUE)[[1]];
# removing the internal braces
n1 <- nchar(opa); n2 <- nchar(cpa);
for (hd in bf(res)) {
rr <- res[hd];
if (n1 > 0) {
ax <- substr(rr,1,n1);
if (ax!=opa) {
erreur(c(opa,ax),"Non consistent opa and cara arguments.");
}
rr <- substr(rr,1+n1,nchar(rr));
}
if (n2 > 0) {
nn <- nchar(rr);
ax <- substr(rr,nn-n2+1,nn);
if (ax!=cpa) {
erreur(c(cpa,ax),"Non consistent cpa and cara arguments.");
}
rr <- substr(rr,1,nn-n2);
}
res[hd] <- rr;
}
}
# returning
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3justify <- function(chaine,
nbc=8,
format=3,
tronc=TRUE,
carac=" ",
monitor=rbsa0$monitor$v)
#TITLE formats a character string
#DESCRIPTION
# Formats character string(s).
# The main use of this function is to produce
# aligned columns lists while not printing
# them at the same time.
#DETAILS
# The justification is made component by component,
# no concatenation between them is done.
#KEYWORDS print
#INPUTS
#{chaine}<<the character string to be printed, can be a vector.>>
#[INPUTS]
#{nbc} << Desired number of characters for the result; when
# \samp{chain} is a vector can be a vector of the same length>>
#{format} << Indicates the type of alignment:\cr
# 0 no aligment (no supplementary character added to reach \samp{nbc})\cr
# 1 to the left side\cr
# 2 centered\cr
# 3 to the right side>>
#{tronc} << If true, no more than
# \samp{nbc} characters are returned and
# possibly the string is truncated. In that
# case, \samp{$} is introduced to indicate the fact.>>
#{carac} << Character to use for enlarging the string>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE a character string
#EXAMPLE
# form3justify("vers")
# form3justify("versification",5)
# form3justify(letters[1:5],format=2,carac="+");
#REFERENCE
#SEE ALSO text3preparation
#CALLING
#COMMENT
#FUTURE Improve the behavior when \samp{nchar(carac)>1}.
#AUTHOR J.-B. Denis
#CREATED 1999_05_25
#REVISED 14_08_27
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(chaine,c("character","numeric"),-1);
object9(nbc,"integer",c(1,Inf));
}
# the null case
if (length(chaine)==0) { return(character(0));}
# preparing
nbc[nbc < 1] <- 8;
if (length(nbc) < length(chaine)) {
nnbc <- rep(nbc,length(chaine));
} else {
nnbc <- nbc;
}
#
itr <- "$"; # truncation indicator
rres <- cchaine <- chaine;
for (rr in bf(rres)) {
res <- rres[rr];
nbc <- nnbc[rr];
chaine <- cchaine[rr];
# truncation
if ( (nchar(res) > nbc) & tronc ) {
if (format <= 1) {
res <- substring(chaine,1,nbc-1);
res <- paste0(res,itr);
}
else {
if (format == 2) {
otg <- (nchar(chaine) - nbc) %/% 2;
res <- substring(chaine,1+otg);
res <- substring(res,1,nbc-2);
res <- paste0(itr,res,itr);
}
else {
res <- substring(chaine,1+nchar(chaine)-nbc+1,
nchar(chaine));
res <- paste0(itr,res);
}
}
}
if ((nchar(res) < nbc) & (format != 0)) {
if (format == 1) {
while (nchar(res) < nbc) res <-
paste(res,"",collapse="",sep=carac);
}
else {
if (format == 2) {
raj <- (nbc - nchar(res)) %/% 2;
if (raj > 0) {
for (jbd in 1:raj) res <-
paste(res,"",collapse="",sep=carac);
}
while (nchar(res) < nbc) {
res <- paste("",res,collapse="",sep=carac);
}
}
else {
while (nchar(res) < nbc) {
res <- paste("",res,collapse="",sep=carac);
}
}
}
}
rres[rr] <- res;
}
# returning
rres;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3repeat <- function(cha="-",nb=10,imp=FALSE,cr=imp)
#TITLE prints a repeated given string
#DESCRIPTION
# Component by component, prints the concatenation
# of the given string(s) repeated \samp{nb} times.
#DETAILS
#KEYWORDS print
#INPUTS
#[INPUTS]
#{cha} << The string to repeat>>
#{nb} << Number of repetitions>>
#{imp} << Printing when TRUE or returning (default)>>
#{cr} << Must a line feed be added?>>
#VALUE
# character string or printing according to \samp{imp}
#EXAMPLE
# form3repeat('-+',20,TRUE)
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_09_24
#REVISED 08_09_25
#--------------------------------------------
{
nb <- max(0,round(nb));
res <- "";
for (jbd in bc(nb)) { res <- paste0(res,cha);}
if (cr) { res <- paste0(res,"\n");}
if(!imp) { return(res);}
cat(res);
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3frame <- function(chaine,bef="(*)_",aft="",imp=FALSE,cr=imp,
monitor=rbsa0$monitor$v)
#TITLE surrounds a character string
#DESCRIPTION
# Adds _bef_ore and _aft_er some characters to a character string
# (the same for all components when it is a vector).
#DETAILS
#KEYWORDS print
#INPUTS
#{chaine} <<The character string to frame; can be a vector.>>
#[INPUTS]
#{bef} << What to add at the beginning.>>
#{aft} << What to add at the end.>>
#{imp} << Printing when TRUE if not returning>>
#{cr} << Must a line feed be added?>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# character string or printing according to \samp{imp}.
#EXAMPLE
# form3frame('IMPORTANT','<<< ',' >>>');
# form3frame('IMPORTANT','<<< ',' >>>',imp=TRUE);
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_08_21
#REVISED 10_06_16
#--------------------------------------------
{
if (monitor$chk$v) {
object9(chaine,"character",-1,mensaje="form3frame: 'chaine' must be a character");
object9(bef,"character",1,mensaje="form3frame: 'bef' must be a character(1)");
object9(aft,"character",1,mensaje="form3frame: 'aft' must be a character(1)");
object9(imp,"logical",1,mensaje="form3frame: 'imp' must be a logical(1)");
object9( cr,"logical",1,mensaje="form3frame: 'cr' must be a logical(1)");
}
if (length(chaine)>0) {
res <- paste0(bef,chaine,aft);
if (cr) { res <- paste0(res,"\n");}
} else { res <- character(0);}
if(!imp) { return(res);}
else {cat(res);}
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3crop <- function(chaine,bef=rbsa0$sep0$v,aft=bef,
mxm=Inf,empty=FALSE,
monitor=rbsa0$monitor$v)
#TITLE removes framing characters from a character string
#DESCRIPTION
# removes \samp{bef}s before and \samp{aft}s after a character string.
#DETAILS
#KEYWORDS utilities
#INPUTS
#{chaine} <<The character string to refine.
# Can be a vector.>>
#[INPUTS]
#{bef} << What to repeatedly remove at the beginning.>>
#{aft} << What to repeatedly remove at the end.>>
#{mxm} << Maximum number of tags to remove.>>
#{empty} << Must remaining empty lines be removed?>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# \samp{character} after removings
#EXAMPLE
# form3crop('IMPORTANT','IM',' ANT');
# form3crop(c(' OUF ',' FOU ',''),' ','',1);
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_12_10
#REVISED 14_01_22
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(chaine,"character",-1,mensaje="form3crop: 'chaine' must be a character");
object9(bef,"character",1,mensaje="form3crop: Vector are not accepted for 'bef'");
object9(aft,"character",1,mensaje="form3crop: Vector are not accepted for 'aft'");
object9(mxm,"numeric",1,mensaje="form3crop: mxm must be numeric(1)");
}
# null case
if (length(chaine) == 0) { return(chaine);}
lb <- nchar(bef);
la <- nchar(aft);
for (ich in bf(chaine)) {
cha <- chaine[ich];
# removing at the beginning of the string
if (lb>0) {
nbr <- 0;
repeat {
deb <- substr(cha,1,lb);
if ((deb == bef) & (nbr < mxm)) {
cha <- substring(cha,lb+1);
nbr <- nbr+1;
} else { break;}
}
}
# removing at the end of the string
if (la>0) {
nbr <- 0;
repeat {
lc <- nchar(cha);
fin <- substr(cha,lc-la+1,lc);
if ((fin == aft) & (nbr < mxm)) {
cha <- substring(cha,1,lc-la);
nbr <- nbr+1;
} else { break;}
}
}
chaine[ich] <- cha;
}
# removing empty lines
if (empty) {
nbli <- length(chaine);
for (ii in rev(bc(nbli))) {
if (chaine[ii] == "") { chaine <- chaine[-ii];}
}
}
# returning
chaine;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3indent <- function(niv=1,cr=1,ele=" ",monitor=rbsa0$monitor$v)
#TITLE provides indentation of different levels
#DESCRIPTION
# returns a character to be used as indentation.
# The level of indentation is given by \samp{niv*monitor$ind$v} times
# the character \samp{ele}. New lines can be added first.
#DETAILS
#KEYWORDS print
#INPUTS
#[INPUTS]
#{niv} << Level of indentation.>>
#{cr} << Number of previous feed lines to first provide?>>
#{ele} << String to repeat.>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# a scalar string
#EXAMPLE
# cat(form3indent(2),"Bien `a vous","\n");
# cat(form3indent(3),cr=3,"Bien `a vous","\n");
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_09_10
#REVISED 14_08_05
#--------------------------------------------
{
niv <- round(max(min(8,niv),0));
res <- "";
for (ii in bc(cr)) { res <- paste0(res,"\n");}
res <- paste0(res,form3repeat(ele,niv*monitor$ind$v));
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3names <- function(nbn,nom=character(0),prefix="",
upca=TRUE,nume=14,
monitor=rbsa0$monitor$v)
#TITLE provides systematic names for items
#DESCRIPTION
# Provides systematic names for a series of items according to their
# number and taking care of previous names.
#DETAILS
#KEYWORDS utilities
#INPUTS
#{nbn} <<Number of new item names to generate>>
#[INPUTS]
#{nom} << Already present names (to avoid identical names).>>
#{prefix} << Systematic prefix of all names to generate. Must
# comprise the dot, if one wants such a separator
# between it and the specific part of the name.
# Of course can be 'underscore' or whatever else.>>
#{upca} << Indicates whether the letters constituting the new
# names must be uppercase or not.>>
#{nume} << Its absolute value gives the number of the letter to use
# when the alphabet is not sufficient. When negative, alphabet
# is not considered as a first possibility. For instance 2 will
# indicate "B" and the default is "N". When 0, no letter is considered.>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# vector with \samp{nbn} different strings associated to new names
#EXAMPLE
# form3names(2);
# form3names(2,nume=-3);
# form3names(2,prefix="rbsa.");
# form3names(2,upca=FALSE);
# form3names(5,"D");
# form3names(5,"Y");
# form3names(30);
#REFERENCE
#SEE ALSO form3numbering
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_10_19
#REVISED 10_02_15
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(upca,"logical",1,mensaje="Argument 'upca' not accepted");
object9(nume,"integer",1,mensaje="Argument 'nume' not accepted");
if (abs(nume)>26) {
erreur(nume,"'nume' must be comprised between -26 and 26 to indicate a Letter");
}
}
#
if (upca) { Letters <- LETTERS;
} else { Letters <- letters;}
#
if (void9(nbn)) { return(character(0));}
if (nbn < 1) { return(character(0));
} else {
if (prefix != "") {
# keeping only the names having got the prefix then
# removing the prefixes from them (to be added further)
decom <- sapply(strsplit(nom,prefix),function(ll){length(ll);});
nom <- nom[decom == 2];
nom <- sapply(strsplit(nom,prefix),function(ll){ll[2];});
}
# looking for the maximum letter in noms
if ( length(nom) == 0 ) { mama <- 0;
} else { mama <- max(1*outer(nom,Letters,"==") %*% matrix(1:26,ncol=1));}
if ((nbn < (27-mama)) & (nume>=0)) {
# adding letters
res <- Letters[mama+(1:nbn)];
} else {
# adding numbered nodes
ajou <- 0; nu <- 1; res <- character(0);
if (nume==0) { malettre <- "";}
else { malettre <- Letters[abs(nume)];}
while ( ajou < nbn ) {
nono <- paste0(malettre,nu);
if (all(nono != nom)) {
ajou <- ajou + 1;
res <- c(res,nono);
}
nu <- nu+1;
}
}
}
# adding the prefix
res <- paste0(prefix,res);
# returning
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3numbering <- function(nbn,type="n",bef="-",aft="-",
start=1+(type=="n"),
monitor=rbsa0$monitor$v)
#TITLE provides a systematic numbering of items
#DESCRIPTION
# Provides systematic names for a series of items according their
# number giving them an identical number of characters.
#DETAILS
# Alphabetical series are "aa","ab",...,"az","ba",... Then starting
# from the second element means to start from "ab". It is not possible
# to start from the 0th element.\cr
# Numerical series are "00","01","02",...,"09","10",... Then one
# can start from the zeroth element which is "00" but starting from
# the second element means starting from "01". This inconsistency
# may look not desirable, but it allows to follow the natural
# reasoning when working in any of the two logics.
#KEYWORDS utilities
#INPUTS
#{nbn} <<Number of item names to generate from \samp{start}.>>
#[INPUTS]
#{type} << Defines the type of numbering to use. There are
# three possibilities: \samp{A} for uppercased letters,
# \samp{a} for lowercased letters and \samp{n} for
# arabic numbers.>>
#{bef} << To put before the number.>>
#{aft} << To put after the number.>>
#{start} << The first number to issue (>0).>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# character vector with \samp{nbn} different strings associated to names
#EXAMPLE
# form3numbering(27);
# form3numbering(27,start=1);
# form3numbering(100,"a");
# form3numbering(100,"A");
#REFERENCE
#SEE ALSO form3names
#CALLING
#COMMENT
#FUTURE
# Monitor the number of digits to obtain series of "Z01", "Z02",... ,"Z79", "Z80".
#AUTHOR J.-B. Denis
#CREATED 07_10_19
#REVISED 14_08_05
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(start,"integer",1,con=c(1,Inf),mensaje="form3numbering: argument 'start' not accepted");
object9( nbn,"integer",1,con=c(1,Inf),mensaje="form3numbering: argument 'nbn' not accepted");
object9(type,"character",1,c("A","a","n"),mensaje="form3numbering: argument 'type' not accepted");
if ((start==0) & (type != "n")) { erreur(list(start=start,type=type),
"The two argument values are not compatible");}
}
#
# degenerate case
if (nbn < 1) { return(character(0));}
nbn <- nbn + start - 1;
#
# determining the number of digits and them
if (tolower(type)=="a") {
nbd <- 26;
if (type =="a") { digi <- letters;
} else { digi <- LETTERS;}
} else {
nbd <- 10;
digi <- as.character(0:9);
}
nbp <- 1;
while (nbn > nbd^nbp) { nbp <- nbp + 1;}
#
# getting the numbers
res <- rep("",nbn);
for (ii in bc(nbp)) {
jj <- rep(digi,times=nbd^(nbp-ii),each=nbd^(ii-1))[1:nbn];
res <- paste0(jj,res);
}
#
if (start>1) {res <- res[-bc(start-1)];}
#
# surrounding
res <- paste0(bef,res,aft);
#
# returning
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3line <- function(len=50,pat="-_-",wid=3,
gind="",pat2="_-_",
imp=TRUE)
#TITLE prints a separator line from a given pattern
#DESCRIPTION
# Prints a separator line from a given pattern.
# The line can be composite with the width argument.
# The pattern can comprise more than one character.
# General indentation is possible (\samp{gind}).
# Even lines can have a different pattern(\samp{pat2}).
#DETAILS
#KEYWORDS print
#INPUTS
#[INPUTS]
#{len} << Line length (without the general indentation).>>
#{pat} << Pattern to use.>>
#{wid} << Number of elementary lines.>>
#{gind} << String to introduce as general indentation.>>
#{pat2} << Pattern to use for the even lines.
# If NULL, the pattern is common to all lines.>>
#{imp} << Printing when TRUE or returning (FALSE)>>
#VALUE
# character string or printing according to \samp{imp}
#EXAMPLE
# form3line();
# form3line(gind="^^^");
# form3line(pat="+",wid=1,gind=" ",pat2=NULL);
#REFERENCE
#SEE ALSO form3repeat
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_07_31
#REVISED 08_07_31
#--------------------------------------------
{
if (is.null(pat2)) { pat2 <- pat; }
if (wid <= 0) { res <- character(0);
} else {
res <- "";
if (nchar(pat)<=0) { pat <- "-";}
nbp <- ceiling((len*wid)/nchar(pat));
ch1 <- paste(rep(pat, nbp),collapse="");
ch2 <- paste(rep(pat2,nbp),collapse="");
po1 <- po2 <- 1;
for (jbd in 1:wid) {
if ((jbd %% 2) == 0) {
li <- substr(ch2,po2,po2+len-1);
po2 <- po2 + len;
} else {
li <- substr(ch1,po1,po1+len-1);
po1 <- po1 + len;
}
res <- paste0(res,gind,li,"\n");
}
}
if(!imp) { return(res);
} else {cat(res);}
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3title <- function(tit,empha=3,indent=2+2*empha,imp=TRUE)
#TITLE prints or prepares a title
#DESCRIPTION
# prints or prepares the character string \samp{tit}
# with more or less emphasis.
# This function is a shortcut of the hidden function \samp{form3titre},
# with some specialized calls.
#DETAILS
#KEYWORDS print
#INPUTS
#{tit}<<the title to print (just one line)>>
#[INPUTS]
#{empha} << Level of emphasizing.\cr
# (0): single line without carriage return\cr
# (1): single line\cr
# (2): underlined\cr
# (3): underlined and overlined\cr
# (4): (2) + 1 line before\cr
# (5): (3) + 1 line after\cr
# (6): (2) + 2 lines before and after\cr
# (7): corners + 1 line before and after (plus surrounding)\cr
# (8): box + 1 lines before and after (plus surrounding)\cr>>
#{indent} << Number of spaces to introduce before the title>>
#{imp} << Printing is performed and nothing is returned.
# If FALSE, the character string is returned
# (including possible new lines)>>
#VALUE
# either nothing or a character string according to imp
#EXAMPLE
# for (ii in 0:8) {form3title("Some Title",ii,imp=TRUE)};
#REFERENCE
#SEE ALSO
#CALLING {form3repeat}
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_09_24
#REVISED 10_09_15
#--------------------------------------------
{
# adjusting
empha <- round(max(0,min(8,empha)));
# preparing the argument for form3titre
if (length(tit)>1) { tit <- paste(tit,collapse=" ");}
if (empha == 0) { tit <- paste0("<",tit,">")}
if (empha == 1) { tit <- paste0("(*)",tit,"(*)")}
sbef <- round(max(indent,0));
caret <- (empha != 0);
saft=""; lbef <- 0; laft <- 0;
box <- "no";
if (empha == 2) { box <- "un";}
if (empha == 3) { box <- "unov";}
if (empha == 4) { box <- "unov"; lbef <- 1;}
if (empha == 5) { box <- "unov"; laft <- 1; lbef <- 1;}
if (empha == 6) { box <- "unov"; laft <- 2; lbef <- 2;}
if (empha == 7) {
box <- "cor" ; laft <- 1; lbef <- 1;
tit<- paste0(" ",tit," ");
}
if (empha == 8) {
box <- "box" ; laft <- 1; lbef <- 1;
tit<- paste0(" ",tit," ");
}
# calling form3titre
res <- form3titre(tit,box=box,
lbef=lbef,sbef=sbef,
saft=saft,laft=laft,
charbox=c("+","|","+",
"-","+","|",
"+","-"," "),
alig=2,caret=caret,imp=imp);
# returning
if (imp) { return(invisible());}
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3parag <- function(texte,titre=-1,
wid=60,fli=NULL,sep=1,
jus=1,trunc=TRUE,
ed=" ",ef="",
monitor=rbsa0$monitor$v,
imp=TRUE)
#TITLE prints or prepares paragraphes from a character vector.
#DESCRIPTION
# prints or prepares a character string \samp{texte}
# as a small formatted text.\cr
# Each component is supposed to be a
# paragraph but the first one can be
# considered as a title.
#DETAILS
#KEYWORDS print
#INPUTS
#{texte}<<The text to print (character vector).>>
#[INPUTS]
#{titre} << When > -2 indicates that the first
# component is a title (if not a
# simple paragraph). Then the absolute value
# of \samp{titre} gives the emphasize to put
# on the title. Notice that the title is
# not splitted in several lines as are
# the other components according to 'wid'
# value.>>
#{wid} << The maximum width for each line (in characters) without
# including indentation and frames.>>
#{fli} << When NULL, the first line of
# each paragraph (in fact the second if there is
# a title) is issued as a standard line. If not,
# \samp{fli[1]} spaces are added before and the considered
# width is \samp{fli[2]} (not including the added spaces).
# Also this means that your already wrote \samp{fli[3]}
# characters on the first line; this last possibility
# can be used only when there are no title and for the
# the first component.
# For instance, a French paragraph will be issued
# with \samp{fli=c(5,wid,0)}. The possibility of modifying
# wid for the first line can be of use when adding
# the name of an item first.>>
#{sep} << Number of lines separating each paragraph.>>
#{jus} << Type of justification (1=left, 2=centred,
# 3=left).>>
#{trunc} << Must truncation be done when a word
# is greater than the proposed wid?>>
#{ed} << Framing at the beginning of each line.>>
#{ef} << Framing at the end of each line.>>
#{monitor} << List of monitoring constants, see \samp{rbsa0$monitor$v} to
# know its structure.>>
#{imp} << Printing is performed and nothing is returned.
# If FALSE, the character string is returned
# (including possible new lines)>>
#VALUE
# either nothing or a character string according to \samp{imp}
#EXAMPLE
# form3parag(c("My Title","My important first sentence.","Last one!"));
# form3parag(rbsa0$text2$v,wid=20);
#REFERENCE
#SEE ALSO
#CALLING {form3repeat}
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_08_01
#REVISED 09_09_29
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(texte,"character");
object9(wid,"numeric",1,c(1,Inf));
if (!is.null(fli)) {
object9(fli,"numeric",3,c(0,Inf));
}
object9(sep,"integer",1,c(1,Inf));
object9(jus,"integer",1,c(1,3));
object9(trunc,"logical",1);
object9(ed,"character",1);
object9(ef,"character",1);
object9(imp,"logical",1);
}
sep <- min(max(0,sep),5);
if (titre > -2) {
# the possible title
res <- form3title(texte[1],empha=titre,indent=nchar(ed),imp=imp);
if (imp) { cat(form3repeat("\n",sep+1));
} else { res <- c(res,form3repeat("\n",sep));}
texte <- texte[-1];
} else { res <- character(0);}
#
for (i in bf(texte)) {
# paragraph after paragraph
mots <- strsplit(texte[i]," ")[[1]];
nlig <- 0;
while (length(mots) > 0) {
# the paragraph is not empty
nlig <- nlig+1;
# is it the first line and must it be different?
spfl <- ((nlig==1)&(!void9(fli)));
if (spfl) {
if (monitor$chk$v) {
object9(fli,"numeric",c(3,Inf));
}
wiid <- fli[2];
lili <- form3repeat(" ",fli[1]);
trop <- fli[3];
} else {
wiid <- wid;
#lili <- character(0);
lili <- "";
trop <- 0;
}
if (void9(wiid)) { wiid <- 60;}
while ( ((length(mots) > 0) &&
(nchar(paste(lili,collapse=" ")) < (wiid-nchar(mots[1])))
) || (
(length(lili) == 0)
)
) {
lili <- c(lili,mots[1]);
mots <- mots[-1];
}
#cat("<<",length(mots),">>\n");
lili <- paste(lili,collapse=" ");
#cat("{{",nchar(lili),lili,"}}\n");
lili <- form3justify(lili,wid-trop,jus,trunc);
if (spfl) { lili <- paste0(lili,ef,"\n");
} else { lili <- paste0(ed,lili,ef,"\n");}
if (imp) { cat(lili);
} else {
res <- c(res,lili);
lili <- character(0);
}
}
if (imp) { cat(form3repeat("\n",sep));
} else { res <- c(res,form3repeat("\n",sep));}
}
# returning
if (!imp) { return(res);}
cat(res);
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3display <- function(x,pau=FALSE,cat=FALSE,...)
#TITLE displays with its name any object
#DESCRIPTION
# displays any object after giving the name of
# the variable containing it. A pause can be introduced
# to give the opportunity to scrutinize the result.
#DETAILS
#KEYWORDS print
#INPUTS
#{x}<<The object to print.>>
#[INPUTS]
#{pau} << Must a pause be performed after the display?>>
#{cat} << Must the printing be done with 'cat' instead of print?>>
#{\dots} <<possible arguments for the print function.>>
#VALUE
# a print (or cat) is done and \samp{x} is returned
#EXAMPLE
# uu <- "azerty";
# form3display(uu);
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_09_17
#REVISED 09_10_12
#--------------------------------------------
{
cat("<< Displaying ",deparse(substitute(x))," >>\n");
if (cat) { cat(x,"\n");
} else { print(x,...);}
if (pau) { pause("affichage");}
# returning
x;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
name8list <- function(lili,monitor=rbsa0$monitor$v)
#TITLE returns the same list but with names
#DESCRIPTION
# Explores the branches of a list, returning the same valued list
# but introducing systematic names when some of the components are not named. This is a
# way to comply one of the two properties of a rbsa-list (see
# \samp{rbsa7list9}).
#DETAILS
# The new names are obtained with \samp{form3names}.
#KEYWORDS IO
#INPUTS
#{lili} << The list structure to be possibly named.>>
#[INPUTS]
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# The resulting named list.
#EXAMPLE
# uu <- list(list(1:3,4:6),
# B=matrix(letters[1:20],nrow=5,dimnames=list(1:5,c("on","tw","th","fo"))),
# list(a=1:3,b=letters,list(array(1:8,c(2,2,2)))));
# str(uu);
# str(name8list(uu));
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 10_04_19
#REVISED 10_04_19
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(lili,"list",-1,mensaje="lili must be a list");
}
#
# exploring the list
tata <- explore8list(lili);
if (nrow(tata) == 0) {return(lili);}
#
# looking for missing names and
# if so, providing them
qq <- which(tata[,"name"]=="<NA>");
while (length(qq)>0) {
qqq <- qq[1];
# selecting all concerned names
qqqq <- tata[tata[,"level"]==tata[qqq,"level"],"numbers"];
# proposing replacement names
nana <- form3names(length(qqqq));
ouou <- strsplit(qqqq[1]," ")[[1]];
ouou <- ouou[-length(ouou)];
if (length(ouou) > 0) {
coco <- paste("lili[[",
paste(ouou,collapse="]][["),
"]]",sep="");
} else {
coco <- "lili";
}
coco <- paste0("names(",coco,") <- nana;");
eval(parse(text=coco));
#
tata <- explore8list(lili);
qq <- which(tata[,"name"]=="<NA>");
}
#
# returning
lili;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Try the rbsa package in your browser
Any scripts or data that you put into this service are public.
rbsa documentation built on May 2, 2019, 6:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions form3join form3split form3justify form3repeat form3frame form3crop form3indent form3names form3numbering form3line form3title form3parag form3display name8list
Documented in form3crop form3display form3frame form3indent form3join form3justify form3line form3names form3numbering form3parag form3repeat form3split form3title name8list
####### rbsa1.code.r ########################
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3join <- function(vcara,none="-",
OPA="{",CPA="}",
opa="(",cpa=")",sep="+",
imp=FALSE,cr=imp)
#TITLE formats a series of names or a similar list
#DESCRIPTION returns a scalar character of the components
# of a \samp{character} surrounded by any kind of parenthesis
# (each and the whole)
# separated with the same separator.\cr
# Easy to undestand when applying the examples.
#DETAILS
#KEYWORDS print format
#INPUTS
#{vcara}<<Character vector to be considered.>>
#[INPUTS]
#{none}<< The internal result when \samp{vcara} is length zero.
# When it is \samp{character(0)} then the
# global parenthesis are not given contrary
# when it is \samp{""}.>>
#{OPA}<< The opening parenthesis to surround the entire list.>>
#{CPA}<< The closing parenthesis to surround the entire list.>>
#{opa}<< The opening parenthesis to surround each component.>>
#{cpa}<< The closing parenthesis to surround each component.>>
#{sep}<< The symbol to separate each component.>>
#{imp}<< Must the result be printed (with cat) or returned?>>
#{cr}<< Must a line feed be added at the end?>>
#VALUE
# A character string or nothing when imp is TRUE
#EXAMPLE
# form3join(letters[1:4])
# form3join(NULL);
# form3join(NULL,NULL);
# form3join(NULL,character(0));
# form3join(NULL,"");
#REFERENCE
#SEE ALSO form3split
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_06_25
#REVISED 08_10_30
#--------------------------------------------
{
vcara <- as.character(vcara);
vide <- (length(vcara) == 0);
if (length(vcara) == 1) { if (vcara == "") {
vide <- TRUE;
}}
if (vide) {
res <- none;
if (length(none)==0) {
OPA <- CPA <- "";
}
} else {
for (hd in bf(vcara)) {
hdc <- paste0(opa,vcara[hd],cpa);
if (hd == 1) { res <- hdc;
} else { res <- paste0(res,sep,hdc);}
}
}
res <- paste0(OPA,res,CPA);
if (cr) { res <- paste0(res,"\n");}
if(!imp) { return(res);}
cat(res);
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3split <- function(cara,none="-.-",
OPA="{",CPA="}",
opa="(",cpa=")",sep="+",
monitor=rbsa0$monitor$v)
#TITLE inverse function of form3join
#DESCRIPTION returns a vector character of the names
# from a character string generated by \samp{form3join}.
#DETAILS
# Of course, it is implicitely supposed that the
# inversion is unambiguous.\cr
# The syntax (consistent use of the parentheses and
# separators) is checked: an error is issued when
# not correct. The possible \samp{\\n} added by \samp{form3join}
# is taken into account and removed.
# For the moment, sep cannot be an empty string.
#KEYWORDS print format
#INPUTS
#{cara}<<Character to be considered.>>
#[INPUTS]
#{none}<< idem as in form3join.>>
#{OPA}<< idem as in form3join.>>
#{CPA}<< idem as in form3join.>>
#{opa}<< idem as in form3join.>>
#{cpa}<< idem as in form3join.>>
#{sep}<< idem as in form3join.>>
#{monitor} << List of monitoring constants, see \samp{rbsa0$monitor$v} to
# know its structure.>>
#VALUE
# A character vector
#EXAMPLE
# uu <- form3join(letters[1:4]);
# form3split(uu);
#REFERENCE
#SEE ALSO form3join
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_10_30
#REVISED 08_10_30
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(cara,"character",1);
}
# removing the possible "\n"
nl <- nchar(cara);
if (nl > 2) {
fin <- substr(cara,nl,nl);
if (fin=="\n") { cara <- substr(cara,1,nl-1);}
}
# removing the external braces
n1 <- nchar(OPA); n2 <- nchar(CPA);
if (n1 > 0) {
ax <- substr(cara,1,n1);
if (ax!=OPA) {
erreur(c(OPA,ax),"Non consistent OPA and cara arguments.");
}
cara <- substr(cara,1+n1,nchar(cara));
}
if (n2 > 0) {
nn <- nchar(cara);
ax <- substr(cara,nn-n2+1,nn);
if (ax!=CPA) {
erreur(c(CPA,ax),"Non consistent OPA and cara arguments.");
}
cara <- substr(cara,1,nn-n2);
}
# removing the separator and constituting the vector
if (cara==none) { res <- character(0);
} else {
# splitting
if (nchar(sep)==0) {
erreur(cara,"Sorry by the function does not act properly for empty separators");
}
res <- strsplit(cara,sep,fixed=TRUE)[[1]];
# removing the internal braces
n1 <- nchar(opa); n2 <- nchar(cpa);
for (hd in bf(res)) {
rr <- res[hd];
if (n1 > 0) {
ax <- substr(rr,1,n1);
if (ax!=opa) {
erreur(c(opa,ax),"Non consistent opa and cara arguments.");
}
rr <- substr(rr,1+n1,nchar(rr));
}
if (n2 > 0) {
nn <- nchar(rr);
ax <- substr(rr,nn-n2+1,nn);
if (ax!=cpa) {
erreur(c(cpa,ax),"Non consistent cpa and cara arguments.");
}
rr <- substr(rr,1,nn-n2);
}
res[hd] <- rr;
}
}
# returning
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3justify <- function(chaine,
nbc=8,
format=3,
tronc=TRUE,
carac=" ",
monitor=rbsa0$monitor$v)
#TITLE formats a character string
#DESCRIPTION
# Formats character string(s).
# The main use of this function is to produce
# aligned columns lists while not printing
# them at the same time.
#DETAILS
# The justification is made component by component,
# no concatenation between them is done.
#KEYWORDS print
#INPUTS
#{chaine}<<the character string to be printed, can be a vector.>>
#[INPUTS]
#{nbc} << Desired number of characters for the result; when
# \samp{chain} is a vector can be a vector of the same length>>
#{format} << Indicates the type of alignment:\cr
# 0 no aligment (no supplementary character added to reach \samp{nbc})\cr
# 1 to the left side\cr
# 2 centered\cr
# 3 to the right side>>
#{tronc} << If true, no more than
# \samp{nbc} characters are returned and
# possibly the string is truncated. In that
# case, \samp{$} is introduced to indicate the fact.>>
#{carac} << Character to use for enlarging the string>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE a character string
#EXAMPLE
# form3justify("vers")
# form3justify("versification",5)
# form3justify(letters[1:5],format=2,carac="+");
#REFERENCE
#SEE ALSO text3preparation
#CALLING
#COMMENT
#FUTURE Improve the behavior when \samp{nchar(carac)>1}.
#AUTHOR J.-B. Denis
#CREATED 1999_05_25
#REVISED 14_08_27
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(chaine,c("character","numeric"),-1);
object9(nbc,"integer",c(1,Inf));
}
# the null case
if (length(chaine)==0) { return(character(0));}
# preparing
nbc[nbc < 1] <- 8;
if (length(nbc) < length(chaine)) {
nnbc <- rep(nbc,length(chaine));
} else {
nnbc <- nbc;
}
#
itr <- "$"; # truncation indicator
rres <- cchaine <- chaine;
for (rr in bf(rres)) {
res <- rres[rr];
nbc <- nnbc[rr];
chaine <- cchaine[rr];
# truncation
if ( (nchar(res) > nbc) & tronc ) {
if (format <= 1) {
res <- substring(chaine,1,nbc-1);
res <- paste0(res,itr);
}
else {
if (format == 2) {
otg <- (nchar(chaine) - nbc) %/% 2;
res <- substring(chaine,1+otg);
res <- substring(res,1,nbc-2);
res <- paste0(itr,res,itr);
}
else {
res <- substring(chaine,1+nchar(chaine)-nbc+1,
nchar(chaine));
res <- paste0(itr,res);
}
}
}
if ((nchar(res) < nbc) & (format != 0)) {
if (format == 1) {
while (nchar(res) < nbc) res <-
paste(res,"",collapse="",sep=carac);
}
else {
if (format == 2) {
raj <- (nbc - nchar(res)) %/% 2;
if (raj > 0) {
for (jbd in 1:raj) res <-
paste(res,"",collapse="",sep=carac);
}
while (nchar(res) < nbc) {
res <- paste("",res,collapse="",sep=carac);
}
}
else {
while (nchar(res) < nbc) {
res <- paste("",res,collapse="",sep=carac);
}
}
}
}
rres[rr] <- res;
}
# returning
rres;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3repeat <- function(cha="-",nb=10,imp=FALSE,cr=imp)
#TITLE prints a repeated given string
#DESCRIPTION
# Component by component, prints the concatenation
# of the given string(s) repeated \samp{nb} times.
#DETAILS
#KEYWORDS print
#INPUTS
#[INPUTS]
#{cha} << The string to repeat>>
#{nb} << Number of repetitions>>
#{imp} << Printing when TRUE or returning (default)>>
#{cr} << Must a line feed be added?>>
#VALUE
# character string or printing according to \samp{imp}
#EXAMPLE
# form3repeat('-+',20,TRUE)
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_09_24
#REVISED 08_09_25
#--------------------------------------------
{
nb <- max(0,round(nb));
res <- "";
for (jbd in bc(nb)) { res <- paste0(res,cha);}
if (cr) { res <- paste0(res,"\n");}
if(!imp) { return(res);}
cat(res);
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3frame <- function(chaine,bef="(*)_",aft="",imp=FALSE,cr=imp,
monitor=rbsa0$monitor$v)
#TITLE surrounds a character string
#DESCRIPTION
# Adds _bef_ore and _aft_er some characters to a character string
# (the same for all components when it is a vector).
#DETAILS
#KEYWORDS print
#INPUTS
#{chaine} <<The character string to frame; can be a vector.>>
#[INPUTS]
#{bef} << What to add at the beginning.>>
#{aft} << What to add at the end.>>
#{imp} << Printing when TRUE if not returning>>
#{cr} << Must a line feed be added?>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# character string or printing according to \samp{imp}.
#EXAMPLE
# form3frame('IMPORTANT','<<< ',' >>>');
# form3frame('IMPORTANT','<<< ',' >>>',imp=TRUE);
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_08_21
#REVISED 10_06_16
#--------------------------------------------
{
if (monitor$chk$v) {
object9(chaine,"character",-1,mensaje="form3frame: 'chaine' must be a character");
object9(bef,"character",1,mensaje="form3frame: 'bef' must be a character(1)");
object9(aft,"character",1,mensaje="form3frame: 'aft' must be a character(1)");
object9(imp,"logical",1,mensaje="form3frame: 'imp' must be a logical(1)");
object9( cr,"logical",1,mensaje="form3frame: 'cr' must be a logical(1)");
}
if (length(chaine)>0) {
res <- paste0(bef,chaine,aft);
if (cr) { res <- paste0(res,"\n");}
} else { res <- character(0);}
if(!imp) { return(res);}
else {cat(res);}
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3crop <- function(chaine,bef=rbsa0$sep0$v,aft=bef,
mxm=Inf,empty=FALSE,
monitor=rbsa0$monitor$v)
#TITLE removes framing characters from a character string
#DESCRIPTION
# removes \samp{bef}s before and \samp{aft}s after a character string.
#DETAILS
#KEYWORDS utilities
#INPUTS
#{chaine} <<The character string to refine.
# Can be a vector.>>
#[INPUTS]
#{bef} << What to repeatedly remove at the beginning.>>
#{aft} << What to repeatedly remove at the end.>>
#{mxm} << Maximum number of tags to remove.>>
#{empty} << Must remaining empty lines be removed?>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# \samp{character} after removings
#EXAMPLE
# form3crop('IMPORTANT','IM',' ANT');
# form3crop(c(' OUF ',' FOU ',''),' ','',1);
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_12_10
#REVISED 14_01_22
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(chaine,"character",-1,mensaje="form3crop: 'chaine' must be a character");
object9(bef,"character",1,mensaje="form3crop: Vector are not accepted for 'bef'");
object9(aft,"character",1,mensaje="form3crop: Vector are not accepted for 'aft'");
object9(mxm,"numeric",1,mensaje="form3crop: mxm must be numeric(1)");
}
# null case
if (length(chaine) == 0) { return(chaine);}
lb <- nchar(bef);
la <- nchar(aft);
for (ich in bf(chaine)) {
cha <- chaine[ich];
# removing at the beginning of the string
if (lb>0) {
nbr <- 0;
repeat {
deb <- substr(cha,1,lb);
if ((deb == bef) & (nbr < mxm)) {
cha <- substring(cha,lb+1);
nbr <- nbr+1;
} else { break;}
}
}
# removing at the end of the string
if (la>0) {
nbr <- 0;
repeat {
lc <- nchar(cha);
fin <- substr(cha,lc-la+1,lc);
if ((fin == aft) & (nbr < mxm)) {
cha <- substring(cha,1,lc-la);
nbr <- nbr+1;
} else { break;}
}
}
chaine[ich] <- cha;
}
# removing empty lines
if (empty) {
nbli <- length(chaine);
for (ii in rev(bc(nbli))) {
if (chaine[ii] == "") { chaine <- chaine[-ii];}
}
}
# returning
chaine;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3indent <- function(niv=1,cr=1,ele=" ",monitor=rbsa0$monitor$v)
#TITLE provides indentation of different levels
#DESCRIPTION
# returns a character to be used as indentation.
# The level of indentation is given by \samp{niv*monitor$ind$v} times
# the character \samp{ele}. New lines can be added first.
#DETAILS
#KEYWORDS print
#INPUTS
#[INPUTS]
#{niv} << Level of indentation.>>
#{cr} << Number of previous feed lines to first provide?>>
#{ele} << String to repeat.>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# a scalar string
#EXAMPLE
# cat(form3indent(2),"Bien `a vous","\n");
# cat(form3indent(3),cr=3,"Bien `a vous","\n");
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_09_10
#REVISED 14_08_05
#--------------------------------------------
{
niv <- round(max(min(8,niv),0));
res <- "";
for (ii in bc(cr)) { res <- paste0(res,"\n");}
res <- paste0(res,form3repeat(ele,niv*monitor$ind$v));
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3names <- function(nbn,nom=character(0),prefix="",
upca=TRUE,nume=14,
monitor=rbsa0$monitor$v)
#TITLE provides systematic names for items
#DESCRIPTION
# Provides systematic names for a series of items according to their
# number and taking care of previous names.
#DETAILS
#KEYWORDS utilities
#INPUTS
#{nbn} <<Number of new item names to generate>>
#[INPUTS]
#{nom} << Already present names (to avoid identical names).>>
#{prefix} << Systematic prefix of all names to generate. Must
# comprise the dot, if one wants such a separator
# between it and the specific part of the name.
# Of course can be 'underscore' or whatever else.>>
#{upca} << Indicates whether the letters constituting the new
# names must be uppercase or not.>>
#{nume} << Its absolute value gives the number of the letter to use
# when the alphabet is not sufficient. When negative, alphabet
# is not considered as a first possibility. For instance 2 will
# indicate "B" and the default is "N". When 0, no letter is considered.>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# vector with \samp{nbn} different strings associated to new names
#EXAMPLE
# form3names(2);
# form3names(2,nume=-3);
# form3names(2,prefix="rbsa.");
# form3names(2,upca=FALSE);
# form3names(5,"D");
# form3names(5,"Y");
# form3names(30);
#REFERENCE
#SEE ALSO form3numbering
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_10_19
#REVISED 10_02_15
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(upca,"logical",1,mensaje="Argument 'upca' not accepted");
object9(nume,"integer",1,mensaje="Argument 'nume' not accepted");
if (abs(nume)>26) {
erreur(nume,"'nume' must be comprised between -26 and 26 to indicate a Letter");
}
}
#
if (upca) { Letters <- LETTERS;
} else { Letters <- letters;}
#
if (void9(nbn)) { return(character(0));}
if (nbn < 1) { return(character(0));
} else {
if (prefix != "") {
# keeping only the names having got the prefix then
# removing the prefixes from them (to be added further)
decom <- sapply(strsplit(nom,prefix),function(ll){length(ll);});
nom <- nom[decom == 2];
nom <- sapply(strsplit(nom,prefix),function(ll){ll[2];});
}
# looking for the maximum letter in noms
if ( length(nom) == 0 ) { mama <- 0;
} else { mama <- max(1*outer(nom,Letters,"==") %*% matrix(1:26,ncol=1));}
if ((nbn < (27-mama)) & (nume>=0)) {
# adding letters
res <- Letters[mama+(1:nbn)];
} else {
# adding numbered nodes
ajou <- 0; nu <- 1; res <- character(0);
if (nume==0) { malettre <- "";}
else { malettre <- Letters[abs(nume)];}
while ( ajou < nbn ) {
nono <- paste0(malettre,nu);
if (all(nono != nom)) {
ajou <- ajou + 1;
res <- c(res,nono);
}
nu <- nu+1;
}
}
}
# adding the prefix
res <- paste0(prefix,res);
# returning
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3numbering <- function(nbn,type="n",bef="-",aft="-",
start=1+(type=="n"),
monitor=rbsa0$monitor$v)
#TITLE provides a systematic numbering of items
#DESCRIPTION
# Provides systematic names for a series of items according their
# number giving them an identical number of characters.
#DETAILS
# Alphabetical series are "aa","ab",...,"az","ba",... Then starting
# from the second element means to start from "ab". It is not possible
# to start from the 0th element.\cr
# Numerical series are "00","01","02",...,"09","10",... Then one
# can start from the zeroth element which is "00" but starting from
# the second element means starting from "01". This inconsistency
# may look not desirable, but it allows to follow the natural
# reasoning when working in any of the two logics.
#KEYWORDS utilities
#INPUTS
#{nbn} <<Number of item names to generate from \samp{start}.>>
#[INPUTS]
#{type} << Defines the type of numbering to use. There are
# three possibilities: \samp{A} for uppercased letters,
# \samp{a} for lowercased letters and \samp{n} for
# arabic numbers.>>
#{bef} << To put before the number.>>
#{aft} << To put after the number.>>
#{start} << The first number to issue (>0).>>
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# character vector with \samp{nbn} different strings associated to names
#EXAMPLE
# form3numbering(27);
# form3numbering(27,start=1);
# form3numbering(100,"a");
# form3numbering(100,"A");
#REFERENCE
#SEE ALSO form3names
#CALLING
#COMMENT
#FUTURE
# Monitor the number of digits to obtain series of "Z01", "Z02",... ,"Z79", "Z80".
#AUTHOR J.-B. Denis
#CREATED 07_10_19
#REVISED 14_08_05
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(start,"integer",1,con=c(1,Inf),mensaje="form3numbering: argument 'start' not accepted");
object9( nbn,"integer",1,con=c(1,Inf),mensaje="form3numbering: argument 'nbn' not accepted");
object9(type,"character",1,c("A","a","n"),mensaje="form3numbering: argument 'type' not accepted");
if ((start==0) & (type != "n")) { erreur(list(start=start,type=type),
"The two argument values are not compatible");}
}
#
# degenerate case
if (nbn < 1) { return(character(0));}
nbn <- nbn + start - 1;
#
# determining the number of digits and them
if (tolower(type)=="a") {
nbd <- 26;
if (type =="a") { digi <- letters;
} else { digi <- LETTERS;}
} else {
nbd <- 10;
digi <- as.character(0:9);
}
nbp <- 1;
while (nbn > nbd^nbp) { nbp <- nbp + 1;}
#
# getting the numbers
res <- rep("",nbn);
for (ii in bc(nbp)) {
jj <- rep(digi,times=nbd^(nbp-ii),each=nbd^(ii-1))[1:nbn];
res <- paste0(jj,res);
}
#
if (start>1) {res <- res[-bc(start-1)];}
#
# surrounding
res <- paste0(bef,res,aft);
#
# returning
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3line <- function(len=50,pat="-_-",wid=3,
gind="",pat2="_-_",
imp=TRUE)
#TITLE prints a separator line from a given pattern
#DESCRIPTION
# Prints a separator line from a given pattern.
# The line can be composite with the width argument.
# The pattern can comprise more than one character.
# General indentation is possible (\samp{gind}).
# Even lines can have a different pattern(\samp{pat2}).
#DETAILS
#KEYWORDS print
#INPUTS
#[INPUTS]
#{len} << Line length (without the general indentation).>>
#{pat} << Pattern to use.>>
#{wid} << Number of elementary lines.>>
#{gind} << String to introduce as general indentation.>>
#{pat2} << Pattern to use for the even lines.
# If NULL, the pattern is common to all lines.>>
#{imp} << Printing when TRUE or returning (FALSE)>>
#VALUE
# character string or printing according to \samp{imp}
#EXAMPLE
# form3line();
# form3line(gind="^^^");
# form3line(pat="+",wid=1,gind=" ",pat2=NULL);
#REFERENCE
#SEE ALSO form3repeat
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_07_31
#REVISED 08_07_31
#--------------------------------------------
{
if (is.null(pat2)) { pat2 <- pat; }
if (wid <= 0) { res <- character(0);
} else {
res <- "";
if (nchar(pat)<=0) { pat <- "-";}
nbp <- ceiling((len*wid)/nchar(pat));
ch1 <- paste(rep(pat, nbp),collapse="");
ch2 <- paste(rep(pat2,nbp),collapse="");
po1 <- po2 <- 1;
for (jbd in 1:wid) {
if ((jbd %% 2) == 0) {
li <- substr(ch2,po2,po2+len-1);
po2 <- po2 + len;
} else {
li <- substr(ch1,po1,po1+len-1);
po1 <- po1 + len;
}
res <- paste0(res,gind,li,"\n");
}
}
if(!imp) { return(res);
} else {cat(res);}
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3title <- function(tit,empha=3,indent=2+2*empha,imp=TRUE)
#TITLE prints or prepares a title
#DESCRIPTION
# prints or prepares the character string \samp{tit}
# with more or less emphasis.
# This function is a shortcut of the hidden function \samp{form3titre},
# with some specialized calls.
#DETAILS
#KEYWORDS print
#INPUTS
#{tit}<<the title to print (just one line)>>
#[INPUTS]
#{empha} << Level of emphasizing.\cr
# (0): single line without carriage return\cr
# (1): single line\cr
# (2): underlined\cr
# (3): underlined and overlined\cr
# (4): (2) + 1 line before\cr
# (5): (3) + 1 line after\cr
# (6): (2) + 2 lines before and after\cr
# (7): corners + 1 line before and after (plus surrounding)\cr
# (8): box + 1 lines before and after (plus surrounding)\cr>>
#{indent} << Number of spaces to introduce before the title>>
#{imp} << Printing is performed and nothing is returned.
# If FALSE, the character string is returned
# (including possible new lines)>>
#VALUE
# either nothing or a character string according to imp
#EXAMPLE
# for (ii in 0:8) {form3title("Some Title",ii,imp=TRUE)};
#REFERENCE
#SEE ALSO
#CALLING {form3repeat}
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 07_09_24
#REVISED 10_09_15
#--------------------------------------------
{
# adjusting
empha <- round(max(0,min(8,empha)));
# preparing the argument for form3titre
if (length(tit)>1) { tit <- paste(tit,collapse=" ");}
if (empha == 0) { tit <- paste0("<",tit,">")}
if (empha == 1) { tit <- paste0("(*)",tit,"(*)")}
sbef <- round(max(indent,0));
caret <- (empha != 0);
saft=""; lbef <- 0; laft <- 0;
box <- "no";
if (empha == 2) { box <- "un";}
if (empha == 3) { box <- "unov";}
if (empha == 4) { box <- "unov"; lbef <- 1;}
if (empha == 5) { box <- "unov"; laft <- 1; lbef <- 1;}
if (empha == 6) { box <- "unov"; laft <- 2; lbef <- 2;}
if (empha == 7) {
box <- "cor" ; laft <- 1; lbef <- 1;
tit<- paste0(" ",tit," ");
}
if (empha == 8) {
box <- "box" ; laft <- 1; lbef <- 1;
tit<- paste0(" ",tit," ");
}
# calling form3titre
res <- form3titre(tit,box=box,
lbef=lbef,sbef=sbef,
saft=saft,laft=laft,
charbox=c("+","|","+",
"-","+","|",
"+","-"," "),
alig=2,caret=caret,imp=imp);
# returning
if (imp) { return(invisible());}
res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3parag <- function(texte,titre=-1,
wid=60,fli=NULL,sep=1,
jus=1,trunc=TRUE,
ed=" ",ef="",
monitor=rbsa0$monitor$v,
imp=TRUE)
#TITLE prints or prepares paragraphes from a character vector.
#DESCRIPTION
# prints or prepares a character string \samp{texte}
# as a small formatted text.\cr
# Each component is supposed to be a
# paragraph but the first one can be
# considered as a title.
#DETAILS
#KEYWORDS print
#INPUTS
#{texte}<<The text to print (character vector).>>
#[INPUTS]
#{titre} << When > -2 indicates that the first
# component is a title (if not a
# simple paragraph). Then the absolute value
# of \samp{titre} gives the emphasize to put
# on the title. Notice that the title is
# not splitted in several lines as are
# the other components according to 'wid'
# value.>>
#{wid} << The maximum width for each line (in characters) without
# including indentation and frames.>>
#{fli} << When NULL, the first line of
# each paragraph (in fact the second if there is
# a title) is issued as a standard line. If not,
# \samp{fli[1]} spaces are added before and the considered
# width is \samp{fli[2]} (not including the added spaces).
# Also this means that your already wrote \samp{fli[3]}
# characters on the first line; this last possibility
# can be used only when there are no title and for the
# the first component.
# For instance, a French paragraph will be issued
# with \samp{fli=c(5,wid,0)}. The possibility of modifying
# wid for the first line can be of use when adding
# the name of an item first.>>
#{sep} << Number of lines separating each paragraph.>>
#{jus} << Type of justification (1=left, 2=centred,
# 3=left).>>
#{trunc} << Must truncation be done when a word
# is greater than the proposed wid?>>
#{ed} << Framing at the beginning of each line.>>
#{ef} << Framing at the end of each line.>>
#{monitor} << List of monitoring constants, see \samp{rbsa0$monitor$v} to
# know its structure.>>
#{imp} << Printing is performed and nothing is returned.
# If FALSE, the character string is returned
# (including possible new lines)>>
#VALUE
# either nothing or a character string according to \samp{imp}
#EXAMPLE
# form3parag(c("My Title","My important first sentence.","Last one!"));
# form3parag(rbsa0$text2$v,wid=20);
#REFERENCE
#SEE ALSO
#CALLING {form3repeat}
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_08_01
#REVISED 09_09_29
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(texte,"character");
object9(wid,"numeric",1,c(1,Inf));
if (!is.null(fli)) {
object9(fli,"numeric",3,c(0,Inf));
}
object9(sep,"integer",1,c(1,Inf));
object9(jus,"integer",1,c(1,3));
object9(trunc,"logical",1);
object9(ed,"character",1);
object9(ef,"character",1);
object9(imp,"logical",1);
}
sep <- min(max(0,sep),5);
if (titre > -2) {
# the possible title
res <- form3title(texte[1],empha=titre,indent=nchar(ed),imp=imp);
if (imp) { cat(form3repeat("\n",sep+1));
} else { res <- c(res,form3repeat("\n",sep));}
texte <- texte[-1];
} else { res <- character(0);}
#
for (i in bf(texte)) {
# paragraph after paragraph
mots <- strsplit(texte[i]," ")[[1]];
nlig <- 0;
while (length(mots) > 0) {
# the paragraph is not empty
nlig <- nlig+1;
# is it the first line and must it be different?
spfl <- ((nlig==1)&(!void9(fli)));
if (spfl) {
if (monitor$chk$v) {
object9(fli,"numeric",c(3,Inf));
}
wiid <- fli[2];
lili <- form3repeat(" ",fli[1]);
trop <- fli[3];
} else {
wiid <- wid;
#lili <- character(0);
lili <- "";
trop <- 0;
}
if (void9(wiid)) { wiid <- 60;}
while ( ((length(mots) > 0) &&
(nchar(paste(lili,collapse=" ")) < (wiid-nchar(mots[1])))
) || (
(length(lili) == 0)
)
) {
lili <- c(lili,mots[1]);
mots <- mots[-1];
}
#cat("<<",length(mots),">>\n");
lili <- paste(lili,collapse=" ");
#cat("{{",nchar(lili),lili,"}}\n");
lili <- form3justify(lili,wid-trop,jus,trunc);
if (spfl) { lili <- paste0(lili,ef,"\n");
} else { lili <- paste0(ed,lili,ef,"\n");}
if (imp) { cat(lili);
} else {
res <- c(res,lili);
lili <- character(0);
}
}
if (imp) { cat(form3repeat("\n",sep));
} else { res <- c(res,form3repeat("\n",sep));}
}
# returning
if (!imp) { return(res);}
cat(res);
invisible();
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
form3display <- function(x,pau=FALSE,cat=FALSE,...)
#TITLE displays with its name any object
#DESCRIPTION
# displays any object after giving the name of
# the variable containing it. A pause can be introduced
# to give the opportunity to scrutinize the result.
#DETAILS
#KEYWORDS print
#INPUTS
#{x}<<The object to print.>>
#[INPUTS]
#{pau} << Must a pause be performed after the display?>>
#{cat} << Must the printing be done with 'cat' instead of print?>>
#{\dots} <<possible arguments for the print function.>>
#VALUE
# a print (or cat) is done and \samp{x} is returned
#EXAMPLE
# uu <- "azerty";
# form3display(uu);
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 08_09_17
#REVISED 09_10_12
#--------------------------------------------
{
cat("<< Displaying ",deparse(substitute(x))," >>\n");
if (cat) { cat(x,"\n");
} else { print(x,...);}
if (pau) { pause("affichage");}
# returning
x;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
name8list <- function(lili,monitor=rbsa0$monitor$v)
#TITLE returns the same list but with names
#DESCRIPTION
# Explores the branches of a list, returning the same valued list
# but introducing systematic names when some of the components are not named. This is a
# way to comply one of the two properties of a rbsa-list (see
# \samp{rbsa7list9}).
#DETAILS
# The new names are obtained with \samp{form3names}.
#KEYWORDS IO
#INPUTS
#{lili} << The list structure to be possibly named.>>
#[INPUTS]
#{monitor} <<List of constants indicating the monitoring choices,
# see the \samp{rbsa0$monitor$v} provided object as an example.>>
#VALUE
# The resulting named list.
#EXAMPLE
# uu <- list(list(1:3,4:6),
# B=matrix(letters[1:20],nrow=5,dimnames=list(1:5,c("on","tw","th","fo"))),
# list(a=1:3,b=letters,list(array(1:8,c(2,2,2)))));
# str(uu);
# str(name8list(uu));
#REFERENCE
#SEE ALSO
#CALLING
#COMMENT
#FUTURE
#AUTHOR J.-B. Denis
#CREATED 10_04_19
#REVISED 10_04_19
#--------------------------------------------
{
# checking
if (monitor$chk$v) {
object9(lili,"list",-1,mensaje="lili must be a list");
}
#
# exploring the list
tata <- explore8list(lili);
if (nrow(tata) == 0) {return(lili);}
#
# looking for missing names and
# if so, providing them
qq <- which(tata[,"name"]=="<NA>");
while (length(qq)>0) {
qqq <- qq[1];
# selecting all concerned names
qqqq <- tata[tata[,"level"]==tata[qqq,"level"],"numbers"];
# proposing replacement names
nana <- form3names(length(qqqq));
ouou <- strsplit(qqqq[1]," ")[[1]];
ouou <- ouou[-length(ouou)];
if (length(ouou) > 0) {
coco <- paste("lili[[",
paste(ouou,collapse="]][["),
"]]",sep="");
} else {
coco <- "lili";
}
coco <- paste0("names(",coco,") <- nana;");
eval(parse(text=coco));
#
tata <- explore8list(lili);
qq <- which(tata[,"name"]=="<NA>");
}
#
# returning
lili;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Try the rbsa package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.