Dear UseRs,
I did not have any answer to my previous message ("Is there a way to define
"manually" columns width when using write.dbf function from the library
foreign ?"), so I tried to modify write.dbf function to do what I want.
Here is my modified version :
write.dbfMODIF <- function (dataframe, file, factor2char = TRUE, max_nchar =
254, width = d)
{
allowed_classes <- c("logical", "integer", "numeric", "character",
"factor", "Date")
if (!is.data.frame(dataframe))
dataframe <- as.data.frame(dataframe)
if (any(sapply(dataframe, function(x) !is.null(dim(x)))))
stop("cannot handle matrix/array columns")
cl <- sapply(dataframe, function(x) class(x[1L]))
asis <- cl == "AsIs"
cl[asis & sapply(dataframe, mode) == "character"] <- "character"
if (length(cl0 <- setdiff(cl, allowed_classes)))
stop("data frame contains columns of unsupported class(es) ",
paste(cl0, collapse = ","))
m <- ncol(dataframe)
DataTypes <- c(logical = "L", integer = "N", numeric = "F",
character = "C", factor = if (factor2char) "C" else "N",
Date = "D")[cl]
for (i in seq_len(m)) {
x <- dataframe[[i]]
if (is.factor(x))
dataframe[[i]] <- if (factor2char)
as.character(x)
else as.integer(x)
else if (inherits(x, "Date"))
dataframe[[i]] <- format(x, "%Y%m%d")
}
precision <- integer(m)
scale <- integer(m)
dfnames <- names(dataframe)
for (i in seq_len(m)) {
nlen <- nchar(dfnames[i], "b")
x <- dataframe[, i]
if (is.logical(x)) {
precision[i] <- 1L
scale[i] <- 0L
}
else if (is.integer(x)) {
rx <- range(x, na.rm = TRUE)
rx[!is.finite(rx)] <- 0
if (any(rx == 0))
rx <- rx + 1
mrx <- as.integer(max(ceiling(log10(abs(rx)))) +
3L)
precision[i] <- min(max(nlen, mrx), 19L)
scale[i] <- 0L
}
else if (is.double(x)) {
precision[i] <- 19L
rx <- range(x, na.rm = TRUE)
rx[!is.finite(rx)] <- 0
mrx <- max(ceiling(log10(abs(rx))))
scale[i] <- min(precision[i] - ifelse(mrx > 0L, mrx +
3L, 3L), 15L)
}
else if (is.character(x)) {
if (width == "d") {
mf <- max(nchar(x[!is.na(x)], "b"))
p <- max(nlen, mf)
if (p > max_nchar)
warning(gettext("character column %d will be truncated
to %d bytes",
i, max_nchar), domain = NA)
precision[i] <- min(p, max_nchar)
scale[i] <- 0L
} else {
if (width > max_nchar)
warning(gettext("character column %d will be truncated
to %d bytes",
i, max_nchar), domain = NA)
precision[i] <- min(width, max_nchar)
}
}
else stop("unknown column type in data frame")
}
if (any(is.na(precision)))
stop("NA in precision")
if (any(is.na(scale)))
stop("NA in scale")
invisible(.Call(DoWritedbf, as.character(file), dataframe,
as.integer(precision), as.integer(scale), as.character(DataTypes)))
}
However, when I wanted to use this function ... it does not find the
DoWritedbf function that is called in the last lines (a function written in
C).
Is there a way to temporally replace the original write.dbf function by this
one in the foreign package ?
Thanks,
Arnaud
R version 2.10.0 (2009-10-26)
i386-pc-mingw32
[[alternative HTML version deleted]]
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
