1.onLoad <- function(libname, pkgname) { 2 ## By default, configure udunits with path set (presumably) by the 3 ## user through the UDUNITS2_XML_PATH environment variable 4 .C('R_ut_init', as.integer(0)) 5 if (!ud.have.unit.system()) { 6 ## Failing that, override it with the in-package XML file 7 p0 <- system.file("share/udunits2.xml", package="udunits2") 8 Sys.setenv(UDUNITS2_XML_PATH=p0) 9 .C('R_ut_init', as.integer(1)) 10 ## If *that* fails, give the user some instructions for how to remedy 11 ## the problem 12 if (!ud.have.unit.system()) { 13 warning( 14 "Failed to read udunits system database: udunits2 will not work properly.\nPlease set the UDUNITS2_XML_PATH environment variable before attempting to load the package") 15 } 16 } 17} 18 19.onAttach <- function(libname, pkgname) { 20 msg <- "udunits system database read" 21 p0 <- Sys.getenv("UDUNITS2_XML_PATH") 22 if (p0 != "") { 23 msg <- paste(msg, "from", p0) 24 } 25 packageStartupMessage(msg) 26} 27 28ud.are.convertible <- 29function(u1, u2) { 30 if (! (ud.is.parseable(u1) && ud.is.parseable(u2))) { 31 return(FALSE) 32 } 33 rv <- .C('R_ut_are_convertible', 34 as.character(u1), 35 as.character(u2), 36 convertible=logical(1)) 37 return(rv$convertible) 38} 39 40ud.convert <- 41function(x, u1, u2) { 42 if (! ud.are.convertible(u1, u2)) { 43 stop(paste("Units", u1, "and", u2, "are not convertible")) 44 } 45 ## Filter out NA's before passing them to the C function 46 ## since it can't handle them 47 rv <- rep(NA, length(x)) 48 i <- which(! is.na(x)) 49 50 len <- length(i) 51 c.rv <- .C('R_ut_convert', 52 as.double(x)[i], 53 as.integer(len), 54 as.character(u1), 55 as.character(u2), 56 converted=double(len) 57 ) 58 rv[i] <- c.rv$converted 59 ## If it's a matrix/vector or anything else, convert it back to it's original type 60 attributes(rv) <- attributes(x) 61 return(rv) 62} 63 64ud.get.name <- 65function(unit.string) { 66 stopifnot(ud.is.parseable(unit.string)) 67 rv <- .C('R_ut_get_name', 68 as.character(unit.string), 69 ud.name=character(length=1)) 70 return(rv$ud.name) 71} 72 73ud.get.symbol <- 74function(unit.string) { 75 stopifnot(ud.is.parseable(unit.string)) 76 rv <- .C('R_ut_get_symbol', 77 as.character(unit.string), 78 ud.symbol=character(length=1)) 79 return(rv$ud.symbol) 80} 81 82ud.is.parseable <- 83function(unit.string) { 84 rv <- .C('R_ut_is_parseable', 85 as.character(unit.string), 86 parseable=logical(1)) 87 return(rv$parseable) 88} 89 90ud.set.encoding <- 91function(enc.string) { 92 .C('R_ut_set_encoding', 93 as.character(enc.string)) 94 return() 95} 96 97ud.have.unit.system <- 98function() { 99 rv <- .C('R_ut_has_system', 100 exists=logical(1)) 101 return(rv$exists) 102} 103