R/ztable2.R

Defines functions addSigColor addSubColNames isGroupCol getNewSpanRow getspanRowData isspanRow getNewSpanCol spanColWidth isspanCol spanRow spanCol totalCol printLatexHead cGroupSpan colGroupCount addrgroup addcgroup getspanRowLength addFrontColor addCellColor addColColor addRowColor

Documented in addCellColor addcgroup addColColor addFrontColor addrgroup addRowColor addSigColor addSubColNames cGroupSpan colGroupCount getNewSpanCol getNewSpanRow getspanRowData getspanRowLength isGroupCol isspanCol isspanRow printLatexHead spanCol spanColWidth spanRow totalCol

#' Add row colors of an object of ztable
#'
#' @param z An object of ztable
#' @param rows An integer vector indicating specific rows
#' @param bg A character vector indicating background color
#' @param color A character vector indicating color
#' @param condition Logical expression to select rows
#' @importFrom magrittr "%>%"
#' @export
#' @examples
#' z=ztable(head(iris))
#' z=addRowColor(z,c(1,3),color="platinum")
#' z
addRowColor=function(z,rows=NULL,bg=NULL,color=NULL,condition=NULL){
    if(!is.null(bg)){
    for(i in 1:length(bg)) bg[i]=validColor(bg[i])
    selected=NULL
    selected <- if (!missing(condition)) {
        e <- substitute(condition)
        r <- eval(e, z$x, parent.frame())
        if (!is.logical(r))
            stop("'subset' must be logical")
        selected=which(r & !is.na(r) )+1
    }
    rows=c(rows,selected)
    if(is.null(rows)) rows=1:(nrow(z$x)+1)
    if(length(rows)>length(bg)) bg=rep(bg,1+length(rows)/length(bg))
    for(i in 1:length(rows))
        for(j in 1:ncol(z$cellcolor))
            z$cellcolor[rows[i],j]=bg[i]
        z$zebra.type=3
        z$zebra=3
        if(is.null(z$rowcolor)) z$rowcolor=rep("white",nrow(z$cellcolor))
        for(j in 1:length(rows)) z$rowcolor[rows[j]]=bg[j]

    }
    if(!is.null(color)){
    for(i in 1:length(color)) color[i]=validColor(color[i])
    if(length(rows)>length(color)) color=rep(color,1+length(rows)/length(color))
    for(i in 1:length(rows))
        for(j in 1:ncol(z$frontcolor))
              z$frontcolor[rows[i],j]=color[i]
    }
    z
}

#' Add column colors of an object of ztable
#'
#' @param z An object of ztable
#' @param cols An integer vector indicating specific columns
#' @param bg A character vector indicating background color
#' @param color A character vector indicating color
#'@export
#' @examples
#' z=ztable(head(iris))
#' z=addColColor(z,c(1,3),color="platinum")
#' z
addColColor=function(z,cols=NULL,bg=NULL,color=NULL){
    cols <- if (missing(cols))
        1:(ncol(z$x)+1)
    else {
        nl <- as.list(seq_along(z$x))
        names(nl) <- names(z$x)
        result=tryCatch(class(cols),error=function(e) "error")
        add=0
        if(result=="error") add=1
        eval(substitute(cols), nl, parent.frame())+add
    }
    if(!is.null(bg)){
    for(i in 1:length(bg)) bg[i]=validColor(bg[i])
    if(length(cols)>length(bg)) bg=rep(bg,1+length(cols)/length(bg))
    for(j in 1:length(cols))
        for(i in 1:nrow(z$cellcolor))
            z$cellcolor[i,cols[j]]=bg[j]
    z$zebra.type=3
    z$zebra=3
    if(is.null(z$colcolor)) z$colcolor=rep("white",ncol(z$cellcolor))
    for(j in 1:length(cols)) z$colcolor[cols[j]]=bg[j]
    }
    if(!is.null(color)){
    for(i in 1:length(color)) color[i]=validColor(color[i])
    if(length(cols)>length(color)) color=rep(color,1+length(cols)/length(color))
    for(j in 1:length(cols))
        for(i in 1:nrow(z$frontcolor))
            z$frontcolor[i,cols[j]]=color[j]
    }
    z
}

#' Add column colors of an object of ztable
#'
#' @param z An object of ztable
#' @param rows An integer vector indicating specific rows
#' @param cols An integer vector indicating specific columns
#' @param bg A character vector indicating background color
#' @param color A character vector indicating color
#' @param condition Logical expression to select rows
#' @export
#' @examples
#' \dontrun{
#' z=ztable(head(iris))
#' z=addRowColor(z,c(1,3),color="platinum")
#' z=addColColor(z,2,color="cyan")
#' z=addCellColor(z,cols=c(5,4),rows=5,color="red")
#' z
#' }
addCellColor=function(z,rows=NULL,cols=NULL,bg=NULL,color=NULL,condition=NULL){
    selected=NULL
    selected <- if (!missing(condition)) {
        e <- substitute(condition)
        r <- eval(e, z$x, parent.frame())
        if (!is.logical(r))
            stop("'subset' must be logical")
        selected=which(r & !is.na(r) )+1
    }
    rows=c(rows,selected)
    if(is.null(rows)) rows=1:(nrow(z$x)+1)
    cols <- if (missing(cols))
        1:(ncol(z$x)+1)
    else {
        nl <- as.list(seq_along(z$x))
        names(nl) <- names(z$x)
        result=tryCatch(class(cols),error=function(e) "error")
        add=0
        if(result=="error") add=1
        eval(substitute(cols), nl, parent.frame())+add
    }
    # while(length(rows)!=length(cols)){
    #     if(length(rows)<length(cols)){
    #         rows=c(rows,rows)
    #         if(length(rows)>length(cols)) rows=rows[1:length(cols)]
    #     }
    #     if(length(rows)>length(cols)){
    #         cols=c(cols,cols)
    #         if(length(cols)>length(rows)) cols=cols[1:length(rows)]
    #     }
    # }
    if(!is.null(bg)){
    for(i in 1:length(bg)) bg[i]=validColor(bg[i])
    if(length(cols)>length(bg)) bg=rep(bg,1+length(cols)/length(bg))
    for(i in 1:length(rows)) {
        for(j in 1:length(cols)){
           z$cellcolor[rows[i],cols[j]]=bg[j]
        }
    }
    }
    if(!is.null(color)){
    for(i in 1:length(color)) color[i]=validColor(color[i])
    if(length(cols)>length(color)) color=rep(color,1+length(cols)/length(color))
    for(i in 1:length(rows)) {
        for(j in 1:length(cols)){
            z$frontcolor[rows[i],cols[j]]=color[j]
        }
    }
    # for(i in 1:length(cols)) {
    #     z$frontcolor[rows[i],cols[i]]=color[i]
    #     result=getspanRowLength(z,rows[i],cols[i])
    #
    #     if(!is.null(result)){
    #         if(result>1){
    #             for(j in 1:(result-1)) z$frontcolor[(rows[i]+j),cols[i]]=color[i]
    #         }
    #     }
    # }
    }
    z$zebra.type=3
    z$zebra=3
    z
}

#' Add column colors of an object of ztable
#'
#' @param z An object of ztable
#' @param rows An integer vector indicating specific rows
#' @param cols An integer vector indicating specific columns
#' @param color A character vector indicating color
#' @export
#' @examples
#' z=ztable(head(iris))
#' z=addFrontColor(z,rows=2:4,cols=c(2,4,6),color=c("red","green","blue"))
#' z
addFrontColor=function(z,rows,cols,color){
    for(i in 1:length(color)) color[i]=validColor(color[i])
    if(length(cols)>length(color)) color=rep(color,1+length(cols)/length(color))

    for(i in 1:length(rows)) {
        for(j in 1:length(cols)){
            z$frontcolor[rows[i],cols[j]]=color[j]
            result=getspanRowLength(z,rows[i],cols[j])
            if(!is.null(result)){
                if(result>1){
                    for(k in 1:(result-1)) z$frontcolor[(rows[i]+k),cols[j]]=color[j]
                }
             }
        }
    }
    z
}

#' Gets spanRow length
#'
#'@param z An object of ztable
#'@param i An integer indicating the row of specific cell
#'@param j An integer indicating the column of specific cell
#'@export
#'@return row count when spanRow starts, 0 when column spans.
getspanRowLength=function(z,i,j){
    if(is.null(z$spanRow)) return(NULL)
    newspan=z$spanRow
    for(k in 1:nrow(newspan)) {
        if(newspan[k,1]!=j) next
        if(newspan[k,2]>i) next
        if(newspan[k,2]==i) return(newspan[k,3]-newspan[k,2]+1)
        else if((newspan[k,2]<j) & (newspan[k,3]>=j)) return(0)
        else next
    }
    return(NULL)
}

#' Add column groups of an object of ztable
#'
#'@param z An object of ztable
#'@param cgroup A character vector or matrix indicating names of column group. Default value is NULL
#'@param n.cgroup A integer vector or matrix indicating the numbers of columns included in each cgroup
#'       Default value is NULL
#'@param color A character vector indicating the font color of each cells.
#'@param bg A character vector indicating the background color of each cells.
#'@param top Logical. Whether or not cgroup be placed at top.
#'@export
addcgroup=function(z,cgroup,n.cgroup,color="black",bg="white",top=FALSE){

    if(length(color)==1){
        color=rep(color,length(cgroup)+1)
    } else{
        color=c("black",color)
    }
    if(length(bg)==1){
        bg=rep(bg,length(cgroup)+1)
    } else{
        bg=c("white",bg)
    }

    if(length(z$cgroup)==0) {
        z$cgroup=list()
        z$cgroup[[1]]=cgroup
        z$cgroupcolor=list()
        z$cgroupcolor[[1]]=color
        z$cgroupbg=list()
        z$cgroupbg[[1]]=bg
        z$n.cgroup=list()
        z$n.cgroup[[1]]=n.cgroup
    } else{
        if(top){
            no=length(z$cgroup)
            for(i in no:1){
                z$cgroup[[no+1]]=z$cgroup[[no]]
                z$cgroupcolor[[no+1]]=z$cgroupcolor[[no]]
                z$cgroupbg[[no+1]]=z$cgroupbg[[no]]
                z$n.cgroup[[no+1]]=z$n.cgroup[[no]]
            }
            z$cgroup[[1]]=cgroup
            z$cgroupcolor[[1]]=color
            z$cgroupbg[[1]]=bg
            z$n.cgroup[[1]]=n.cgroup
        } else{
            no=length(z$cgroup)+1
            z$cgroup[[no]]=cgroup
            z$cgroupcolor[[no]]=color
            z$cgroupbg[[no]]=bg
            z$n.cgroup[[no]]=n.cgroup
        }
    }

    z
}

#' Add row groups of an object of ztable
#'
#'@param z An object of ztable
#'@param rgroup A character vector indicating names of row group. Default value is NULL
#'@param n.rgroup A integer vector indicating the numbers of rows included in each rgroup
#'       Default value is NULL
#'@param cspan.rgroup An integer indicating the column span of rgroup
#'@param color A character vector indicating the font color of rgroup.
#'@param bg A character vector indicating the background color of rgroup.
#'@export
addrgroup=function(z,rgroup,n.rgroup,cspan.rgroup=NULL,color="black",bg="white"){
    if(is.null(rgroup)) return(z)
    for(i in 1:length(rgroup)) {
        if(is.na(rgroup[i])) rgroup[i]=""
    }
    z$rgroup=rgroup
    z$n.rgroup=n.rgroup
    z$cspan.rgroup=cspan.rgroup
    if(length(bg)==1) bg=rep(bg,length(rgroup))
    if(length(color)==1) color=rep(color,length(rgroup))
    z$colcolor=rep(bg,ncol(z$cellcolor))
    z$rgroupcolor=color
    z$rgroupbg=bg
    z
}

#' Count the colgroup of an object of ztable
#'
#' @param z An object of class ztable
#' @return A vector indicating the position of colgroup
#'@export
colGroupCount=function(z){
    if(is.null(z$cgroup)) return(NULL)
    if(is.null(z$n.cgroup)) return(NULL)
    result=c()
    for(i in 1:length(z$n.cgroup)){
        count=0
        for(j in 1:length(z$n.cgroup[[i]])) {
            if(is.na(z$n.cgroup[[i]][j])) break
            count=count+z$n.cgroup[[i]][j]
            result=c(result,count)
        }
    }
    a=unique(result)
    a[order(a)]
}

#' Count the colspan of each colgroup
#'
#' @param z An object of ztable
#' @return A matrix indicating the column span occupied by each colgroup
#' @export
cGroupSpan=function(z){
    (vlines=align2lines(z$align))
    (colCount=colGroupCount(z))

    newCount=c()
    addrow=ifelse(z$include.rownames,1,0)
    for(i in 1:length(colCount)) {
        if(vlines[colCount[i]+1+addrow]==0) newCount=c(newCount,colCount[i])
    }
    newCount
    if(is.null(newCount)) return(z$n.cgroup)
    result=z$n.cgroup
    for(i in 1:length(z$n.cgroup)){
        start=0
        for(j in 1:length(z$n.cgroup[[i]])) {
            if(is.na(z$n.cgroup[[i]][j])) break
            end=start+z$n.cgroup[[i]][j]
            count=0
            for(k in 1:length(newCount)){
                if(newCount[k]>start & newCount[k]<end) count=count+1
            }
            result[[i]][j]=result[[i]][j]+count
            #cat("start=",start,",end=",end,",result[",i,",",j,"]=",result[i,j],"\n")
            start=end
        }
    }
    result
}

#' Print the head of latex table if the object of ztable has a colgroup
#'
#' @param z An object of ztable
#' @export
printLatexHead=function(z){
    if(is.null(z$cgroup)) return()
    if(is.null(z$n.cgroup)) return()
    #colCount=colGroupCount(z)
    ncount=ncol(z$x)
    addrow=ifelse(z$include.rownames,1,0)
    cGroupSpan=cGroupSpan(z)
    totalCol=totalCol(z)
    vlines=align2lines(z$align)
    #vlines=align2lines(getNewAlign(z))
    #vlines

    for(i in 1:length(z$cgroup)){
            colSum=0
            linecount=1
            if(z$include.rownames) {
                firstrow=cat(paste("\\cellcolor{",z$cgroupbg[[i]][1],"} &",sep=""))
                colSum=1
                linecount=1
            }
            for(j in 1:length(z$cgroup[[i]])) {
                if(is.na(z$cgroup[[i]][j])) break
                mcalign="c"
                if((j==1) & (addrow==0) & (vlines[linecount+1]>0))
                    for(k in 1:vlines[linecount+1]) mcalign=paste("|",mcalign,sep="")
                end=colSum+cGroupSpan[[i]][j]+1
                linecount=linecount+z$n.cgroup[[i]][j]
                if(vlines[linecount+1]>0)
                    for(k in 1:vlines[linecount+1]) mcalign=paste(mcalign,"|",sep="")
                second=paste("\\multicolumn{",cGroupSpan[[i]][j],"}{",mcalign,"}{",sep="")
                colSum=colSum+cGroupSpan[[i]][j]
                if(z$cgroupbg[[i]][j+1]!="white")
                    second=paste(second,"\\cellcolor{",z$cgroupbg[[i]][j+1],"}",sep="")
                if(z$cgroupcolor[[i]][j+1]!=z$color) {
                    second=paste(second,"\\color{",z$cgroupcolor[[i]][j+1],"}",sep="")
                }
                if(z$colnames.bold)
                    second=paste(second,"\\textbf{",z$cgroup[[i]][j],"}}",sep="")
                else second=paste(second,z$cgroup[[i]][j],"}",sep="")

                if(j!=1) second=paste("&",second,sep="")
                cat(second)
                if(linecount<(ncol(z$x)+1)) if(vlines[linecount+1]==0) cat("&")
            }
            cat("\\\\ \n")
            colSum=addrow+1
            start=1
            for(j in 1:length(z$cgroup[[i]])) {
                if(is.na(z$cgroup[[i]][j])) break
                if(z$cgroup[[i]][j]!="")
                    cat(paste("\\cline{",colSum,"-",colSum+cGroupSpan[[i]][j]-1,"}",sep=""))
                colSum=colSum+cGroupSpan[[i]][j]
                start=start+z$n.cgroup[[i]][j]
                if(j < length(z$cgroup[[i]])) if(vlines[start+1]==0) colSum=colSum+1

            }
            cat("\n")
    }
}


#' Calculating total columns of ztable
#'
#' @param z An object of ztable
#' @export
totalCol=function(z){
    ncount=ncol(z$x)
    addrow=ifelse(z$include.rownames,1,0)
    result=ncount+addrow
    vlines=align2lines(z$align)
    if(!is.null(z$cgroup)) {
        colCount=colGroupCount(z)
        if(length(colCount)>1){
        for(i in 1:(length(colCount)-1)) {
            if(vlines[colCount[i]+2]==0) result=result+1
        }
        }
    }
    result
}

#' Merging data cells of ztable object in columns
#'
#' @param z An object of ztable
#' @param row An integer indicating the row of merging data cell
#' @param from An integer indicating start column of merging data cell
#' @param to An integer indicating end column of merging data cell
#' @param bg An optional character indicating the background color of merging cell
#' @param color An optional character indicating the font color of merging cell
#' @export
spanCol=function(z,row,from,to,bg=NULL,color=NULL){
    if(length(row)!=1) {
        warning("Only one row is permitted")
        return(z)
    }
    if(row<0 | (row > (nrow(z$x)+1))) {
        warning("Out of range : row")
        return(z)
    }
    if(from>to){
        warning("\"to\" must be equal to or greater than \"from\"")
        return(z)
    }
    if(is.null(z$spanCol)) z$spanCol=matrix(c(row,from,to),nrow=1)
    else z$spanCol=rbind(z$spanCol,c(row,from,to))
    #colnames(z$spanCol)=c("row","from","to")
    z=addCellColor(z,cols=from,rows=row,bg=bg,color=color)
    z
}


#' Merging data cells of ztable object in rows
#'
#' @param z An object of ztable
#' @param col An integer indicating the column of merging data cell
#' @param from An integer indicating start row of merging data cell
#' @param to An integer indicating end row of merging data cell
#' @param bg An optional character indicating the background color of merging cell
#' @param color An optional character indicating the font color of merging cell
#' @export
spanRow=function(z,col,from,to,bg=NULL,color=NULL){
    if(length(row)!=1) {
        warning("Only one row is permitted")
        return(z)
    }
    if(col<0 | col > (ncol(z$x)+1)) {
        warning("Out of range : col")
        return(z)
    }
    if(from>to){
        warning("\"to\" must be equal to or greater than \"from\"")
        return(z)
    }
    if(is.null(z$spanRow)) z$spanRow=matrix(c(col,from,to),nrow=1)
    else z$spanRow=rbind(z$spanRow,c(col,from,to))
    #colnames(z$spanRow)=c("col","from","to")
    #if(!is.null(color)) z=addCellColor(z,cols=col,rows=from,color=color)
    z=addCellColor(z,cols=col,rows=from,bg=bg,color=color)
    z
}

#' Identify the spanCol status of a cell
#'
#'@param z An object of ztable
#'@param i An integer indicating the row of specific cell
#'@param j An integer indicating the column of specific cell
#'@return column plus space count when spanCol starts, 0 when column spans,
#'        minus value when spanCol ends, NULL when no span.
isspanCol=function(z,i,j){
    if(is.null(z$spanCol)) return(NULL)
    newspan=getNewSpanCol(z)
    for(k in 1:nrow(newspan)) {
        if(newspan[k,1]!=i) next
        if(newspan[k,2]>j) next
        if(newspan[k,2]==j) return(newspan[k,3]-newspan[k,2]+1)
        else if((newspan[k,2]<j) & (z$spanCol[k,3]>=j)) return(0)
        else next
    }
    return(NULL)
}

#' Calculate the spanColWidth when spanCol start
#'
#'@param z An object of ztable
#'@param i An integer indicating the row of specific cell
#'@param j An integer indicating the column of specific cell
#
#'@return column count when spanCol start
spanColWidth=function(z,i,j){
    if(is.null(z$spanCol)) return(NULL)
    newspan=z$spanCol
    for(k in 1:nrow(newspan)) {
        if(newspan[k,1]!=i) next
        if(newspan[k,2]>j) next
        if(newspan[k,2]==j) return(newspan[k,3]-newspan[k,2]+1)
        else next
    }
    return(NULL)
}

#' Calculating new spanCol with spanCol plus space made by column group
#'
#'@param z An object of ztable
#'@export
getNewSpanCol=function(z){
    result=z$spanCol
    result1=result
    result1
    if(is.null(z$cgroup)) return(result)
    if(is.null(colGroupCount(z))) return(result)
    vlines=align2lines(z$align)
    vlines
    addcol=ifelse(z$include.rownames,1,0)

    #colCount=colGroupCount(z)+1
    colCount=colGroupCount(z)+addcol
    newCount=c()
    colCount
    for(i in 1:length(colCount)) {
        if(vlines[colCount[i]+1]==0) newCount=c(newCount,colCount[i])
    }
    if(is.null(newCount)) return(result)
    for(i in 1:nrow(result)) {
        for(j in 1:(length(newCount))) {
            if((result[i,2]<=newCount[j]) & (result[i,3]>newCount[j])) {
                result1[i,3]=result1[i,3]+1
            }
        }
    }
    return(result1)
}

#' Identify the spanRow status of a cell
#'
#'@param z An object of ztable
#'@param i An integer indicating the row of specific cell
#'@param j An integer indicating the column of specific cell
#'@return columns count plus spaces by rgroup when spanRow starts, 0 when row spans,
#'        minus value when spanRow ends, NULL when no span.
isspanRow=function(z,i,j){
    if(is.null(z$spanRow)) return(NULL)
    newspanRow=getNewSpanRow(z)
    for(k in 1:nrow(z$spanRow)) {
        if(z$spanRow[k,1]!=j) next
        if(z$spanRow[k,2]>i) next
        if(z$spanRow[k,2]==i) return(newspanRow[k,3]-newspanRow[k,2]+1)
        else if(z$spanRow[k,3]==i) return(-(newspanRow[k,3]-newspanRow[k,2]+1))
        else if((z$spanRow[k,2]<i) & (z$spanRow[k,3]>i)) return(0)
        else next
    }
    return(NULL)
}

#'Gets the spanRow start column
#'
#'@param z An object of ztable
#'@param i An integer indicating the row of specific cell
#'@param j An integer indicating the column of specific cell
#'
#'@return An integer indicating column where spanRow start. This function is for latex
#'        multirow
getspanRowData=function(z,i,j){
    for(k in 1:nrow(z$spanRow)) {
        if(z$spanRow[k,1]!=j) next
        if(z$spanRow[k,2]>=i) next
        if(z$spanRow[k,3]==i) return(z$spanRow[k,2])
    }
    return(NULL)
}

#' Calculating new spanRow with spanRow plus space made by row group
#'
#'@param z An object of ztable
getNewSpanRow=function(z){
    result=z$spanRow
    result1=result
    if(is.null(z$rgroup)) return(result)
    if(is.null(z$n.rgroup)) return(result)
    #colCount=colGroupCount(z)+1
    printrgroup=1
    if(!is.null(z$n.rgroup)){
        if(length(z$n.rgroup)>1) {
            for(i in 2:length(z$n.rgroup)) {
                printrgroup=c(printrgroup,printrgroup[length(printrgroup)]+z$n.rgroup[i-1])
            }
        }
    }
    for(i in 1:nrow(result)) {
        for(j in 2:(length(printrgroup))) {
            if((result[i,2]<=printrgroup[j]) & (result[i,3]>printrgroup[j])) {
                result1[i,3]=result1[i,3]+1
            }
        }
    }
    result1
}

#' Returns whether or not column with position start plus length is group column
#'
#' @param start An integer indicating start column position
#' @param length An integer indicating spanCol length
#' @param colCount An integer vector calculating from colGroupCount()
#' @export
isGroupCol=function(start,length,colCount){

    if(is.null(colCount)) return(0)
    newstart=start
    for(i in 1:length(colCount)){
        if(colCount[i]<start) newstart=start+1
    }
    result=colCount
    for(i in 1:length(colCount)){
        result[i]=colCount[i]+(i-1)+1
    }
    if((newstart+length) %in% result[-length(result)]) return(1)
    else return(0)
}

#' Add a adjunctive name below column name in a ztable
#'
#'@param z An object of ztable
#'@param subcolnames A charactor vector
#'@export
addSubColNames=function(z,subcolnames){
    if(length(subcolnames)!=length(z$x))
        warning("length of subconames is different from length of z$x")
    else z$subcolnames=subcolnames
    z
}

#' Add row color or cellcolor for rows or cells of p-value less than sigp in a ztable
#'
#'@param z An object of ztable
#'@param level A p-value
#'@param bg A character indicating background color
#'@param color A character indicating color
#'@export
addSigColor=function(z,level=0.05,bg="lightcyan",color="black"){

    if("ztable.mytable" %in% class(z))  {
        if(is.null(z$cgroup)){
            temp=z$x[[ncol(z$x)]]
            temp[temp=="< 0.001"]=0
            below05=which(as.numeric(temp)<level)+1
            if(length(below05)>0) {
                z1=addRowColor(z,rows=below05,bg=bg,color=color)
            } else{
                z1=z
            }
        } else{
            count=length(z$cgroup[[1]])-1
            count
            colpergroup=(ncol(z$x)-1)/count
            colpergroup
            z1<-z
            for(i in 2:(count+1)){
                pcol=1+colpergroup*(i-1)
                temp=z$x[[pcol]]
                temp[temp=="< 0.001"]=0
                below05=which(as.numeric(temp)<level)+1
                if(length(below05)>0) for(j in 1:length(below05))
                    z1=addCellColor(z1,rows=below05[j],
                                   cols=(pcol+1-(colpergroup-1)):(pcol+1),bg=bg,color=color)

            }
        }
    } else {
        if(!is.null(z$pcol)){
            temp=z$x[[z$pcol]]
            below05=which(as.numeric(temp)<level)+1
            if(length(below05)>0){
                z1=addRowColor(z,rows=below05,bg=bg,color=color)
            }  else{
                z1<-z
            }
        } else{
            z1=z
        }
    }
    z1
}

Try the ztable package in your browser

Any scripts or data that you put into this service are public.

ztable documentation built on Oct. 23, 2020, 5:58 p.m.