1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
ConvertMedUnits <- function(x, measurement, abbreviation,
to=c("Conventional","SI","US"),
exact=!missing(abbreviation))
{
MedUnits <- NULL # define to avoid R CMD check warning
data(MedUnits, package='gdata', envir=environment())
to=match.arg(to)
if(!missing(measurement) && missing(abbreviation))
{
if(exact)
matchUnits <-
MedUnits[tolower(MedUnits$Measurement) == tolower(measurement),]
else
matchUnits <- MedUnits[grep(measurement, MedUnits$Measurement,
ignore.case=TRUE),]
}
else if(missing(measurement) && !missing(abbreviation))
{
if(exact)
matchUnits <-
MedUnits[tolower(MedUnits$Abbreviation) == tolower(abbreviation),]
else
matchUnits <- MedUnits[grep(match, MedUnits$Abbrevation,
ignore.case=TRUE),]
}
else # both missing or both specified
stop("one of `measurement' or `abbreviation' must be specified")
if(nrow(matchUnits) > 1)
stop(
paste("More than one matching row. Please use 'exact=TRUE' ",
"and supply one of these matching strings:",
paste('\t"',matchUnits$Measurement, '"', sep='', collapse="\n\t"),
sep="\n\t"))
else if (nrow(matchUnits) < 1)
stop("No match")
if (to %in% c("Convetional", "US"))
{
retval <- x / matchUnits$Conversion
attr(retval,"units") <- matchUnits$ConventionalUnits
}
else
{
retval <- x * matchUnits$Conversion
attr(retval,"units") <- matchUnits$SIUnits
}
retval
}
|
