Thanks Bastien, I completely forgot that I asked this question. I learned a lot since then ... actually, now I know how to do it, but it was not the case in 2009 :-)
Arnaud 2013/5/22 <bastien.ferland-raym...@mrn.gouv.qc.ca> > > Hello Arnaud, > > You posted this question a long long time ago, however I found your answer > so I decided to post it anyway in case somebody else have the same problem > as you and me. > > You were actually very close in finding your solution. The function > DoWritedbf is an internal function from the foreign package. To access it > outside of the package just do: > > foreign:::DoWritedbf > > so in your line: > > invisible(.Call(foreign:::DoWritedbf, as.character(file), dataframe, > as.integer(precision), as.integer(scale), as.character(DataTypes))) > > It is explain here: > http://stackoverflow.com/questions/2165342/r-calling-a-function-from-a-namespace > > Sorry for the delay in my answer... > > Bastien Ferland-Raymond, M.Sc. Stat., M.Sc. Biol. > Division des orientations et projets spéciaux > Direction des inventaires forestiers > Ministère des Ressources naturelles > > In reply to : > ##### > 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.
