R help - Jan 2010 - column width in .dbf files using write.dbf ... to be continued

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]]

Old topic...

An answer may be useful for someone else, though...

Just do :
 > environment(write.dbfMODIF)<-environment(foreign::write.dbf )

and it should be good to go.

Cheers,



--
View this message in context:
http://r.789695.n4.nabble.com/column-width-in-dbf-files-using-write-dbf-to-be-continued-tp1013017p4645841.html
Sent from the R help mailing list archive at Nabble.com.