Nothing
###################################################################################
# modification of print's method for class trajectory
####################################################################################
####################################################################################
####################################################################################
# general functions
####################################################################################
Row <- function(x, n, pad = 1) {
foo <- function(i, x, n) {
fmt <- paste0("%", n[i], "s")
sprintf(fmt, as.character(x[i]))
}
rowc <- sapply(seq_along(x), foo, x = x, n = n)
paste0(" ", paste(paste0(rep(" ", pad), rowc, rep(" ", pad)),
collapse = " "),
" ")
}
SepLine1 <- function(n, pad = 1) {
tmp <- lapply(n, function(x, pad) paste(rep("-", x + (2* pad)),
collapse = ""),
pad = pad)
paste0("-", paste(tmp, collapse = "-"), "-")
}
SepLine2 <- function(n, pad = 1) {
tmp <- lapply(n, function(x, pad) paste(rep(" ", x + (2* pad)),
collapse = ""),
pad = pad)
paste0(" ", paste(tmp, collapse = " "), " ")
}
###################################################################################
# modification of print's method for class trajectory.CNORM
####################################################################################
#' Print CNORM
#'
#' Print method for an object of class "\code{Trajectory.CNORM}".
#'
#' @param x Trajectory's object. An object of class "\code{Trajectory.CNORM}".
#' @param ... optional parameters
#'
#' @return The print of Obj.
#' @export
#'
#' @examples
#' data = read.csv(system.file("extdata", "CNORM2gr.csv", package = "trajeR"))
#' data = as.matrix(data)
#' sol = trajeR(Y = data[, 2:6], A = data[, 7:11], degre = c(2,2), Model = "CNORM", Method = "EM")
#' sol
print.Trajectory.CNORM <- function(x, ...){
# definiton of different sizes
Obj = x
n= Obj$Size
ng = Obj$groups
nbeta = Obj$degre + 1
ntheta = length(Obj$theta)/ng
if (any(is.na(Obj$delta))){
ndelta = 0
}else{
ndelta = length(Obj$delta)/ng
}
nbetatmp = c(0, nbeta)
nbetacum = cumsum(c(0, nbeta))
ndeltacum = cumsum(c(0, rep(ndelta, ng)))
indbeta = 1:sum(nbeta)
indsigma = (sum(nbeta)+1):(sum(nbeta)+ng)
if (any(is.na(Obj$delta))){
inddelta = 0
}else{
inddelta = (sum(nbeta)+ng+1):(sum(nbeta)+ng+ndelta*ng)
}
indtheta = (sum(nbeta) +ng+ ndelta*ng + 1):(sum(nbeta) +ng+ ndelta*ng + ntheta*ng)
#for the changement of group in the final table
indcum=c(0, nbetacum[-1]+(1:ng)*ndelta)
# adding number of groups
group = rep("", sum(nbeta)+ng+ndelta*ng + ntheta*ng)
#number for beta
for (i in 1:ng){
group[nbetacum[i]+1] = as.character(i)
}
# number for sigma
for (i in 1:ng){
group[nbetacum[ng+1]+i] = as.character(i)
}
# number for theta
for (i in 1:(ng)){
group[indcum[ng+1]+ng+1+(i-1)*ntheta] = as.character(i)
}
# create a data frame for print
dfprint = cbind(group, Parameter = Obj$Names, Obj$tab)
dfprint[,2] = as.character(dfprint[,2])
dfprint[,1] = as.character(dfprint[,1])
if (ntheta == 1){
if (Obj$Method == "L"){
dfprint[indtheta, 3] = exp(dfprint[indtheta, 3])/sum(exp(dfprint[indtheta, 3]))
}
dfprint[indtheta, 2] = paste0("pi", 1:ng)
}else{
# we store the value of the baseline
dfprint[indtheta,3] = dfprint[indtheta,3] - dfprint[indtheta[1:ntheta],3]
dfprint = dfprint[-indtheta[2:ntheta],]
# we change the name of group 1 to baseline
dfprint[indcum[ng+1]+ng+1,2] = "Baseline"
}
# we reorganize the data frame by group ordering
tmp =c()
for (i in 1:ng){
tmp = rbind(tmp, dfprint[(nbetacum[i]+1):(nbetacum[i+1]),])
if (ndelta !=0){
tmp = rbind(tmp, dfprint[(sum(nbeta)+ng+ndeltacum[i]+1):(sum(nbeta)+ng+ndeltacum[i+1]),])
}
}
for (i in 1:ng){
tmp = rbind(tmp, dfprint[sum(nbeta) + i,])
}
if (ntheta == 1){
tmp = rbind(tmp, dfprint[indtheta,])
}else{
tmp = rbind(tmp, dfprint[indtheta[1:(length(indtheta)-ntheta+1)],])
}
dfprint = tmp
dfprint[,3] = round(as.numeric(dfprint[,3]), 5)
dfprint[,5] = round(as.numeric(dfprint[,5]), 5)
dfprint[,6] = round(as.numeric(dfprint[,6]), 5)
dfprint[,4] = round(as.numeric(dfprint[,4]), 5)
fObj = format(dfprint)
strings = apply( dfprint,2, function(x) unlist(dfprint))[1,]
widths <- nchar(strings)
names = c("Group" ,"Parameter", "Estimate", "Std. Error", "T for H0:", "Prob>|T|")
widths <- pmax(nchar(strings), nchar(names))
csum <- sum(widths + 1) - 1
cat(paste("Call TrajeR with"), Obj$groups, "groups and a", paste(Obj$degre, collapse=","),
"degrees of polynomial shape of trajectory.\n")
cat("Model : Censored Normal\n")
if (Obj$Method == "L"){
cat("Method : Likelihood \n \n")
} else if (Obj$Method == "EM"){
cat("Method : Expectation-maximization \n \n")
}else{
cat("Method : Expectation-maximization with IWRLS\n \n")
}
esp = 1
sep1 <- SepLine1(widths, pad = esp)
sep2 <- SepLine2(widths, pad = esp)
namestmp = colnames(dfprint)
namestmp[5] = "T for H0:"
writeLines(Row(namestmp, widths, esp))
writeLines(Row(c("","","","","param.=0",""), widths, esp))
writeLines(sep1)
# write beta and delta
for (i in 1:(ng-1)){
for (j in 1:(nbeta[i]+ndelta)){
writeLines(Row(dfprint[indcum[i]+j , ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:(nbeta[ng]+ndelta)){
writeLines(Row(dfprint[indcum[ng]+j, ], widths, esp))
}
writeLines(sep1)
# write sigma
for (i in 1:(ng-1)){
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng + i, ], widths, esp))
}
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng + ng, ], widths, esp))
writeLines(sep1)
# write theta or pi
if (ntheta == 1){
for (i in 1:ng){
if (ndelta !=0){
writeLines(Row(dfprint[sum(nbeta)+ng+ndelta*ng+i, ], widths, esp))
}else{
writeLines(Row(dfprint[sum(nbeta)+ng+ndelta*ng+i, ], widths, esp))
}
}
}else{
writeLines(Row(dfprint[indcum[ng+1]+ng+1, ], widths, esp))
writeLines(sep2)
if (ng>2){
for (j in 1:((ng-2)*ntheta)){
writeLines(Row(dfprint[indcum[ng+1]+ng+1+j, ], widths, esp))
}
writeLines(sep2)
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+ng+(ng-2)*ntheta+1+j, ], widths, esp))
}
}else{
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+ng+1+j, ], widths, esp))
}
}
}
writeLines(sep1)
cat("Likelihood :", Obj$Likelihood)
}
###################################################################################
# modification of print's method for class trajectory.ZIP
####################################################################################
#' Print ZIP
#'
#' Print method for an object of class "\code{Trajectory.ZIP}".
#'
#' @param x Trajectory's object. An object of class "\code{Trajectory.ZIP}".
#' @param ... optional parameters
#'
#' @export
#'
#' @return The print of Obj.
#'
#' @examples
#' data = read.csv(system.file("extdata", "ZIP2gr.csv", package = "trajeR"))
#' data = as.matrix(data)
#' sol = trajeR(Y = data[, 2:6], A = data[, 7:11],
#' degre = c(1,2), degre.nu = c(1,1), Model = "ZIP", Method = "L")
#' sol
print.Trajectory.ZIP <- function(x, ...){
# definiton of different sizes
Obj = x
n= Obj$Size
ng = Obj$groups
nbeta = Obj$degre + 1
ntheta = length(Obj$theta)/ng
nnu = Obj$degre.nu + 1
if (any(is.na(Obj$delta))){
ndelta = 0
}else{
ndelta = length(Obj$delta)/ng
}
nbetatmp = c(0, nbeta)
nbetacum = cumsum(c(0, nbeta))
nnucum = cumsum(c(0, nnu))
ndeltacum = cumsum(c(0, rep(ndelta, ng)))
indbeta = 1:sum(nbeta)
indnu = (sum(nbeta)+1):(sum(nbeta)+sum(nnu))
if (any(is.na(Obj$delta))){
inddelta = 0
}else{
inddelta = (sum(nbeta)+sum(nnu)+1):(sum(nbeta)+sum(nnu)+ndelta*ng)
}
indtheta = (sum(nbeta) + sum(nnu) + ndelta*ng + 1):(sum(nbeta) + sum(nnu) + ndelta*ng + ntheta*ng)
#for the changement of group in the final table
indcum=c(0, nbetacum[-1]+nnucum[-1]+(1:ng)*ndelta)
# adding number of groups
group = rep("", sum(nbeta)+sum(nnu)+ndelta*ng + ntheta*ng)
for (i in 1:ng){
group[nbetacum[i]+1] = as.character(i)
#group[nbetacum[ng+1]+nnucum[i]+1] = as.character(i)
group[indcum[ng+1]+1+(i-1)*ntheta] = as.character(i)
}
# create a data frame for print
dfprint = cbind(group, Parameter = Obj$Names, Obj$tab)
dfprint[,2] = as.character(dfprint[,2])
dfprint[,1] = as.character(dfprint[,1])
if (ntheta == 1){
if (Obj$Method == "L"){
dfprint[indtheta, 3] = exp(dfprint[indtheta, 3])/sum(exp(dfprint[indtheta, 3]))
}
dfprint[indtheta, 2] = paste0("pi", 1:ng)
}else{
# we store the value of the baseline
dfprint[indtheta,3] = dfprint[indtheta,3] - dfprint[indtheta[1:ntheta],3]
dfprint = dfprint[-indtheta[2:ntheta],]
# we change the name of group 1 to baseline
dfprint[indcum[ng+1]+1,2] = "Baseline"
}
# we reorganize the data frame by group ordering
tmp =c()
for (i in 1:ng){
tmp = rbind(tmp, dfprint[(nbetacum[i]+1):(nbetacum[i+1]),])
tmp = rbind(tmp, dfprint[(nbetacum[ng+1]+nnucum[i]+1):(nbetacum[ng+1]+nnucum[i+1]),])
if (ndelta !=0){
tmp = rbind(tmp, dfprint[(sum(nbeta)+sum(nnu)+ndeltacum[i]+1):(sum(nbeta)+sum(nnu)+ndeltacum[i+1]),])
}
}
if (ntheta == 1){
tmp = rbind(tmp, dfprint[indtheta,])
}else{
tmp = rbind(tmp, dfprint[indtheta[1:(length(indtheta)-ntheta+1)],])
}
dfprint = tmp
dfprint[,3] = round(as.numeric(dfprint[,3]), 5)
dfprint[,5] = round(as.numeric(dfprint[,5]), 5)
dfprint[,6] = round(as.numeric(dfprint[,6]), 5)
dfprint[,4] = round(as.numeric(dfprint[,4]), 5)
fObj = format(dfprint)
strings = apply( dfprint,2, function(x) unlist(dfprint))[1,]
widths <- nchar(strings)
names = c("Group" ,"Parameter", "Estimate", "Std. Error", "T for H0:", "Prob>|T|")
widths <- pmax(nchar(strings), nchar(names))
csum <- sum(widths + 1) - 1
cat(paste("Call TrajeR with"), Obj$groups, "groups and a", paste(Obj$degre, collapse=","),
"degrees of polynomial shape of trajectory.\n")
cat("Model : Zero Inflated Poisson\n")
if (Obj$Method == "L"){
cat("Method : Likelihood \n \n")
} else if (Obj$Method == "EM"){
cat("Method : Expectation-maximization \n \n")
}else{
cat("Method : Expectation-maximization with IWRLS\n \n")
}
esp = 1
sep1 <- SepLine1(widths, pad = esp)
sep2 <- SepLine2(widths, pad = esp)
namestmp = colnames(dfprint)
namestmp[5] = "T for H0:"
writeLines(Row(namestmp, widths, esp))
writeLines(Row(c("","","","","param.=0",""), widths, esp))
writeLines(sep1)
for (i in 1:(ng-1)){
for (j in 1:(nbeta[i]+nnu[i]+ndelta)){
writeLines(Row(dfprint[indcum[i]+j , ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:(nbeta[ng]+nnu[ng]+ndelta)){
writeLines(Row(dfprint[indcum[ng]+j, ], widths, esp))
}
writeLines(sep1)
if (ntheta == 1){
for (i in 1:ng){
if (ndelta !=0){
writeLines(Row(dfprint[sum(nbeta)+sum(nnu)+ndelta*ng+i, ], widths, esp))
}else{
writeLines(Row(dfprint[sum(nbeta)+sum(nnu)+ndelta*ng+i, ], widths, esp))
}
}
}else{
writeLines(Row(dfprint[indcum[ng+1]+1, ], widths, esp))
writeLines(sep2)
if (ng>2){
for (i in 2:(ng-1)){
for (j in 1:((ng-2)*ntheta)){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+(ng-2)*ntheta+1+j, ], widths, esp))
}
}else{
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
}
}
writeLines(sep1)
cat("Likelihood :", Obj$Likelihood)
}
###################################################################################
# modification of print's method for class trajectory.LOGIT
####################################################################################
#' Print LOGIT
#'
#' Print mehtod for an object of class "\code{Trajectory.LOGIT}".
#'
#' @param x Trajectory's object. . An object of class "\code{Trajectory.LOGIT}".
#' @param ... optional parameters
#'
#' @return The print of Obj.
#' @export
#'
#' @examples
#' data = read.csv(system.file("extdata", "LOGIT2gr.csv", package = "trajeR"))
#' data = as.matrix(data)
#' sol = trajeR(Y = data[, 2:6], A = data[, 7:11], degre = c(1,2), Model = "LOGIT", Method = "L")
#' sol
print.Trajectory.LOGIT <- function(x, ...){
# definiton of different sizes
Obj = x
n= Obj$Size
ng = Obj$groups
nbeta = Obj$degre + 1
ntheta = length(Obj$theta)/ng
if (any(is.na(Obj$delta))){
ndelta = 0
}else{
ndelta = length(Obj$delta)/ng
}
nbetatmp = c(0, nbeta)
nbetacum = cumsum(c(0, nbeta))
ndeltacum = cumsum(c(0, rep(ndelta, ng)))
indbeta = 1:sum(nbeta)
if (any(is.na(Obj$delta))){
inddelta = 0
}else{
inddelta = (sum(nbeta)+1):(sum(nbeta)+ndelta*ng)
}
indtheta = (sum(nbeta) + ndelta*ng + 1):(sum(nbeta) + ndelta*ng + ntheta*ng)
#for the changement of group in the final table
indcum=c(0, nbetacum[-1]+(1:ng)*ndelta)
# adding number of groups
group = rep("", sum(nbeta)+ndelta*ng + ntheta*ng)
for (i in 1:ng){
group[nbetacum[i]+1] = as.character(i)
}
for (i in 1:(ng)){
group[indcum[ng+1]+1+(i-1)*ntheta] = as.character(i)
}
# create a data frame for print
dfprint = cbind(group, Parameter = Obj$Names, Obj$tab)
dfprint[,2] = as.character(dfprint[,2])
dfprint[,1] = as.character(dfprint[,1])
if (ntheta == 1){
if (Obj$Method == "L"){
dfprint[indtheta, 3] = exp(dfprint[indtheta, 3])/sum(exp(dfprint[indtheta, 3]))
}
dfprint[indtheta, 2] = paste0("pi", 1:ng)
}else{
# we store the value of the baseline
dfprint[indtheta,3] = dfprint[indtheta,3] - dfprint[indtheta[1:ntheta],3]
dfprint = dfprint[-indtheta[2:ntheta],]
# we change the name of group 1 to baseline
dfprint[indcum[ng+1]+1,2] = "Baseline"
}
# we reorganize the data frame by group ordering
tmp =c()
for (i in 1:ng){
tmp = rbind(tmp, dfprint[(nbetacum[i]+1):(nbetacum[i+1]),])
if (ndelta !=0){
tmp = rbind(tmp, dfprint[(sum(nbeta)+ndeltacum[i]+1):(sum(nbeta)+ndeltacum[i+1]),])
}
}
if (ntheta == 1){
tmp = rbind(tmp, dfprint[indtheta,])
}else{
tmp = rbind(tmp, dfprint[indtheta[1:(length(indtheta)-ntheta+1)],])
}
dfprint = tmp
dfprint[,3] = round(as.numeric(dfprint[,3]), 5)
dfprint[,5] = round(as.numeric(dfprint[,5]), 5)
dfprint[,6] = round(as.numeric(dfprint[,6]), 5)
dfprint[,4] = round(as.numeric(dfprint[,4]), 5)
fObj = format(dfprint)
strings = apply( dfprint,2, function(x) unlist(dfprint))[1,]
widths <- nchar(strings)
names = c("Group" ,"Parameter", "Estimate", "Std. Error", "T for H0:", "Prob>|T|")
widths <- pmax(nchar(strings), nchar(names))
csum <- sum(widths + 1) - 1
cat(paste("Call TrajeR with"), Obj$groups, "groups and a", paste(Obj$degre, collapse=","),
"degrees of polynomial shape of trajectory.\n")
cat("Model : Logit\n")
if (Obj$Method == "L"){
cat("Method : Likelihood \n \n")
} else if (Obj$Method == "EM"){
cat("Method : Expectation-maximization \n \n")
}else{
cat("Method : Expectation-maximization with IWRLS\n \n")
}
esp = 1
sep1 <- SepLine1(widths, pad = esp)
sep2 <- SepLine2(widths, pad = esp)
namestmp = colnames(dfprint)
namestmp[5] = "T for H0:"
writeLines(Row(namestmp, widths, esp))
writeLines(Row(c("","","","","param.=0",""), widths, esp))
writeLines(sep1)
for (i in 1:(ng-1)){
for (j in 1:(nbeta[i]+ndelta)){
writeLines(Row(dfprint[indcum[i]+j , ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:(nbeta[ng]+ndelta)){
writeLines(Row(dfprint[indcum[ng]+j, ], widths, esp))
}
writeLines(sep1)
if (ntheta == 1){
for (i in 1:ng){
if (ndelta !=0){
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng+i, ], widths, esp))
}else{
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng+i, ], widths, esp))
}
}
}else{
writeLines(Row(dfprint[indcum[ng+1]+1, ], widths, esp))
writeLines(sep2)
if (ng>2){
for (i in 2:(ng-1)){
for (j in 1:((ng-2)*ntheta)){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+(ng-2)*ntheta+1+j, ], widths, esp))
}
}else{
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
}
}
writeLines(sep1)
cat("Likelihood :", Obj$Likelihood)
}
###################################################################################
# modification of print's method for class trajectory.POIS
####################################################################################
#' Print POIS
#'
#' Print mehtod for an object of class "\code{Trajectory.POIS}".
#'
#' @param x Trajectory's object. . An object of class "\code{Trajectory.POIS}".
#' @param ... optional parameters
#'
#' @return The print of Obj.
#' @export
#'
#' @examples
#' data = read.csv(system.file("extdata", "POIS2gr.csv", package = "trajeR"))
#' data = as.matrix(data)
#' sol = trajeR(Y = data[, 2:6], A = data[, 7:11],
#' degre = c(2,2), Model = "POIS", Method = "L", hessian = FALSE)
#' sol
print.Trajectory.POIS <- function(x, ...){
# definiton of different sizes
Obj = x
n= Obj$Size
ng = Obj$groups
nbeta = Obj$degre + 1
ntheta = length(Obj$theta)/ng
if (any(is.na(Obj$delta))){
ndelta = 0
}else{
ndelta = length(Obj$delta)/ng
}
nbetatmp = c(0, nbeta)
nbetacum = cumsum(c(0, nbeta))
ndeltacum = cumsum(c(0, rep(ndelta, ng)))
indbeta = 1:sum(nbeta)
if (any(is.na(Obj$delta))){
inddelta = 0
}else{
inddelta = (sum(nbeta)+1):(sum(nbeta)+ndelta*ng)
}
indtheta = (sum(nbeta) + ndelta*ng + 1):(sum(nbeta) + ndelta*ng + ntheta*ng)
#for the changement of group in the final table
indcum=c(0, nbetacum[-1]+(1:ng)*ndelta)
# adding number of groups
group = rep("", sum(nbeta)+ndelta*ng + ntheta*ng)
for (i in 1:ng){
group[nbetacum[i]+1] = as.character(i)
}
for (i in 1:(ng)){
group[indcum[ng+1]+1+(i-1)*ntheta] = as.character(i)
}
# create a data frame for print
dfprint = cbind(group, Parameter = Obj$Names, Obj$tab)
dfprint[,2] = as.character(dfprint[,2])
dfprint[,1] = as.character(dfprint[,1])
if (ntheta == 1){
if (Obj$Method == "L"){
dfprint[indtheta, 3] = exp(dfprint[indtheta, 3])/sum(exp(dfprint[indtheta, 3]))
}
dfprint[indtheta, 2] = paste0("pi", 1:ng)
}else{
# we store the value of the baseline
dfprint[indtheta,3] = dfprint[indtheta,3] - dfprint[indtheta[1:ntheta],3]
dfprint = dfprint[-indtheta[2:ntheta],]
# we change the name of group 1 to baseline
dfprint[indcum[ng+1]+1,2] = "Baseline"
}
# we reorganize the data frame by group ordering
tmp =c()
for (i in 1:ng){
tmp = rbind(tmp, dfprint[(nbetacum[i]+1):(nbetacum[i+1]),])
if (ndelta !=0){
tmp = rbind(tmp, dfprint[(sum(nbeta)+ndeltacum[i]+1):(sum(nbeta)+ndeltacum[i+1]),])
}
}
if (ntheta == 1){
tmp = rbind(tmp, dfprint[indtheta,])
}else{
tmp = rbind(tmp, dfprint[indtheta[1:(length(indtheta)-ntheta+1)],])
}
dfprint = tmp
dfprint[,3] = round(as.numeric(dfprint[,3]), 5)
dfprint[,5] = round(as.numeric(dfprint[,5]), 5)
dfprint[,6] = round(as.numeric(dfprint[,6]), 5)
dfprint[,4] = round(as.numeric(dfprint[,4]), 5)
fObj = format(dfprint)
strings = apply( dfprint,2, function(x) unlist(dfprint))[1,]
widths <- nchar(strings)
names = c("Group" ,"Parameter", "Estimate", "Std. Error", "T for H0:", "Prob>|T|")
widths <- pmax(nchar(strings), nchar(names))
csum <- sum(widths + 1) - 1
cat(paste("Call TrajeR with"), Obj$groups, "groups and a", paste(Obj$degre, collapse=","),
"degrees of polynomial shape of trajectory.\n")
cat("Model : Poisson\n")
if (Obj$Method == "L"){
cat("Method : Likelihood \n \n")
} else if (Obj$Method == "EM"){
cat("Method : Expectation-maximization \n \n")
}else{
cat("Method : Expectation-maximization with IWRLS\n \n")
}
esp = 1
sep1 <- SepLine1(widths, pad = esp)
sep2 <- SepLine2(widths, pad = esp)
namestmp = colnames(dfprint)
namestmp[5] = "T for H0:"
writeLines(Row(namestmp, widths, esp))
writeLines(Row(c("","","","","param.=0",""), widths, esp))
writeLines(sep1)
for (i in 1:(ng-1)){
for (j in 1:(nbeta[i]+ndelta)){
writeLines(Row(dfprint[indcum[i]+j , ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:(nbeta[ng]+ndelta)){
writeLines(Row(dfprint[indcum[ng]+j, ], widths, esp))
}
writeLines(sep1)
if (ntheta == 1){
for (i in 1:ng){
if (ndelta !=0){
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng+i, ], widths, esp))
}else{
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng+i, ], widths, esp))
}
}
}else{
writeLines(Row(dfprint[indcum[ng+1]+1, ], widths, esp))
writeLines(sep2)
if (ng>2){
for (i in 2:(ng-1)){
for (j in 1:((ng-2)*ntheta)){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+(ng-2)*ntheta+1+j, ], widths, esp))
}
}else{
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
}
}
writeLines(sep1)
cat("Likelihood :", Obj$Likelihood)
}
###################################################################################
# modification of print's method for class trajectory.NL
####################################################################################
#' print NL trajectory
#'
#' Print method for an object of class "\code{Trajectory.NL}".
#'
#' @param x Trajectory's object. . An object of class "\code{Trajectory.NL}".
#' @param ... optional parameters
#'
#' @return The print of Obj.
#' @export
#'
print.Trajectory.NL <- function(x, ...){
# definiton of different sizes
Obj = x
n= Obj$Size
ng = Obj$groups
nbeta = Obj$degre + 1
ntheta = length(Obj$theta)/ng
if (any(is.na(Obj$delta))){
ndelta = 0
}else{
ndelta = length(Obj$delta)/ng
}
nbetatmp = c(0, nbeta)
nbetacum = cumsum(c(0, nbeta))
ndeltacum = cumsum(c(0, rep(ndelta, ng)))
indbeta = 1:sum(nbeta)
indsigma = (sum(nbeta)+1):(sum(nbeta)+ng)
if (any(is.na(Obj$delta))){
inddelta = 0
}else{
inddelta = (sum(nbeta)+ng+1):(sum(nbeta)+ng+ndelta*ng)
}
indtheta = (sum(nbeta) +ng+ ndelta*ng + 1):(sum(nbeta) +ng+ ndelta*ng + ntheta*ng)
#for the changement of group in the final table
indcum=c(0, nbetacum[-1]+(1:ng)*ndelta)
# adding number of groups
group = rep("", sum(nbeta)+ng+ndelta*ng + ntheta*ng)
#number for beta
for (i in 1:ng){
group[nbetacum[i]+1] = as.character(i)
}
# number for sigma
for (i in 1:ng){
group[nbetacum[ng+1]+i] = as.character(i)
}
# number for theta
for (i in 1:(ng)){
group[indcum[ng+1]+ng+1+(i-1)*ntheta] = as.character(i)
}
# create a data frame for print
dfprint = cbind(group, Parameter = Obj$Names, Obj$tab)
dfprint[,2] = as.character(dfprint[,2])
dfprint[,1] = as.character(dfprint[,1])
if (ntheta == 1){
if (Obj$Method == "L"){
dfprint[indtheta, 3] = exp(dfprint[indtheta, 3])/sum(exp(dfprint[indtheta, 3]))
}
dfprint[indtheta, 2] = paste0("pi", 1:ng)
}else{
# we store the value of the baseline
dfprint[indtheta,3] = dfprint[indtheta,3] - dfprint[indtheta[1:ntheta],3]
dfprint = dfprint[-indtheta[2:ntheta],]
# we change the name of group 1 to baseline
dfprint[indcum[ng+1]+ng+1,2] = "Baseline"
}
# we reorganize the data frame by group ordering
tmp =c()
for (i in 1:ng){
tmp = rbind(tmp, dfprint[(nbetacum[i]+1):(nbetacum[i+1]),])
if (ndelta !=0){
tmp = rbind(tmp, dfprint[(sum(nbeta)+ng+ndeltacum[i]+1):(sum(nbeta)+ng+ndeltacum[i+1]),])
}
}
for (i in 1:ng){
tmp = rbind(tmp, dfprint[sum(nbeta) + i,])
}
if (ntheta == 1){
tmp = rbind(tmp, dfprint[indtheta,])
}else{
tmp = rbind(tmp, dfprint[indtheta[1:(length(indtheta)-ntheta+1)],])
}
dfprint = tmp
dfprint[,3] = round(as.numeric(dfprint[,3]), 5)
dfprint[,5] = round(as.numeric(dfprint[,5]), 5)
dfprint[,6] = round(as.numeric(dfprint[,6]), 5)
dfprint[,4] = round(as.numeric(dfprint[,4]), 5)
fObj = format(dfprint)
strings = apply( dfprint,2, function(x) unlist(dfprint))[1,]
widths <- nchar(strings)
names = c("Group" ,"Parameter", "Estimate", "Std. Error", "T for H0:", "Prob>|T|")
widths <- pmax(nchar(strings), nchar(names))
csum <- sum(widths + 1) - 1
cat(paste("Call TrajeR with"), Obj$groups, "groups and a", paste(Obj$degre, collapse=","),
"degrees of polynomial shape of trajectory.\n")
cat("Model : Non Linear\n")
if (Obj$Method == "L"){
cat("Method : Likelihood \n \n")
} else if (Obj$Method == "EM"){
cat("Method : Expectation-maximization \n \n")
}else{
cat("Method : Expectation-maximization with IWRLS\n \n")
}
esp = 1
sep1 <- SepLine1(widths, pad = esp)
sep2 <- SepLine2(widths, pad = esp)
namestmp = colnames(dfprint)
namestmp[5] = "T for H0:"
writeLines(Row(namestmp, widths, esp))
writeLines(Row(c("","","","","param.=0",""), widths, esp))
writeLines(sep1)
# write beta and delt
for (i in 1:(ng-1)){
for (j in 1:(nbeta[i]+ndelta)){
writeLines(Row(dfprint[indcum[i]+j , ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:(nbeta[ng]+ndelta)){
writeLines(Row(dfprint[indcum[ng]+j, ], widths, esp))
}
writeLines(sep1)
# write sigma
for (i in 1:(ng-1)){
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng + i, ], widths, esp))
}
writeLines(Row(dfprint[sum(nbeta)+ndelta*ng + ng, ], widths, esp))
writeLines(sep1)
# write theta or pi
if (ntheta == 1){
for (i in 1:ng){
if (ndelta !=0){
writeLines(Row(dfprint[sum(nbeta)+ng+ndelta*ng+i, ], widths, esp))
}else{
writeLines(Row(dfprint[sum(nbeta)+ng+ndelta*ng+i, ], widths, esp))
}
}
}else{
writeLines(Row(dfprint[indcum[ng+1]+ng+1, ], widths, esp))
writeLines(sep2)
if (ng>2){
for (i in 2:(ng-1)){
for (j in 1:((ng-2)*ntheta)){
writeLines(Row(dfprint[indcum[ng+1]+ng+1+j, ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+ng+(ng-2)*ntheta+1+j, ], widths, esp))
}
}else{
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+ng+1+j, ], widths, esp))
}
}
}
writeLines(sep1)
cat("Likelihood :", Obj$Likelihood)
}
###################################################################################
# modification of print's method for class trajectory.BETA
####################################################################################
#' Print BETA
#'
#' Print method for an object of class "\code{Trajectory.BETA}".
#'
#' @param x Trajectory's object. An object of class "\code{Trajectory.BETA}".
#' @param ... optional parameters
#'
#' @export
#'
#' @return The print of Obj.
#' @examples
#' data = read.csv(system.file("extdata", "BETA2gr.csv", package = "trajeR"))
#' data = as.matrix(data)
#' data[,2:6] = data[,2:6]*(nrow(data[,2:6])-1+0.5)/nrow(data[,2:6])
#' sol = trajeR(Y = data[, 2:6], A = data[, 7:11], itermax = 50,
#' degre = c(2,2), degre.phi = c(1,1), Model = "BETA", Method = "L")
#' sol
print.Trajectory.BETA <- function(x, ...){
# definiton of different sizes
Obj = x
n= Obj$Size
ng = Obj$groups
nbeta = Obj$degre + 1
ntheta = length(Obj$theta)/ng
nphi = Obj$degre.phi + 1
if (any(is.na(Obj$delta))){
ndelta = 0
}else{
ndelta = length(Obj$delta)/ng
}
nbetatmp = c(0, nbeta)
nbetacum = cumsum(c(0, nbeta))
nphicum = cumsum(c(0, nphi))
ndeltacum = cumsum(c(0, rep(ndelta, ng)))
indbeta = 1:sum(nbeta)
indphi = (sum(nbeta)+1):(sum(nbeta)+sum(nphi))
if (any(is.na(Obj$delta))){
inddelta = 0
}else{
inddelta = (sum(nbeta)+sum(nphi)+1):(sum(nbeta)+sum(nphi)+ndelta*ng)
}
indtheta = (sum(nbeta) + sum(nphi) + ndelta*ng + 1):(sum(nbeta) + sum(nphi) + ndelta*ng + ntheta*ng)
#for the changement of group in the final table
indcum=c(0, nbetacum[-1]+nphicum[-1]+(1:ng)*ndelta)
# adding number of groups
group = rep("", sum(nbeta)+sum(nphi)+ndelta*ng + ntheta*ng)
for (i in 1:ng){
group[nbetacum[i]+1] = as.character(i)
group[nbetacum[ng+1]+nphicum[i]+1] = as.character(i)
#group[nbetacum[ng+1]+nnucum[i]+1] = as.character(i)
group[indcum[ng+1]+1+(i-1)*ntheta] = as.character(i)
}
# create a data frame for print
dfprint = cbind(group, Parameter = Obj$Names, Obj$tab)
dfprint[,2] = as.character(dfprint[,2])
dfprint[,1] = as.character(dfprint[,1])
if (ntheta == 1){
if (Obj$Method == "L"){
dfprint[indtheta, 3] = exp(dfprint[indtheta, 3])/sum(exp(dfprint[indtheta, 3]))
}
dfprint[indtheta, 2] = paste0("pi", 1:ng)
}else{
# we store the value of the baseline
dfprint[indtheta,3] = dfprint[indtheta,3] - dfprint[indtheta[1:ntheta],3]
dfprint = dfprint[-indtheta[2:ntheta],]
# we change the name of group 1 to baseline
dfprint[indcum[ng+1]+1,2] = "Baseline"
}
# we reorganize the data frame by group ordering
tmp =c()
for (i in 1:ng){
tmp = rbind(tmp, dfprint[(nbetacum[i]+1):(nbetacum[i+1]),])
tmp = rbind(tmp, dfprint[(nbetacum[ng+1]+nphicum[i]+1):(nbetacum[ng+1]+nphicum[i+1]),])
if (ndelta !=0){
tmp = rbind(tmp, dfprint[(sum(nbeta)+sum(nphi)+ndeltacum[i]+1):(sum(nbeta)+sum(nphi)+ndeltacum[i+1]),])
}
}
if (ntheta == 1){
tmp = rbind(tmp, dfprint[indtheta,])
}else{
tmp = rbind(tmp, dfprint[indtheta[1:(length(indtheta)-ntheta+1)],])
}
dfprint = tmp
dfprint[,3] = round(as.numeric(dfprint[,3]), 5)
dfprint[,5] = round(as.numeric(dfprint[,5]), 5)
dfprint[,6] = round(as.numeric(dfprint[,6]), 5)
dfprint[,4] = round(as.numeric(dfprint[,4]), 5)
fObj = format(dfprint)
strings = apply( dfprint,2, function(x) unlist(dfprint))[1,]
widths <- nchar(strings)
names = c("Group" ,"Parameter", "Estimate", "Std. Error", "T for H0:", "Prob>|T|")
widths <- pmax(nchar(strings), nchar(names))
csum <- sum(widths + 1) - 1
cat(paste("Call TrajeR with"), Obj$groups, "groups and a", paste(Obj$degre, collapse=","),
"degrees of polynomial shape of trajectory.\n")
cat("Model : Beta\n")
if (Obj$Method == "L"){
cat("Method : Likelihood \n \n")
} else if (Obj$Method == "EM"){
cat("Method : Expectation-maximization \n \n")
}else{
cat("Method : Expectation-maximization with IWRLS\n \n")
}
esp = 1
sep1 <- SepLine1(widths, pad = esp)
sep2 <- SepLine2(widths, pad = esp)
namestmp = colnames(dfprint)
namestmp[5] = "T for H0:"
writeLines(Row(namestmp, widths, esp))
writeLines(Row(c("","","","","param.=0",""), widths, esp))
writeLines(sep1)
for (i in 1:(ng-1)){
writeLines(Row(c("mean","","","","",""), widths, esp))
for (j in (indcum[i]+1):(indcum[i]+nbeta[i])){
writeLines(Row(dfprint[j , ], widths, esp))
}
if (ndelta != 0){
for (j in (indcum[i]+nbeta[i]+nphi[i]+1):(indcum[i]+nbeta[i]+nphi[i]+ndelta)){
writeLines(Row(dfprint[j , ], widths, esp))
}
}
writeLines(Row(c("var.","","","","",""), widths, esp))
for (j in (indcum[i]+nbeta[i]+1):(indcum[i]+nbeta[i]+nphi[i])){
writeLines(Row(dfprint[j , ], widths, esp))
}
writeLines(sep2)
}
writeLines(Row(c("mean","","","","",""), widths, esp))
for (j in 1:(nbeta[ng])){
writeLines(Row(dfprint[indcum[ng]+j , ], widths, esp))
}
if (ndelta != 0){
for (j in (nbeta[ng]+nphi[ng]+1):(nbeta[ng]+nphi[ng]+ndelta)){
writeLines(Row(dfprint[indcum[ng]+j , ], widths, esp))
}
}
writeLines(Row(c("var.","","","","",""), widths, esp))
for (j in (indcum[ng]+nbeta[ng]+1):(indcum[ng]+nbeta[ng]+nphi[ng])){
writeLines(Row(dfprint[j , ], widths, esp))
}
# for (j in 1:(nbeta[ng]+nphi[ng]+ndelta)){
# writeLines(Row(dfprint[indcum[ng]+j, ], widths, esp))
# }
writeLines(sep1)
if (ntheta == 1){
for (i in 1:ng){
if (ndelta !=0){
writeLines(Row(dfprint[sum(nbeta)+sum(nphi)+ndelta*ng+i, ], widths, esp))
}else{
writeLines(Row(dfprint[sum(nbeta)+sum(nphi)+ndelta*ng+i, ], widths, esp))
}
}
}else{
writeLines(Row(dfprint[indcum[ng+1]+1, ], widths, esp))
writeLines(sep2)
if (ng>2){
for (i in 2:(ng-1)){
for (j in ((i-2)*ntheta+1):((i-1)*ntheta)){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
writeLines(sep2)
}
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+(ng-2)*ntheta+1+j, ], widths, esp))
}
}else{
for (j in 1:ntheta){
writeLines(Row(dfprint[indcum[ng+1]+1+j, ], widths, esp))
}
}
}
writeLines(sep1)
cat("Likelihood :", Obj$Likelihood)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.