Question

我试图设计一个R函数，它接受一个列表并绘制一个具有专门格式的表格。

这是我的数据：

$Projectpath$

以下是我将数据输入的功能：

pottery <- list(
    `Llanederyn` = c( 14.4, 13.8, 14.6, 11.5, 13.8, 10.9, 10.1, 11.6, 11.1, 13.4, 12.4, 13.1, 12.7, 12.5 ),
    `Caldicot` = c( 11.8, 11.6 ),
    `Island Thorns` = c( 18.3, 15.8, 18.0, 18.0, 20.8 ),
    `Ashley Rails` = c( 17.7, 18.3, 16.7, 14.8, 19.1 )
)

myTableGrob( pottery )

目前，此代码将创建下表：

我要去的表是这样的：

我发现了很多good documentation和discussion，但对我想要完成的事情没有任何帮助。

另一方面，如果有人知道我可以在哪里获得有关myTableGrob <- function( data, padding = unit( 4, 'mm' ), ... ) { mostRows <- max( sapply( data, length ) ) dataDF <- data.frame( lapply( data, function( p ) { for ( aoc in (length( p ):mostRows)[-1] ) p[aoc] <- '' return( p ) } ), stringsAsFactors = FALSE, check.names = FALSE ) prefferedFont <- list( fontface = 'plain', fontfamily = 'Times', cex = φ ) g <- tableGrob( dataDF, theme = ttheme_minimal( colhead = list( fg_params = prefferedFont ), core = list( fg_params = prefferedFont ) ), rows = NULL ) g$colnames <- colnames( dataDF ) g <- gtable_add_grob( g, grobs = segmentsGrob( name = 'segment', y1 = unit( 0, 'npc' ), gp = gpar( lty = 1, lwd = 1 ) ), t = 1, l = 1, r = ncol( g ) ) g$widths <- unit( rep( (1/φ) / ncol( g ), ncol( g ) ), 'npc' ) grid.newpage() grid.draw( g ) return( invisible( g ) ) }和tableGrob / ttheme_default函数的更多信息，那么这也会派上用场。我不熟悉这些函数可以采用的参数，只是发现我可以为ttheme_minimal函数提供tthmeme_和colhead参数来调用grobs子集的更改。也许我错过了与整个grob对象构造相关的东西？

感谢。

- 编辑 -

我在这里创建了这个脚本，创建了我之后的矩阵版本。也许我可以从这开始直接与grobs一起工作并创造一些富有成效的东西。

core

- UPDATE -

answer proposed by @baptiste似乎非常接近。 （我希望格式化得到纠正但是）我还在考虑使用以下脚本，但不是需要知道需要移动哪些列，也许我们可以搜索重复的列标题并将它们组合起来关于他们的数字：

listToTableMatricies <- function( data, MAX_ROWS = 7, ... )
{
    mostRows <- max( sapply( data, function(d) {
        ifelse( length( d ) %/% MAX_ROWS > 0,
            MAX_ROWS, length( d ) %% MAX_ROWS )
        } ) )

    dataMod <- sapply( data, function( d ) {
        nc <- ( length( d ) %/% (MAX_ROWS + 1) ) + 1
        for ( aoc in (length( d ):(mostRows*nc))[-1] )
            d[aoc] <- NA
        return( matrix( d, nrow = mostRows, ncol = nc ) )
    } )

    return( dataMod )
}

Answer 1

这是一种格式化数据的方法，然后使列标题跨越两列（您可能希望微调列宽，这里都相等）：

pottery <- list(
  `Llanederyn` = c( 14.4, 13.8, 14.6, 11.5, 13.8, 10.9, 10.1, 11.6, 11.1, 13.4, 12.4, 13.1, 12.7, 12.5 ),
  `Caldicot` = c( 11.8, 11.6 ),
  `Island Thorns` = c( 18.3, 15.8, 18.0, 18.0, 20.8 ),
  `Ashley Rails` = c( 17.7, 18.3, 16.7, 14.8, 19.1 )
)

# http://stackoverflow.com/questions/7962267/cbind-a-df-with-an-empty-df-cbind-fill

cbind.fill <- function(...){
  nm <- list(...) 
  nm <- lapply(nm, as.matrix)
  n <- max(sapply(nm, nrow)) 
  do.call(cbind, lapply(nm, function (x) 
    rbind(x, matrix("", n-nrow(x), ncol(x))))) 
}

pottery7 <- unlist(lapply(pottery, function(col) split(col, seq_len(length(col)) %/% 8)), FALSE)
tt <- as.data.frame(do.call(cbind.fill, pottery7))
colnames(tt) <- c("", names(pottery))

library(gridExtra)
tg <- tableGrob(tt, theme = ttheme_minimal(), rows = NULL)
tg$widths <- unit(rep(1/ncol(tg), ncol(tg)), "null")

id_cell <- function(table, row, col, name="colhead-fg"){
  l <- table$layout
  which(l$t %in% row & l$l %in% col & l$name==name)
}

id <- id_cell(tg, 1, 2)
tg$layout[id,"l"] <- tg$layout[id,"l"] - 1
grid.newpage()
grid.draw(tg)

Answer 2

我想出的解决方案如下：

tablePlot <- function( data, MAX_ROWS = 7, nsmall = 1, ... )
{
    # Find out the number of rows needed
    mostRows <- max( sapply( data, function(d) {
            min( length( d ), MAX_ROWS )
        } ) )

    # Convert data to strings
    data <- lapply( data, format, nsmall )

    # Create a list of matricies for each group
    dataMod <- lapply( data, function( d ) {
        nc <- (length( d ) %/% (MAX_ROWS) ) -
                (as.logical(length( d ) %% MAX_ROWS == 0)) + 1
        for ( aoc in (length( d ):(mostRows*nc))[-1] )
            d[aoc] <- ''
        return( matrix( d, nrow = mostRows, ncol = nc ) )
    } )

    # Track the number of subcolumns needed per group
    # groupSubColumns
    gsc <- lapply( dataMod, function(d) dim(d)[2] )

    dataDF <- data.frame( dataMod, stringsAsFactors = FALSE, check.names = FALSE )
    colnames( dataDF ) <- unlist( lapply( names( gsc ), function( g ) c( rep( '', gsc[[g]]-1), g ) ) )

    prefferedFont <- list( fontface = 'plain', fontfamily = 'Times', cex = φ/1.25 )

    g <- tableGrob( dataDF, theme = ttheme_minimal(
            colhead = list( fg_params = prefferedFont ),
            core = list( fg_params = prefferedFont ) ),
        rows = NULL )

    # g$colnames <- colnames( dataDF )

    g <- gtable_add_grob( g,
            grobs = segmentsGrob( name = 'segment',
                    y1 = unit( 0, 'npc' ),
                    gp = gpar( lty = 1, lwd = 1 ) ),
            t = 1, l = 1, r = ncol( g ) )

    g$widths <- unit( rep( (1/φ) / ncol( g ), ncol( g ) ), 'npc' )

    id_cell <- function( table, row, col, name = 'colhead-fg' )
    {
        l <- table$layout
        which( l$t %in% row & l$l %in% col & l$name == name )
    }

    for( c in 1:length( colnames( dataDF ) ) )
    {
        colname <- colnames( dataDF )[c]
        if ( colname != '' )
        {
            id <- id_cell( g, 1, c )
            g$layout[id, 'l'] <- g$layout[id, 'l'] - ( gsc[[colname]] - 1 )
        }
    }

    grid.newpage()
    grid.draw( g )
    return( dataMod )
    return( invisible( g ) )
}

对于我想要采用的多子列方法，这个函数更加健壮，即使我遗憾地遗漏了我希望看到的格式。就是这样，将多子列组中的数字拉近了。除此之外，这里有一些用脚本生成的数字：

向帮助这项发展的@baptiste致敬。

如何在gridExtra :: tableGrob中添加多子列

2 个答案: