## #+TITLE:
## #+AUTHOR: Emilio Torres Manzanera
## #+DATE: Time-stamp: <2026-05-12 16:22 emilio on emilio-XPS-15-9570>
## #+TAGS:
## #+PROPERTY: header-args :results output :exports both :session


## pdf_table_page <- function(pdffile, # Fichero pdf
##                            page, # página que queremos extraer
##                            alltables=FALSE, # Extrae toda la página (TRUE) o solo la tabla principal (FALSE)
##                            gaprows = NULL, # Separador entre líneas. Prueba con gaprows 4L o 5L si no funciona a la primera
##                            verbose = 0L)


suppressMessages(require(data.table))
require(pdftools)


plot_array <- function(image,rowlimits=c(1L,dim(image)[1]),collimits=c(1L,dim(image)[2]),...){
    par(mai=c(0,0,0,0),bty="n",bty = "n", xaxs = "i", yaxs = "i", xaxt = "n", yaxt = "n", col = "white") # margins
    plot(collimits, rowlimits, type = "n", xlab = "", ylab = "",...)
    rasterImage(image, 1, 1, dim(image)[2], dim(image)[1],...)
}


get_blocks_runs_true_false <- function(vec, max_gap_false = 0L){
    if (!is.logical(vec) || !is.vector(vec) || length(vec) == 0L) {
        stop(sprintf("`vec` must be a logical vector. It represents the runs of TRUE and FALSE of some events. As example: Has this position information?"))
    }
    if (anyNA(vec)) {
        stop(sprintf("`vec` must not contain any NA values."))
    }
    if(!is.numeric(max_gap_false) || length(max_gap_false)> 1L || is.na(max_gap_false) || max_gap_false < 0L) {
        print(max_gap_false)
        stop(sprintf("`max_gap_false` must be a integer value non negative (%s). It represents the maximun number of FALSEs to be included in the previous run of TRUEs.",class(max_gap_false)))
    }
    max_gap_false <- as.integer(max_gap_false)
    r <- rle(vec)
    nms <- c("value","length","start","end","merge_gap","group_id")
    m <- matrix(0L,nrow=length(r$values), ncol=length(nms),dimnames=list(NULL,nms))
    m[,"value"]  <- as.integer(r$values)
    m[,"length"]  <- r$lengths
    m[,"start"] <- c(1L, cumsum(r$lengths)[-length(r$lengths)] + 1L)
    m[,"end"] <- cumsum(r$lengths)
    m[,"merge_gap"] <- (m[,"value"] == 0L &
                        m[,"length"] <= max_gap_false &
                        c(m[-1L,"value"],0L) == 1L &
                        c(0L,m[-nrow(m),"value"]) == 1L)
    m[,"group_id"]  <- cumsum(m[,"value"]  & !c(0L,m[-nrow(m),"merge_gap"]))
    ## Agrupar por bloques
    agruparporbloques <- function(m){
        if(nrow(m) == 0L) return(matrix(NA,nrow=0L,ncol=4L, dimnames=list(NULL,c("group_id","start","end","n"))))
        idx_m_filtered_group <- split(seq_len(nrow(m)), m[, "group_id"])
        result <- vapply(idx_m_filtered_group, function(rows) {
            group_mat <- m[rows, ,drop = FALSE]
            start  <-  min(group_mat[,"start"])
            end  <-  max(group_mat[,"end"])
            c(group_mat[1L, "group_id"], start = start, end = end, n= end-start +1L)
        },FUN.VALUE=c(1L,1L,1L,1L),USE.NAMES=TRUE)
        t(result)
    }
    f <- m[, "value"] | m[, "merge_gap"]
    list(
        trueblocks  = agruparporbloques(m[f,,drop=FALSE]),
        falseblocks = agruparporbloques(m[!f,,drop=FALSE])
    )

}






## ============================================================
## Convertir european currency to us currency
## ============================================================

european_to_us_currency <- function(x) {
    ## Identify European formatted numbers: optional minus, digits,
    is_european <- grepl("^[-+]?[0-9]{1,3}(?:\\.[0-9]{3})*(?:,[0-9]+)?$", x, perl = TRUE)
    result <- x
    result[is_european] <- gsub(".", "", x =result[is_european],fixed=TRUE)
    result[is_european] <- gsub(",", ".", x =result[is_european])
    result
}

european_to_us_date <- function(x) {
    x <- as.character(x)
    ## Check format with regex: dd/mm/yyyy (allows 1 or 2 digits for day/month)
    pattern <- "^([0-9]{1,2})/([0-9]{1,2})/([0-9]{4})$"
    is_european <- grepl(pattern, x, perl = TRUE)
    result <- x
    result[is_european] <-  as.character(as.Date(x[is_european], format = "%d/%m/%Y"))
    result
}

guess_type_column <- function(x) {
    if(is.logical(x)) return(x)
    if(is.integer(x)) return(x)
                                        # Try Date first
    d <- try(as.Date(x, format = "%Y-%m-%d"), silent = TRUE)
    if (!inherits(d, "try-error") && !any(is.na(d))) return(d)

                                        # Keep as character
    type.convert(x,as.is=TRUE)
}





obtenermatrixtablaboloquedelineas <- function(lineasbloque,
                                              mimage,
                                              bloquesfila0gap,
                                              gapcolumns,
                                              mpdfdata,
                                              mpdftext
                                              ){


    vwithdata <-  colSums(mimage[lineasbloque,,drop=FALSE]) > 0L
    bloquescolumna <- get_blocks_runs_true_false(vwithdata, gapcolumns)
    ibloquemasgrandecolumnas <- which.max(bloquescolumna[["trueblocks"]][,"n"])
    columnasbloque <- bloquescolumna[["trueblocks"]][ibloquemasgrandecolumnas,"start"]:bloquescolumna[["trueblocks"]][ibloquemasgrandecolumnas,"end"]

    ##    print(bloquescolumna)

    ## Comprobamos visualmente
    ## im2 <- image
    ## im2[,unlist(columnasbloque),] <- 0.5
    ## plot_array(im2)

    filasy <-apply(bloquesfila0gap$trueblocks,1L, function(z){
        z["start"]:z["end"]
    })
    columnasx  <- apply(bloquescolumna$trueblocks,1L, function(z){
        z["start"]:z["end"]
    })

    ## print("columnax")
    ## print(columnasx)



    linea <- rep(seq_len(length(filasy)), times=lengths(filasy))
    y <- unlist(filasy)
    ytotal <- rep(NA,nrow(mimage))
    ytotal[y] <- linea
    mpdfdata[,"linea"]  <- ytotal[mpdfdata[,"y"]]

    if(is.matrix(columnasx)) {
        columna <- rep(1L, nrow(columnasx))
    } else {
        columna <- rep(seq_len(length(columnasx)), times=lengths(columnasx))
    }
    x <- unlist(columnasx)
    xtotal <- rep(NA,ncol(mimage))
    xtotal[x] <- columna
    mpdfdata[,"columna"]  <- xtotal[mpdfdata[,"x"]]

    f <- mpdfdata[,"y"]  %in% lineasbloque
    ## Group idtext by linea and columna
    mtabla <- tapply(mpdfdata[f, "idtext"],
                     list(mpdfdata[f, "linea"], mpdfdata[f, "columna"]),
                     function(x) paste(mpdftext[x,"textus"], collapse = " "))
    colnames(mtabla) <- paste0("col_",1L:ncol(mtabla))
    mtabla
}


obtenerdatatabletablabloquedelineas <- function(lineasbloque,
                                                mimage,
                                                bloquesfila0gap,
                                                gapcolumns,
                                                mpdfdata,
                                                mpdftext,
                                                page
                                                ) {

    mtabla <- obtenermatrixtablaboloquedelineas(lineasbloque,
                                                mimage,
                                                bloquesfila0gap,
                                                gapcolumns,
                                                mpdfdata,
                                                mpdftext
                                                )

    mtabla
    dttabla <- as.data.table(mtabla)
    cols <- names(dttabla)
    dttabla[,pagina:= as.integer(page)]
    dttabla[,linea:=rownames(mtabla)]
    dttabla[, (cols) := lapply(.SD, guess_type_column), .SDcols = cols]

    dttabla
}





pdf_table_page <- function(pdffile, # Fichero pdf
                           page, # página que queremos extraer
                           alltables=FALSE, # Extrae toda la página (TRUE) o solo la tabla principal (FALSE)
                           gaprows = NULL, # Separador entre líneas. Prueba con gaprows 4L o 5L si no funciona a la primera
                           gapcolumns = 6L,
                           verbose = 0L){
    require(data.table)
    require(pdftools)

    page <- as.integer(page)
    
    dimesionespagina <- pdf_pagesize(pdffile)[page,c("height","width")] # size of page (dpi=72)
    datatext <- as.data.table(pdf_data(pdffile)[[page]]) # width height x y space text
    datatext

    mpdfdata <- cbind(as.matrix(datatext[,.(width,height,x,y,space)]),
                      idtext=1L:nrow(datatext),
                      page=page,
                      tabla= NA_integer_,
                      linea=NA_integer_,
                      columna=NA_integer_)
    mpdftext <- cbind(text=as.matrix(datatext[,.(text)]),textus=NA_character_)
    mpdftext[,"textus"]  <- european_to_us_date(mpdftext[,"text"])
    mpdftext[,"textus"]  <- european_to_us_currency(mpdftext[,"textus"])


    ## Rellenamos todos los espacios
    mimage <- matrix(0L,nrow=dimesionespagina[["height"]],ncol=dimesionespagina[["width"]])
    pos <- unlist(apply(mpdfdata,1L, function(z){
        cols <- z["x"]:(z["x"]+z["width"])
        poscols <- (cols - 1L)*nrow(mimage)
        rows <- z["y"]:(z["y"]+z["height"])
        pos <- rows + rep(poscols,each=length(rows))
    }))
    mimage[pos] <- 1L


    ## Empezamos con las lineas físicas reales, las que tienen 0 gap de separación.
    dim(mimage)
    vwithdata <-  rowSums(mimage) > 0L
    bloquesfila0gap <- get_blocks_runs_true_false(vwithdata, 0L )


    get_mode <- function(x) {
        ux <- unique(x)
        ux[which.max(tabulate(match(x, ux)))]
    }



    ##print(bloques0gap[["falseblocks"]][,.N,by=n][order(-N)])

    if(is.null(gaprows) || !is.numeric(as.numeric(gaprows)) ||  any(gaprows < 0L)){
        moda <- get_mode(bloquesfila0gap[["falseblocks"]][,"n"])
        if(is.na(moda)) moda <-  -1L
        gapmasusual <- moda +1L
    } else {
        gapmasusual <- gaprows
    }

        bloquesfila <- get_blocks_runs_true_false(vwithdata, gapmasusual )

    filasy <-apply(bloquesfila$trueblocks,1L, function(z){
        z["start"]:z["end"]
    })
    linea <- rep(seq_len(length(filasy)), times=lengths(filasy))
    y <- unlist(filasy)
    ytotal <- rep(NA,nrow(mimage))
    ytotal[y] <- linea
    mpdfdata[,"tabla"]  <- ytotal[mpdfdata[,"y"]]

    mpdfdata

    ## Aquí empieza el análisis de cada tabla

     if(alltables){
        ldt <- lapply(1:nrow(bloquesfila[["trueblocks"]]), function(i){
            lineasbloque <-  bloquesfila[["trueblocks"]][i,"start"]:bloquesfila[["trueblocks"]][i,"end"]
            obtenerdatatabletablabloquedelineas(lineasbloque,mimage, bloquesfila0gap,gapcolumns,mpdfdata,mpdftext,page)
        })
        return(ldt)
    } else {
        ## Cogemos el bloque con más líneas
        ibloquemasgrandefilas <- which.max(bloquesfila[["trueblocks"]][,"n"])
        lineasbloque <-  bloquesfila[["trueblocks"]][ibloquemasgrandefilas,"start"]:bloquesfila[["trueblocks"]][ibloquemasgrandefilas,"end"]
        dt <- obtenerdatatabletablabloquedelineas(lineasbloque,mimage, bloquesfila0gap,gapcolumns,mpdfdata,mpdftext,page)
        return(copy(dt))
    }



}