Nothing
inst/rbsa1.code.r
In rbsa: Ancillary Functions for R Programming
####### 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.
####### 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.