Nothing
#' Find rgb value from color name
#'
#'@param name a valid color name
#'@return rgb value
name2rgb=function(name){
if(substr(name,1,1)=="#") {
result=name
} else{
number=grep(paste("^",name,sep=""),ztable::zcolors$name)
if(length(number)<1) result="white"
else{
rgb=ztable::zcolors[number[1],2]
result=paste("#",rgb,sep="")
}
}
result
}
#' Delete first components of align
#'
#' @param align A character for define the align of column in Latex format
align2nd=function(align){
if(substr(align,1,1)=="|") {
result=substr(align,2,nchar(align))
result=align2nd(result)
} else result=substr(align,2,nchar(align))
result
}
#' Count the number of align
#'
#' @param align A character for define the align of column in Latex format
#' @export
alignCount=function(align){
result=unlist(strsplit(align,"|",fixed=TRUE))
temp=c()
for(i in 1:length(result)) temp=paste(temp,result[i],sep="")
nchar(temp)
}
#' Check the validity of align
#'
#' @param align A character for define the align of column in Latex format
#' @param ncount An integer equals of ncol function
#' @param addrow An integer
#' @export
alignCheck=function(align,ncount,addrow){
count=alignCount(align)
#cat("align=",align,"count=",count,"\n")
while(count != (ncount+addrow)){
if(count< (ncount+addrow)) align=paste(align,"c",sep="")
else if(count > (ncount+addrow)) align=align2nd(align)
count=alignCount(align)
#cat("align=",align,"count=",count,"\n")
}
result=align
result
}
#' Convert the align in Latex format to html format
#'
#' @param align A character of align in Latex format
#' @export
align2html=function(align){
result=c()
for(i in 1:nchar(align)){
temp=substr(align,i,i)
if(temp=="|") next
temp=ifelse(temp=="l","left",ifelse(temp=="r","right","center"))
result=c(result,temp)
}
result
}
#' Add or delete vertical lines in a ztable
#'
#' @param z An object of ztable
#' @param type An integer or one of c("none","all")
#' @param add An integer vector indicating columns where the width of vertical lines added
#' @param del An integer vector indicating columns where the width of vertical lines subtracted
#' @importFrom stringr str_remove_all fixed
#' @export
vlines=function(z,type=NULL,add=NULL,del=NULL){
if(is.null(type) & is.null(add) & is.null(del)) {
cat("\nvlines : add or delete vertical lines to a ztable\n
Usage: type must be one of these or NULL: 0-1 or \"none\",\"all\"\n
add and del: An integer vector indicating position to add or delete vertical line(s)\n")
return(z)
}
align=str_remove_all(z$align,fixed("|"))
vlines=align2lines(z$align)
colcount=colGroupCount(z)
addrow=ifelse(z$include.rownames,1,0)
#align=alignCheck(align,ncol(z$x),addrow)
count=nchar(align)
if(!is.null(type)) {
vltype=NULL
if(!is.numeric(type)) {
if(toupper(type) == "NONE") vltype=0
else if(toupper(type) == "ALL") vltype=1
else return(z)
}
if((type>=0) & (type<=1)) vltype=type
if(vltype==0) vlines=rep(0,count+1)
else vlines=rep(1,count+1) #vltype=1
}
if(!is.null(add)){
if(is.numeric(add)){
for(i in 1:length(add)) {
if(add[i]<1 | add[i]>(count+1)) next
vlines[add[i]]=vlines[add[i]]+1
}
}
}
if(!is.null(del)){
if(is.numeric(del)){
for(i in 1:length(del)){
if(del[i]<1 | del[i]>(count+1)) next
if(vlines[del[i]]>0) vlines[del[i]]=vlines[del[i]]-1
}
}
}
newalign=vline2align(align,vlines)
z$align=newalign
z
}
#' Add or delete horizontal lines in a ztable
#'
#' @param z An object of ztable
#' @param type An integer or one of c("none","all")
#' @param add An integer vector indicating rows where the horizontal lines added
#' @param del An integer vector indicating rows where the horizontal lines deleted
#' @export
hlines=function(z,type=NULL,add=NULL,del=NULL){
if(is.null(type) & is.null(add) & is.null(del)) {
cat("\nhlines : add or delete horizontal lines to a ztable\n
Usage: type must be one of these or NULL: 0-1 or \"none\",\"all\"\n
add and del: An integer vector indicating position to add or delete horizontal line(s)\n")
return(z)
}
count=nrow(z$x)
if(!is.null(z$hline.after)) result=z$hline.after
else result=c(-1,0,count)
if(!is.null(type)) {
if(!is.numeric(type)) {
if(toupper(type) == "NONE") hltype=0
else if(toupper(type) == "ALL") hltype=1
else return(z)
}
if((type>=0) & (type<=1)) hltype=type
if(hltype==0) result=c(-1,0,count)
else result=c(-1,0,1:count)
}
if(!is.null(add)){
if(is.numeric(add)){
for(i in 1:length(add)) {
result=c(result,add)
}
}
}
if(!is.null(del)){
if(is.numeric(del)){
result1=c()
for(i in 1:length(result)){
if(!(result[i] %in% del)) result1=c(result1,result[i])
}
result=result1
}
}
z$hline.after=result
z
}
#' Make a latex "align" from a string and vertical line specifier
#'
#' @param align A character string indicating align of latex table
#' @param vlines An integer vector indicating vertical line position
#' @export
vline2align=function(align,vlines){
newalign=c()
for(i in 1:nchar(align)) {
if(vlines[i]>0) for(j in 1:vlines[i]) newalign=c(newalign,"|")
newalign=c(newalign,substr(align,i,i))
}
last=vlines[length(vlines)]
if(last>0) for(j in 1:last) newalign=c(newalign,"|")
temp=newalign[1]
if(length(newalign)>1)
for(i in 2:length(newalign)) {
temp=paste(temp,newalign[i],sep="")
}
temp
}
#' count the vertical column lines from align of Latex format
#'
#' @param align A string of align Latex format
#' @return a numeric vector consists of vertical lines of each column
#' @export
align2lines=function(align){
result=c()
length=nchar(align)
count=0
number=alignCount(align)
for(i in 1:length){
temp=substr(align,1,1)
if(temp=="|") {
count=count+1
if(i==length) result=c(result,count)
}
else{
result=c(result,count)
count=0
}
align=substr(align,2,nchar(align))
}
if(length(result)==number) result=c(result,0)
result
}
#' Make a character string indicating the alignment of components of table.
#'
#' @param z An object of ztable
#' @export
getNewAlign=function(z){
#cat("z$align=",z$align,"\n")
if(is.null(z$cgroup)) return(z$align)
lines=align2lines(z$align)
lines
exAlign=str_remove_all(z$align,fixed("|"))
exAlign
ncount=ncol(z$x)
addrow=ifelse(z$include.rownames,1,0)
addrow
colCount=colGroupCount(z)
colCount
result=c()
start=1+addrow
# Add column group align "c" if lines
for(i in 1:length(colCount)){
#cat("start=",start,"stop=",colCount[i]+addrow,",")
result=paste(result,substr(exAlign,start=start,stop=(colCount[i]+addrow)),sep="")
#cat("i=",i,",start=",start,"stop=",(colCount[i]+addrow),",result=",result)
start=colCount[i]+1+addrow
#cat(",line[start]=",start,"\n")
if(lines[start]==0) result=paste(result,"c",sep="")
#cat("result=",result,"\n")
}
result
if(colCount[length(colCount)]<ncount)
result=paste(result,substr(exAlign,start=start,stop=nchar(z$align)),sep="")
result
newlines=c()
for(i in 1:length(lines)){
if(i==1) newlines=lines[1]
else newlines=c(newlines,lines[i])
if((i-1) %in% colCount[-length(colCount)])
if(lines[i+1]==0) newlines=c(newlines,0)
}
temp=c()
for(i in 1:length(newlines)){
if(newlines[i]>0) for(j in 1:newlines[i]) temp=paste(temp,"|",sep="")
if(i>nchar(result)) break
temp=paste(temp,substr(result,start=i,stop=i),sep="")
}
#temp=paste(temp,"c",sep="")
temp
}
#' print html style
#' @param z An object of ztable
#' @export
myhtmlStyle=function(z){
if(is.null(z$family)) family="times"
else family=z$family
cat("<head>")
cat("<style>
table {
font-family:",family,";\n")
cat("color: ",z$color,";\n")
#cat("border: ",z$color," 1px solid;\n")
cat("text-align: right;}
th {
padding: 1px 1px 5px 5px;
}
td {
padding: 1px 1px 5px 5px; }
</style>")
cat("</head>")
}
#' Print HTML head if ztable object a has a colgroup
#'
#' @param z An object of ztable
#' @export
printHTMLHead=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)
cGroupSpan
totalCol=totalCol(z)
totalCol
vlines=align2lines(z$align)
for(i in 1:length(z$cgroup)){
cat("<tr>\n")
if(z$include.rownames) {
cat("<td style=\"")
if(i==1) cat("border-top: 2px solid gray; border-bottom: hidden;")
cat(paste(" border-left: ",vlines[1],"px solid black;",sep=""))
if(z$cgroupbg[[i]][1]!="white")
cat(paste("background-color: ",name2rgb(z$cgroupbg[[i]][1]),sep=""))
if(z$cgroupcolor[[i]][1]!=z$color)
cat(paste("color: ",name2rgb(z$cgroupcolor[[i]][1]),";",sep=""))
cat("\"> </td>\n")
}
colSum=1
for(j in 1:length(z$cgroup[[i]])) {
if(is.na(z$cgroup[[i]][j])) {
cat("<td colspan=\"",cGroupSpan[[i]][j],"\" align=\"center\" ")
cat("style=\"")
if(i==1) cat("border-top: 2px solid gray;")
cat("border-bottom: hidden;")
cat(paste(" border-left: ",vlines[colSum+1],"px solid black;",sep=""))
colSum=colSum+cGroupSpan[[i]][j]
#if(colSum==ncol(z$x)+1)
cat(paste("border-right:",vlines[colSum+1],"px solid black;",sep=""))
if(z$cgroupbg[[i]][j+1]!="white")
cat(paste("background-color: ",name2rgb(z$cgroupbg[[i]][j+1]),";",sep=""))
if(z$cgroupcolor[[i]][j+1]!=z$color)
cat(paste("color: ",name2rgb(z$cgroupcolor[[i]][j+1]),";",sep=""))
cat(paste("\"></td>\n",sep=""))
} else {
cat("<td colspan=\"",cGroupSpan[[i]][j],"\" align=\"center\" ")
if(z$colnames.bold) cat("style=\"font-weight: bold;")
else cat("style=\"font-weight: normal;")
if(i==1) cat("border-top: 2px solid gray;")
if(z$cgroup[[i]][j]!="") cat(" border-bottom: 1px solid gray;")
else cat(" border-bottom: hidden;")
cat(paste(" border-left: ",vlines[colSum+1],"px solid black;",sep=""))
colSum=colSum+cGroupSpan[[i]][j]
if(colSum==ncol(z$x)+1)
cat(paste("border-right:",vlines[colSum+1],"px solid black;",sep=""))
if(z$cgroupbg[[i]][j+1]!="white")
cat(paste("background-color: ",name2rgb(z$cgroupbg[[i]][j+1]),";",sep=""))
if(z$cgroupcolor[[i]][j+1]!=z$color)
cat(paste("color: ",name2rgb(z$cgroupcolor[[i]][j+1]),";",sep=""))
cat(paste("\">",z$cgroup[[i]][j],"</td>\n",sep=""))
}
#if((j < ncol(z$cgroup)) & ((colSum+j-1)<totalCol)) {
if(j < length(z$cgroup[[i]])) {
result=colSum+1
if(result<=length(vlines)) {
if(vlines[result]==0){
cat("<td style=\"")
if(i==1) cat("border-top: 2px solid gray;")
cat("border-bottom: hidden\"> </td>\n")
}
}
}
}
cat("</tr>\n")
}
}
#' Print an object of class "ztable" to html table
#'
#' @param z An object of class "ztable"
#' @param xdata A formatted data.frame
ztable2html=function(z,xdata){
ncount=ncol(z$x)
addrow=ifelse(z$include.rownames,1,0)
# caption position
if(z$caption.position=="r") cposition="right"
else if(z$caption.position=="l") cposition="left"
else cposition="center"
fontsize=ifelse(z$size>=5,11+(z$size-5)*2,10-(4-z$size))
headingsize=fontsize-2
rgroupcount=0
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])
}
}
rgroupcount=1
}
NewAlign=getNewAlign(z)
totalCol=totalCol(z)
colCount=colGroupCount(z)
# rgroupcount=0
# 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])
# }
# }
# rgroupcount=1
# }
# table position
if(z$position=="flushleft") tposition="left"
else if(z$position=="flushright") tposition="right"
else tposition="center"
#cat("<table class='gmisc_table'")
myhtmlStyle(z)
cat("<table ")
cat(paste("align=\"",tposition,"\" style=\"border-collapse: collapse; caption-side:",
z$caption.placement,"; font-size:",as.integer(fontsize),"pt;\">",sep=""))
cat(paste("<caption style=\"text-align:",cposition,";",sep=""))
if(z$caption.bold) cat("font-weight: bold")
cat(paste("\">",z$caption,"</caption>",sep=""))
if((z$show.heading==TRUE) & (!is.null(attr(z$x,"heading")))) {
head=attr(z$x,"heading")
for(i in 1:length(head)) {
if(nchar(head[i])<1) next
cat(paste("<tr>\n<td style=\"border-top: hidden; font-size: ",
as.integer(headingsize),"pt; padding: 0px 0px;\" colspan=\"",ncount+addrow,
"\" align=\"left\" >",head[i],sep=""))
cat("</td>\n</tr>\n")
}
}
vlines=align2lines(z$align)
printtop=1
if(!is.null(z$cgroup)) {
printHTMLHead(z)
printtop=0
}
if(z$include.colnames) {
cat("<tr>\n")
subcolnames=ifelse(is.null(z$subcolnames),0,1)
if(z$include.rownames) {
result=1
if(!is.null(isspanCol(z,1,1)))
cat(paste("<th colspan=\"",isspanCol(z,1,1),"\"",sep=""))
else if(!is.null(isspanRow(z,1,1))){
result=isspanRow(z,1,1)
if(result>0) cat(paste("<th rowspan=\"",result,"\"",sep=""))
} else cat("<th ")
cat(paste("style=\"border-left: ",vlines[1],
"px solid black;",
"background-color: ",name2rgb(z$cellcolor[1,1]),";",sep=""))
if(printtop) cat("border-top: 2px solid gray;")
if(subcolnames==0) cat("border-bottom: 1px solid gray;")
else cat("border-bottom: hidden;")
cat(paste("\"> </th>\n",sep=""))
}
colpos=align2html(z$align)
for(i in 1:ncol(z$x)) {
result=1
if(!is.null(isspanCol(z,1,(i+1)))){
result=isspanCol(z,1,(i+1))
if(result>0) cat(paste("<th colspan=\"",result,"\"",sep=""))
else if(result==0) next
} else if(!is.null(isspanRow(z,1,(i+1)))){
result=isspanRow(z,1,(i+1))
if(result>0) cat(paste("<th rowspan=\"",isspanRow(z,1,(i+1)),"\"",sep=""))
else cat("<th")
} else cat("<th ")
if(result!=0){
cat("<th ")
drawbottom=0
if((subcolnames==1)) {
if(is.na(z$subcolnames[i])){
cat("rowspan=\"2\" ")
drawbottom=1
}
}
cat(paste("align=\"center\" ",sep=""))
if(z$colnames.bold) cat("style=\"font-weight: bold;")
else cat("style=\"font-weight: normal;")
cat(paste("border-left: ",vlines[i+1],"px solid black;",sep=""))
if((i==ncol(z$x)) & (length(vlines)>ncol(z$x)+1))
cat(paste("border-right:",vlines[i+2],"px solid black;",sep=""))
if((subcolnames==0) | (subcolnames+drawbottom==2))
cat("border-bottom: 1px solid gray;")
else cat("border-bottom: hidden;")
if(printtop) cat("border-top: 2px solid gray;")
if(z$cellcolor[1,i+1]!="white")
cat(paste("background-color: ",name2rgb(z$cellcolor[1,i+1]),";",sep=""))
if(z$frontcolor[1,i+1]!=z$color)
cat(paste("color: ",name2rgb(z$frontcolor[1,i+1]),";",sep=""))
cat(paste("\">",colnames(z$x)[i],"</th>\n",sep=""))
if(i %in% colCount[-length(colCount)]) {
if(vlines[i+2]==0){
if(subcolnames==0) cat("<th style=\"border-bottom: 1px solid gray;")
else cat("<th style=\"border-bottom: hidden;")
if(printtop) cat("border-top: 2px solid gray; ")
if((z$cellcolor[1,i+1]!="white") & (z$cellcolor[1,i+1]==z$cellcolor[1,i+2]))
cat("background-color: ",name2rgb(z$cellcolor[1,i+1]),";")
cat("\"> </th>\n")
}
}
}
}
cat("</tr>\n")
printtop=0
if(subcolnames){
cat("<tr>\n")
if(addrow) {
cat(paste("<th style=\"border-left: ",vlines[1],
"px solid black;","border-bottom: 1px solid gray;",
"background-color: ",name2rgb(z$cellcolor[1,1]),";",sep=""))
cat(paste("\"> </th>\n",sep=""))
}
for(i in 1:length(z$subcolnames)){
if(is.na(z$subcolnames[i])) {
if(vlines[i+2]==0){
if(i!=length(z$subcolnames)){
cat("<th style=\"border-bottom: 1px solid gray;")
#if(printtop) cat("border-top: 2px solid gray;")
if((z$cellcolor[1,i+1]!="white") & (z$cellcolor[1,i+1]==z$cellcolor[1,i+2]))
cat("background-color: ",name2rgb(z$cellcolor[1,i+1]),";")
cat("\"> </th>\n")
}
}
next
}
cat("<th align=\"center\" ")
if(z$colnames.bold) cat("style=\"font-weight: bold;")
else cat("style=\"font-weight: normal;")
cat(paste("border-left: ",vlines[i+1],"px solid black;",sep=""))
if((i==ncol(z$x)) & (length(vlines)>ncol(z$x)+1))
cat(paste("border-right:",vlines[i+2],"px solid black;",sep=""))
cat("border-bottom: 1px solid gray;")
if(z$cellcolor[1,i+1]!="white")
cat(paste("background-color: ",name2rgb(z$cellcolor[1,i+1]),";",sep=""))
if(z$frontcolor[1,i+1]!=z$color)
cat(paste("color: ",name2rgb(z$frontcolor[1,i+1]),";",sep=""))
cat(paste("\">",z$subcolnames[i],"</th>\n",sep=""))
if(i %in% colCount[-length(colCount)]) {
if(vlines[i+2]==0){
cat("<th style=\"border-bottom: 1px solid gray;")
#if(printtop) cat("border-top: 2px solid gray;")
if((z$cellcolor[1,i+1]!="white") & (z$cellcolor[1,i+1]==z$cellcolor[1,i+2]))
cat("background-color: ",name2rgb(z$cellcolor[1,i+1]),";")
cat("\"> </th>\n")
}
}
}
cat("</tr>\n")
}
}
colpos=align2html(z$align)
addrow=ifelse(z$include.rownames,1,0)
addrow
rgroupprinted=0
for(i in 1:nrow(z$x)){
if(rgroupcount>0) {
if(i %in% printrgroup) {
rgroupprinted=1
if(is.null(z$cspan.rgroup)){
temp=paste("<tr>\n<td colspan=\"",totalCol,
"\" align=\"left\""," style=\"font-weight: bold;",sep="")
if(z$rgroupbg[rgroupcount]!="white")
temp=paste(temp,"background-color:",name2rgb(z$rgroupbg[rgroupcount]),";",sep="")
if(z$rgroupcolor[rgroupcount]!="black")
temp=paste(temp,"color:",name2rgb(z$rgroupcolor[rgroupcount]),";",sep="")
temp=paste(temp," border-left: ",vlines[1],"px solid black; ",sep="")
temp=paste(temp,"border-right:",vlines[ncol(z$x)+2],"px solid black;",sep="")
temp=paste(temp,"border-bottom: 1px solid black;",sep="")
temp=paste(temp,"border-top: 1px solid black;",sep="")
temp=paste(temp,"\">",z$rgroup[rgroupcount],"</td>\n",sep="")
}
else {
if(z$cspan.rgroup==1) {
temp=paste("<tr>\n<td align=\"left\""," style=\"font-weight: bold;",sep="")
# if(z$colcolor[1]!="white")
# temp=paste(temp,"background-color:",name2rgb(z$colcolor[1]),";",sep="")
if(z$rgroupbg[rgroupcount]!="white")
temp=paste(temp,"background-color:",name2rgb(z$rgroupbg[rgroupcount]),";",sep="")
if(z$rgroupcolor[rgroupcount]!="black")
temp=paste(temp,"color:",name2rgb(z$rgroupcolor[rgroupcount]),";",sep="")
temp=paste(temp," border-left: ",vlines[1],"px solid black; ",sep="")
#temp=paste(temp,"border-bottom: 1px solid black;",sep="")
if(i!=1) temp=paste(temp,"border-top: hidden; ",sep="")
if(!is.null(z$hline.after)){
if((i-1) %in% z$hline.after)
temp=paste(temp,"border-top: 1px solid black;")
}
temp=paste(temp,"\">",z$rgroup[rgroupcount],"</td>\n",sep="")
for(j in 1:(ncount+addrow-1)){
temp1=paste("<td style=\"border-left: ",
vlines[j+1],"px solid black; ",sep="")
if(!is.null(z$hline.after)){
if((i-1) %in% z$hline.after)
temp1=paste(temp1,"border-top: 1px solid black;")
}
else if(i!=1) temp1=paste(temp1,"border-top: hidden; ",sep="")
if((j==ncol(z$x)) & (length(vlines)>ncol(z$x)+1))
temp1=paste(temp1,"border-right:",vlines[j+2],"px solid black;",sep="")
if(!is.null(z$colcolor)) {
if(z$colcolor[j+1]!="white")
temp1=paste(temp1,"background-color:",
name2rgb(z$colcolor[j+1])," ",sep="")
}
temp1=paste(temp1,"\"></td>\n",sep="")
if(is.null(isspanRow(z,i+1,j+1))) temp=paste(temp,temp1,sep="")
else if(isspanRow(z,i+1,j+1)>0) temp=paste(temp,temp1,sep="")
if(!is.null(colCount)){
if(j %in% colCount[-length(colCount)]) {
if(vlines[j+2]==0){
#if((z$cellcolor[i+1,j+1]!="white")&(z$cellcolor[i+1,j+1]==z$cellcolor[i+1,j+2]))
# temp=paste(temp,"<td style=\"background-color: ",
# name2rgb(z$cellcolor[i+1,j+1]),"\"></td>\n",
# sep="")
#else temp=paste(temp,"<td></td>\n",sep="")
temp=paste(temp,"<td",sep="")
if(i!=1) temp=paste(temp,"style=\"border-top: hidden;\"")
temp=paste(temp,"></td>\n",sep="")
}
}
}
}
} else {
if(z$cspan.rgroup<1 | z$cspan.rgroup>(ncount+addrow))
z$cspan.rgroup=ncount+addrow
temp=paste("<tr>\n<td colspan=\"",z$cspan.rgroup,
"\" align=\"left\""," style=\"font-weight: bold;",sep="")
# if(z$colcolor[1]!="white")
# temp=paste(temp,"background-color:",name2rgb(z$colcolor[1]),";",sep="")
if(z$rgroupbg[rgroupcount]!="white")
temp=paste(temp,"background-color:",name2rgb(z$rgroupbg[rgroupcount]),";",sep="")
if(z$rgroupcolor[rgroupcount]!="black")
temp=paste(temp,"color:",name2rgb(z$rgroupcolor[rgroupcount]),";",sep="")
temp=paste(temp," border-left: ",vlines[1],"px solid black; ",sep="")
temp=paste(temp,"border-bottom: 1px solid black;",sep="")
temp=paste(temp,"border-top: 1px solid black;",sep="")
if(!is.null(z$hline.after)){
if((i-1) %in% z$hline.after)
temp=paste(temp,"border-top: 1px solid black;")
}
temp=paste(temp,"\">",z$rgroup[rgroupcount],"</td>\n",sep="")
if(z$cspan.rgroup<(ncount+addrow)) {
for(j in (z$cspan.rgroup):(ncount+addrow-1)) {
temp1=paste("<td style=\"border-left: ",
vlines[j+1],"px solid black; ",sep="")
if((j==ncol(z$x)) & (length(vlines)>ncol(z$x)+1))
temp1=paste(temp1,"border-right:",vlines[j+2],"px solid black;",sep="")
#temp1=paste(temp1,"border-bottom: 1px solid black;",sep="")
#temp1=paste(temp1,"border-top: 1px solid black;",sep="")
if(!is.null(z$hline.after)){
if((i-1) %in% z$hline.after)
temp1=paste(temp1,"border-top: 1px solid black;")
}
else if(i!=1) temp1=paste(temp1,"border-top: hidden; ",sep="")
if(!is.null(z$colcolor)) {
if(z$colcolor[j+1]!="white")
temp1=paste(temp1,"background-color:",
name2rgb(z$colcolor[j+1])," ",sep="")
}
temp1=paste(temp1,"\"></td>\n",sep="")
if(is.null(isspanRow(z,i+1,j+1))) temp=paste(temp,temp1,sep="")
else if(isspanRow(z,i+1,j+1)>0) temp=paste(temp,temp1,sep="")
if(!is.null(colCount)){
if(j %in% colCount[-length(colCount)]) {
if(vlines[j+2]==0) {
#if((z$cellcolor[i+1,j+1]!="white")&(z$cellcolor[i+1,j+1]==z$cellcolor[i+1,j+2]))
# temp=paste(temp,"<td style=\"background-color: ",
# name2rgb(z$cellcolor[i+1,j+1]),"\"></td>\n",
# sep="")
#else temp=paste(temp,"<td></td>\n",sep="")
if(i!=1) temp=paste(temp,"<td style=\"border-top: hidden;\"",sep="")
else temp=paste(temp,"<td",sep="")
temp=paste(temp,"></td>\n")
}
}
}
}
}
}
}
cat(temp,"</tr>\n")
rgroupcount=rgroupcount+1
}
}
bcolor="white"
#if(i %in% z$prefix.rows)
# if(is.numeric(z$zebra)) bcolor=z$zebra.color[i]
# cat("<tr style=\"background-color:",name2rgb(bcolor),"\">")
cat("<tr>\n")
if(z$include.rownames) {
result=1
if(!is.null(isspanCol(z,(i+1),1)))
cat(paste("<td colspan=\"",isspanCol(z,i+1,1),"\"",sep=""))
else if(!is.null(isspanRow(z,(i+1),1))){
result=isspanRow(z,(i+1),1)
if(result>0) cat(paste("<td rowspan=\"",result,"\"",sep=""))
} else cat("<td ")
if(result>0){
#cat("result=",result,"\n")
cat(paste(" style=\"border-left: ",vlines[1],"px solid black; ",sep=""))
if(i==1 & printtop) cat("border-top: 2px solid gray;")
else if(i!=1 | rgroupprinted) cat("border-top: hidden;")
if(!is.null(z$hline.after)){
if((i-1) %in% z$hline.after)
if(!(i %in% printrgroup)) cat("border-top: 1px solid black;")
}
if(z$cellcolor[i+1,1]!="white")
cat(paste("background-color: ",name2rgb(z$cellcolor[i+1,1]),"; ",sep=""))
if(z$frontcolor[i+1,1]!=z$color)
cat(paste("color: ",name2rgb(z$frontcolor[i+1,1]),"; ",sep=""))
cat(paste("\">",rownames(z$x)[i],"</td>\n",sep=""))
}
}
for(j in 1:ncount) {
if(is.null(isspanCol(z,(i+1),(j+1)))){
if(is.null(isspanRow(z,(i+1),(j+1)))){
result=-1
cat("<td ")
} else {
result=isspanRow(z,(i+1),(j+1))
if(result > 0) {
cat("<td rowspan=\"",result,"\" ")
}
}
if((result==-1)|(result>1)){
cat(paste("align=\"",colpos[j+addrow],"\" style=\"border-left: ",
vlines[j+1],"px solid black;",sep=""))
if((j==ncol(z$x)) & (length(vlines)>ncol(z$x)+1))
cat(paste("border-right:",vlines[j+2],"px solid black;",sep=""))
if(i==1 & printtop) cat("border-top: 2px solid gray;")
else if(i!=1 | rgroupprinted) cat("border-top: hidden;")
if(!is.null(z$hline.after)){
if((i-1) %in% z$hline.after)
if(!(i %in% printrgroup)) cat("border-top: 1px solid black;")
}
if(z$cellcolor[i+1,j+1]!="white")
cat(paste("background-color: ",name2rgb(z$cellcolor[i+1,j+1]),";",sep=""))
if(z$frontcolor[i+1,j+1]!=z$color)
cat(paste("color: ",name2rgb(z$frontcolor[i+1,j+1]),";",sep=""))
cat("\">")
cat(paste(xdata[i,j],"</td>\n",sep=""))
}
if(j %in% colCount[-length(colCount)]) {
if(vlines[j+2]==0) {
backcolor=NULL
if(!is.null(z$rowcolor)){
if(z$rowcolor[i+1]!="white") backcolor=z$rowcolor[i+1]
}
if(is.null(backcolor)){
if((z$cellcolor[i+1,j+1]!="white")&(z$cellcolor[i+1,j+1]==z$cellcolor[i+1,j+2]))
backcolor=z$cellcolor[i+1,j+1]
}
cat("<td style=\"")
if(i==1 & printtop) cat("border-top: 2px solid gray;")
else if(i!=1 | rgroupprinted) cat("border-top: hidden;")
if(!is.null(backcolor)) cat(" background-color: ",name2rgb(backcolor),";")
cat("\"></td>\n")
}
}
} else {
result=isspanCol(z,(i+1),(j+1))
if(result>0) {
width=spanColWidth(z,(i+1),(j+1))
cat(paste("<td colspan=\"",result,"\" align=\"",colpos[j+addrow],"\" style=\"border-left: ",
vlines[j+1],"px solid black;",sep=""))
#if((j==ncol(z$x)) & (length(vlines)>ncol(z$x)+1))
cat(paste("border-right:",vlines[j+width+1],"px solid black;",sep=""))
if(i==1 & printtop) cat("border-top: 2px solid gray;")
else if(i!=1 | rgroupprinted) cat("border-top: hidden;")
if(!is.null(z$hline.after)){
if((i-1) %in% z$hline.after)
if(!(i %in% printrgroup)) cat("border-top: 1px solid black;")
}
if(z$cellcolor[i+1,j+1]!="white")
cat(paste("background-color: ",name2rgb(z$cellcolor[i+1,j+1]),";",sep=""))
if(z$frontcolor[i+1,j+1]!=z$color)
cat(paste("color: ",name2rgb(z$frontcolor[i+1,j+1]),";",sep=""))
cat("\">")
cat(paste(xdata[i,j],"</td>\n",sep=""))
if(isGroupCol(j,result,colCount)) {
if(vlines[j+width+1]==0) {
cat("<td style=\"")
if(i==1 & printtop) cat("border-top: 2px solid gray;")
else if(i!=1 | rgroupprinted) cat("border-top: hidden;")
if(!is.null(backcolor)) cat(" background-color: ",name2rgb(backcolor),";")
cat("\"></td>\n")
}
}
}
}
}
cat("</tr>\n")
}
if((z$show.footer!=TRUE) | (is.null(attr(z$x,"footer")))) footer=""
else footer=attr(z$x,"footer")
cat("<tr>\n")
cat(paste("<td colspan=\"",totalCol,
"\" align=\"left\" style=\"font-size:",as.integer(headingsize),
"pt ;border-top: 1px solid black; border-bottom: hidden;\">",footer,"</td>\n",sep=""))
cat("</tr>\n")
cat("</table>\n")
}
#' Print an object of ztable via rstudioapi::viewer
#'
#' @param z An object of ztable
#' @importFrom rstudioapi viewer
#' @importFrom utils browseURL
ztable2viewer=function(z){
temp.f=tempfile(fileext=".html")
sink(temp.f)
cat(paste("<html>",
"<head>",
"<meta http-equiv=\"Content-type\" content=\"text/html;charset=UTF-8\">",
"</head>",
"<body>",
"<div style=\"margin: 0 auto; display: table; margin-top: 1em;\">",
sep="\n"))
print(z,type="html")
cat(paste("</div>","</body>","</html>",sep="\n"))
sink()
viewer <- getOption("viewer")
if (!is.null(viewer)){
rstudioapi::viewer(temp.f)
} else{
if(is.character(temp.f)) utils::browseURL(temp.f)
}
}
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.