.fable.pipes.constructor <- function(x, DEBUG=F) {
x.orig <- x
align <- attr(x, "ALIGN")
row_span <- attr(x, "ROW.SPAN")
lines <- attr(x,"LINES")
max.lines.per.col <- attr(x,"MAX_LINES_PER_COL")
col.divisor.char <- attr(x,"COL.DIVISOR")
row.divisor.char <- attr(x,"ROW.DIVISOR")
titles.rows <- attr(x,"TITLES.ROW")
titles.col <- attr(x,"TITLES.COL")
titles.rows.separa <- attr(x,"TITLES.ROW.SEPARA")
titles.col.separa <- attr(x,"TITLES.COL.SEPARA")
titles.row.divisor.char = attr(x, "TITLES.ROW.DIVISOR.CHAR")
titles.col.divisor.char = attr(x, "TITLES.COL.DIVISOR.CHAR")
padding <- attr(x, "PADDING")
padding.char <- attr(x, "PADDING.CHAR")
x <- attr(x,"FINAL")
if (DEBUG) cat("\n [.fable.pipes.constructor] ", class(x), " \n")
x <- .pad_array(x, align = align, padding = padding, padding.char = padding.char,
DEBUG = DEBUG)
max_char_per_col <- attr(x,"MAX_CHAR_PER_COL")
final <- c()
# print(row_span)
for (r in seq_len(nrow(x))) {
r.temp.span <- c()
cont.span = 0
nchar.span = c()
t.linea <- c()
top.linea <- c()
bot.linea <- c()
line.has.top = .fable.lines.has.line.in.row(x.orig,row = r, line = "t")
line.has.bot = .fable.lines.has.line.in.row(x.orig,row = r, line = "b")
row.title = FALSE
# prev.linea.celda = ""
prev.texto.celda = ""
prev.span.celda = 1
temp.texto.celda = ""
span.total.char = 0
for (c in seq_len(ncol(x))) {
PRINT.CELDA = FALSE
CIERRA.SPAN = FALSE
CONTINUA.SPAN = FALSE
linea.celda <- lines[r,c]
texto.celda <- x[r,c]
span.celda <- row_span[r,c]
# print(span.celda)
if (span.celda == 1) {
PRINT.CELDA = TRUE
if (prev.span.celda == 0) CIERRA.SPAN = TRUE
} else if (span.celda > 1) {
inicio.span.linea = linea.celda
inicio.span.col = c
if (prev.span.celda != 0) {
temp.texto.celda = texto.celda
span.total.char = max_nchar(texto.celda)
} else {
CIERRA.SPAN = TRUE
CONTINUA.SPAN = TRUE
}
} else if (span.celda == 0) {
temp.texto.celda = paste0(temp.texto.celda," ", texto.celda)
span.total.char = span.total.char + max_nchar(texto.celda) + ((padding*2) - 1)
texto.celda = ""
}
if ((c == ncol(x)) & (temp.texto.celda != "")) CIERRA.SPAN = TRUE
# cat("\nR: ",r," C:",c," CIERRA.SPAN:",CIERRA.SPAN," SPAN:",span.celda," TEXTO:",texto.celda,"\n")
if (CIERRA.SPAN) {
PRINT.CELDA = TRUE
print.texto = temp.texto.celda #.... el que viene acumulado
temp.texto.celda = texto.celda
texto.celda = print.texto
span.col.diff <- c - inicio.span.col
max_char_span <- sum(max_char_per_col[inicio.span.col:c]) + #... total de LETRAS en todas las columnas
((span.col.diff)*(padding*2)) + #.... total de padding
(span.col.diff * nchar(col.divisor.char))#.... total de columnas (por los divisores)
texto.celda <- .pad_cell(trimws(print.texto), max_char = max_char_span, align = align[r,c], padding = padding, padding.char = padding.char)
linea.celda = paste0(unique_chars(paste0(inicio.span.linea,linea.celda, collapse = "")),collapse = "")
}
if (PRINT.CELDA) {
col.title = ( (c %in% titles.col) & (c %in% titles.col.separa) )
row.title = ((r %in% titles.rows) & (r %in% titles.rows.separa))
if (col.title) temp.col.divisor = titles.col.divisor.char
else temp.col.divisor = col.divisor.char
if (row.title) temp.row.divisor = titles.row.divisor.char
else temp.row.divisor = row.divisor.char
if (grepl("t",linea.celda, fixed = TRUE)) {
if (grepl("l",linea.celda, fixed = TRUE)) top.linea <- c(top.linea,temp.col.divisor)
top.linea <- c(top.linea,rep(temp.row.divisor,times = max_nchar(texto.celda)))
if (grepl("r",linea.celda, fixed = TRUE)) top.linea <- c(top.linea,temp.col.divisor)
} else if (line.has.top) {
if (grepl("l",linea.celda, fixed = TRUE)) top.linea <- c(top.linea,temp.col.divisor)
top.linea <- c(top.linea,rep(" ",times = max_nchar(texto.celda)))
if (grepl("r",linea.celda, fixed = TRUE)) top.linea <- c(top.linea,temp.col.divisor)
}
if (grepl("b",linea.celda, fixed = TRUE)) {
if (grepl("l",linea.celda, fixed = TRUE)) bot.linea <- c(bot.linea,temp.col.divisor)
bot.linea <- c(bot.linea,rep(temp.row.divisor,times = max_nchar(texto.celda)))
if (grepl("r",linea.celda, fixed = TRUE)) bot.linea <- c(bot.linea,temp.col.divisor)
} else if (line.has.bot) {
if (grepl("l",linea.celda, fixed = TRUE)) bot.linea <- c(bot.linea,temp.col.divisor)
bot.linea <- c(bot.linea,rep(" ",times = max_nchar(texto.celda)))
if (grepl("r",linea.celda, fixed = TRUE)) bot.linea <- c(bot.linea,temp.col.divisor)
}
if (grepl("l",linea.celda, fixed = TRUE)) t.linea <- c(t.linea,temp.col.divisor)
t.linea <- c(t.linea,texto.celda)
if (grepl("r",linea.celda, fixed = TRUE)) t.linea <- c(t.linea,temp.col.divisor)
}#........ fin PRINT.CELDA
if (CIERRA.SPAN & !CONTINUA.SPAN) temp.texto.celda = ""
prev.texto.celda <- texto.celda
# prev.line.celda <- linea.celda
prev.span.celda <- span.celda
}
#..... fin for column
if (length(top.linea) > 0) final <- c(final,paste0(top.linea, collapse = ""))
final <- c(final,paste0(t.linea, collapse = ""))
if (length(bot.linea) > 0) final <- c(final,paste0(bot.linea, collapse = ""))
}#.... fin for row
final
}
.fable.pipes <- function(x, DEBUG = F) {
x.final <- .fable.pipes.constructor(x)
cat(x.final,sep = "\n")
}
.fable.html <- function(x,DEBUG=F) {
align <- attr(x, "ALIGN")
row_span <- attr(x, "ROW.SPAN")
lines <- attr(x,"LINES") #..... para luego
col.divisor.char <- attr(x,"COL.DIVISOR")
titles.rows <- attr(x,"TITLES.ROW")
titles.col <- attr(x,"TITLES.COL")
titles.rows.separa <- attr(x,"TITLES.ROW.SEPARA")
titles.col.separa <- attr(x,"TITLES.COL.SEPARA")
titles.row.divisor.char = attr(x, "TITLES.ROW.DIVISOR.CHAR")
titles.col.divisor.char = attr(x, "TITLES.COL.DIVISOR.CHAR")
padding <- attr(x, "PADDING")
padding.char <- attr(x, "PADDING.CHAR")
x <- attr(x,"FINAL")
x <- .pad_array(x, align = align, padding = padding, padding.char = padding.char,
DEBUG = DEBUG)
final <- paste0("<table style='width:100%; margin: 0px auto;'>")
for (r in seq_len(nrow(x))) {
row.style = ""
if (r %in% titles.rows.separa) {
row.style <- "border-bottom: 1px solid;"
final <- c(final,paste0("<tr style='",row.style,"'>"))
} else final <- c(final,paste0("<tr",row.style,">"))
for (c in seq_len(ncol(x))) {
style = paste0(" style='padding:",padding,"px; border-spacing: 10px;")
# style = paste0(" style='")
col.style = ""
align.style = ""
tag = ""
align.rc = align[r,c]
# cat("\n ALIGN" ,align.rc)
if (c %in% titles.col.separa) col.style = " border-right:1px solid;"
if (align.rc == "left") align.style = " text-align: left;"
else if (align.rc == "right") align.style = " text-align: right;"
else if (align.rc == "center") align.style = " text-align: center;"
if ((r %in% titles.rows) || (c %in% titles.col)) {
tag = "<th"
end.tag = "</th>"
}
else {
tag = "<td"
end.tag = "</td>"
}
final <- c(final,paste0(tag,style,row.style,col.style,align.style,"'>"),x[r,c],end.tag)
}
final <- c(final,"</tr>")
}
final <- c(final,"</table>")
final <- paste0(final,collapse = "")
cat(final,sep = "\n")
}
#' @export
print.feR.fable <- function(x) {
type <- attr(x,"type")
if (type == "auto") {
salida <- knitr::pandoc_to()
consola <- is.null(salida)
} else {
consola <- (type == "pipe")
}
# attr(result,"CONSOLA") <- consola
# cat("\n ------ CONSOLA: ",consola," \n")
if (is.null(consola)) consola <- TRUE
DEBUG <- attr(x, "DEBUG")
end.recursion = FALSE
if ("END.RECURSION" %in% names(attributes(x))) end.recursion = attr(x,"END.RECURSION")
if (is.feR.object(x) & !is.feR.fable(x)) {
if (end.recursion) {
if (consola) .fable.pipes(fable(x), DEBUG = DEBUG)
else .fable.html(x, DEBUG = DEBUG)
}
else {
x.p <- x
class(x.p) <- class(x.p)[-1]
print(x.p)
}
} else {
if (consola) .fable.pipes(x, DEBUG = DEBUG)
else .fable.html(x, DEBUG = DEBUG)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.