write.fwf 列名与值不一致

write.fwf column names don't line up with values

以下代码生成一个 table,其列名与其值不一致:

library( gdata )
test0 <- matrix(5:28, nrow = 4) 
row.names(test0) <- paste("r", 1:4, sep = "")
colnames(test0) <- paste("c", 1:6, sep = "")

test0[3, 2] <- 1234567890
test0[ , 3] <- 0.19412341293479123840214

test0 <- format(test0, digits = 5, trim = T, width = 10, scientific = T)

write.fwf(test0, file = paste("test", ".txt", sep = ""), width = 11, rowname = T, colname = T, quote = F) 

如何使列名与每一列的值对齐(以便让 GAMS 读取 table)?

奇怪的是列名没有以相同的方式处理。一种解决方法是将列名添加为 table 中的一行,然后写入 table 不带列名...

test1 <- rbind( colnames(test0) , test0 )
write.fwf(test1, file = paste("test", ".txt", sep = ""),
          width = 11,
          rownames = T,
          colnames = F,  #Don't print the column names
          quote = F )

这看起来像:

我创建了一个小脚本,用于将数据框保存为 fwf 格式,列与值对齐。

latest gist code

suppressPackageStartupMessages({
    library(gdata)
    library(stringr)
})

#' Generate automatically .fwf file (fixed width file) in R
#' @description This function creates automatically fixed width file
#' It align columns headers with datas
#' @param df dataframe   
#' @param filename filename   
#' @param nbspaces nb spaces for columns separator   
#' @param replace_na Empty/NA chain replacement   
#' @param rowname If it's defined, it convert rownames column to named column   
#' @examples write_fwf(mtcars, "carname", "/tmp/mtcars.fwf")
#'
#' # colnames: carname,mpg,cyl,disp,hp,drat,wt,qsec,vs,am,gear,carb
#' # cols: 22,7,6,8,6,7,8,8,5,5,7,7
#' carname                mpg   cyl    disp    hp   drat      wt    qsec   vs   am   gear   carb
#' Mazda RX4             21.0     6   160.0   110   3.90   2.620   16.46    0    1      4      4
#' Mazda RX4 Wag         21.0     6   160.0   110   3.90   2.875   17.02    0    1      4      4
#' Datsun 710            22.8     4   108.0    93   3.85   2.320   18.61    1    1      4      1
#' Hornet 4 Drive        21.4     6   258.0   110   3.08   3.215   19.44    1    0      3      1
write_fwf <- function(df, filename,rowname = FALSE,nbspaces = 3, replace_na = "NA") {
  # Convert rownames to column
  if (rowname) {
    df <- tibble::rownames_to_column(df, rowname)
  }

  # Convert all columns to character
  tmpdf = data.frame(df)
  tmpdf[] <- lapply(df, as.character)

  # Compute column size
  nasize=nchar(replace_na)
  maxwidthname <- nchar(colnames(tmpdf))
  maxwidthvalue <- sapply(tmpdf, function(x) max(nchar(x)))
  maxcols <- pmax(maxwidthname,maxwidthvalue,nasize)
  delta <- maxwidthvalue - maxwidthname 

  # Compute header
  header <- c()
  for (idx in seq(ncol(df))) {
    if (is.character(df[,idx])) {
      header <- append(header,paste0(colnames(df)[idx],strrep(" ",max(delta[idx],0))))
    } else {
      header <- append(header,paste0(strrep(" ",max(delta[idx],0)), colnames(df)[idx]))
    }
  }

  # Open file
  file <- file(filename, "w")
  
  # Write header
  writeLines(paste("# colnames:", paste(colnames(df), collapse=',')),file)
  writeLines(paste("# cols:", paste(unlist(maxcols+nbspaces), collapse=',')),file)
  writeLines(header,file, sep=strrep(" ",nbspaces))
  writeLines("", file, sep="\n")
  close(file)
  
  # Export data
  write.fwf(
    df,
    file=filename,
    append=TRUE, 
    width=maxcols,
    colnames=FALSE,
    na=replace_na, 
    sep=strrep(" ",nbspaces),
    justify="left"
  )
}

#' Read automatically .fwf file (fixed width file) in R
#' @description This function read and detect automatically fixed width file
#' @param maxsearchlines nb lines for the searching the columns metadata description   
#' @examples read_fwf("/tmp/mtcars.fwf")
read_fwf <- function(filename,maxsearchlines=100) {
  # Search columns informations
  file <- file(filename, "r")
  on.exit(close(file))

  lines <- readLines(file,n=maxsearchlines)

  idxname <- str_which(lines,"# colnames: ")
  colnames <- str_replace(lines[idxname], "# colnames: ", "")
  colnames <- unlist(str_split(colnames, ","))

  idxcols <- str_which(lines,"# cols: ")
  colwidths <- str_replace(lines[idxcols], "# cols: ", "")
  colwidths <- str_split(colwidths, ",")
  colwidths <- strtoi(unlist(colwidths))

  return(read.fwf(file=filename, skip=idxcols+1, col.names = colnames, widths=colwidths,strip.white=TRUE))
}

样本利用率

write_fwf(mtcars, "carname", "/tmp/mtcars.fwf")

结果

# colnames: carname,mpg,cyl,disp,hp,drat,wt,qsec,vs,am,gear,carb
# cols: 22,7,6,8,6,7,8,8,5,5,7,7
carname                mpg   cyl    disp    hp   drat      wt    qsec   vs   am   gear   carb
Mazda RX4             21.0     6   160.0   110   3.90   2.620   16.46    0    1      4      4
Mazda RX4 Wag         21.0     6   160.0   110   3.90   2.875   17.02    0    1      4      4
Datsun 710            22.8     4   108.0    93   3.85   2.320   18.61    1    1      4      1
Hornet 4 Drive        21.4     6   258.0   110   3.08   3.215   19.44    1    0      3      1
Hornet Sportabout     18.7     8   360.0   175   3.15   3.440   17.02    0    0      3      2
Valiant               18.1     6   225.0   105   2.76   3.460   20.22    1    0      3      1
Duster 360            14.3     8   360.0   245   3.21   3.570   15.84    0    0      3      4