Skip to content

Commit 711f20d

Browse files
StuartWheaterStuartWheater
committed
Merge remote-tracking branch 'upstream/v6.1-dev' into v6.1-dev_testing
2 parents 32d3366 + 22aa68e commit 711f20d

3 files changed

Lines changed: 355 additions & 0 deletions

File tree

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ export(ds.densityGrid)
2929
export(ds.dim)
3030
export(ds.exists)
3131
export(ds.exp)
32+
export(ds.getWGSR)
3233
export(ds.glm)
3334
export(ds.glmPredict)
3435
export(ds.glmSLMA)

‎R/ds.getWGSR.R‎

Lines changed: 220 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,220 @@
1+
#'
2+
#' @title Computes the WHO Growth Reference z-scores of anthropometric data
3+
#' @description Calculate WHO Growth Reference z-score for a given anthropometric measurement
4+
#' This function is similar to R function \code{getWGSR} from the \code{zscorer} package.
5+
#' @details The function calls the server-side function \code{getWGSRDS} that computes the WHO
6+
#' Growth Reference z-scores of anthropometric data for weight, height or length, MUAC (middle
7+
#' upper arm circumference), head circumference, sub-scapular skinfold and triceps skinfold.
8+
#' Note that the function might fail or return NAs when the variables are outside the ranges
9+
#' given in the WGS (WHO Child Growth Standards) reference (i.e. 45 to 120 cm for height and
10+
#' 0 to 60 months for age). It is up to the user to check the ranges and the units of their
11+
#' data.
12+
#' @param sex the name of the binary variable that indicates the sex of the subject. This must
13+
#' be coded as 1 = male and 2 = female. If in your project the variable sex has different
14+
#' levels, you should recode the levels to 1 for males and 2 for females using the
15+
#' \code{ds.recodeValues} DataSHIELD function before the use of the \code{ds.getWGSR}.
16+
#' @param firstPart Name of variable specifying:\cr
17+
#' Weight (kg) for BMI/A, W/A, W/H, or W/L\cr
18+
#' Head circumference (cm) for HC/A\cr
19+
#' Height (cm) for H/A\cr
20+
#' Length (cm) for L/A\cr
21+
#' MUAC (cm) for MUAC/A\cr
22+
#' Sub-scapular skinfold (mm) for SSF/A\cr
23+
#' Triceps skinfold (mm) for TSF/A\cr
24+
#' Give a quoted variable name as in (e.g.) "weight". Be careful with units (weight in kg;
25+
#' height, length, head circumference, and MUAC in cm; skinfolds in mm).
26+
#' @param secondPart Name of variable specifying:\cr
27+
#' Age (days) for H/A, HC/A, L/A, MUAC/A, SSF/A, or TSF/A\cr
28+
#' Height (cm) for BMI/A, or W/H\cr
29+
#' Length (cm) for W/L\cr
30+
#' Give a quoted variable name as in (e.g.) "age". Be careful with units (age in days;
31+
#' height and length in cm).
32+
#' @param index The index to be calculated and added to data. One of:\cr
33+
#' bfa BMI for age\cr
34+
#' hca Head circumference for age\cr
35+
#' hfa Height for age\cr
36+
#' lfa Length for age\cr
37+
#' mfa MUAC for age\cr
38+
#' ssa Sub-scapular skinfold for age\cr
39+
#' tsa Triceps skinfold for age\cr
40+
#' wfa Weight for age\cr
41+
#' wfh Weight for height\cr
42+
#' wfl Weight for length\cr
43+
#' Give a quoted index name as in (e.g.) "wfh".
44+
#' @param standing Variable specifying how stature was measured. If NA (default) then age (for "hfa"
45+
#' or "lfa") or height rules (for "wfh" or "wfl") will be applied. This must be coded as
46+
#' 1 = Standing; 2 = Supine; 3 = Unknown. Missing values will be recoded to 3 = Unknown.
47+
#' Give a single value (e.g."1"). If no value is specified then height and age rules will be applied.
48+
#' @param thirdPart Name of variable specifying age (in days) for BMI/A. Give a quoted variable
49+
#' name as in (e.g.) "age". Be careful with units (age in days). If age is given in different units
50+
#' you should convert it in age in days using the \code{ds.make} DataSHIELD function before the use
51+
#' of the \code{ds.getWGSR}. For example if age is given in months then the transformation is given
52+
#' by the formula $age_days=age_months*(365.25/12)$.
53+
#' @param newobj a character string that provides the name for the output variable
54+
#' that is stored on the data servers. Defaults \code{getWGSR.newobj}.
55+
#' @param datasources a list of \code{\link{DSConnection-class}} objects obtained after login.
56+
#' If the \code{datasources} argument is not specified the default set of connections will be
57+
#' used: see \code{\link{datashield.connections_default}}.
58+
#' @return \code{ds.getWGSR} assigns a vector for each study that includes the z-scores for the
59+
#' specified index. The created vectors are stored in the servers.
60+
#' @author Demetris Avraam for DataSHIELD Development Team
61+
#' @export
62+
#' @examples
63+
#' \dontrun{
64+
#'
65+
#' # Connecting to the Opal servers
66+
#'
67+
#' require('DSI')
68+
#' require('DSOpal')
69+
#' require('dsBaseClient')
70+
#'
71+
#' builder <- DSI::newDSLoginBuilder()
72+
#' builder$append(server = "study1",
73+
#' url = "http://192.168.56.100:8080/",
74+
#' user = "administrator", password = "datashield_test&",
75+
#' table = "ANTHRO.anthro1", driver = "OpalDriver")
76+
#' builder$append(server = "study2",
77+
#' url = "http://192.168.56.100:8080/",
78+
#' user = "administrator", password = "datashield_test&",
79+
#' table = "ANTHRO.anthro2", driver = "OpalDriver")
80+
#' builder$append(server = "study3",
81+
#' url = "http://192.168.56.100:8080/",
82+
#' user = "administrator", password = "datashield_test&",
83+
#' table = "ANTHRO.anthro3", driver = "OpalDriver")
84+
#'
85+
#' logindata <- builder$build()
86+
#'
87+
#' # Log onto the remote Opal training servers
88+
#' connections <- DSI::datashield.login(logins = logindata, assign = TRUE, symbol = "D")
89+
#'
90+
#' # Example 1: Generate the weight-for-height (wfh) index
91+
#' ds.getWGSR(sex = "D$sex", firstPart = "D$weight", secondPart = "D$height",
92+
#' index = "wfh", newobj = "wfh_index", datasources = connections)
93+
#'
94+
#' # Example 2: Generate the BMI for age (bfa) index
95+
#' ds.getWGSR(sex = "D$sex", firstPart = "D$weight", secondPart = "D$height",
96+
#' index = "bfa", thirdPart = "D$age", newobj = "bfa_index", datasources = connections)
97+
#'
98+
#' # clear the Datashield R sessions and logout
99+
#' datashield.logout(connections)
100+
#'
101+
#' }
102+
#'
103+
ds.getWGSR <- function(sex=NULL, firstPart=NULL, secondPart=NULL, index=NULL, standing=NA, thirdPart=NA, newobj=NULL, datasources=NULL){
104+
105+
# look for DS connections
106+
if(is.null(datasources)){
107+
datasources <- datashield.connections_find()
108+
}
109+
110+
if(is.null(sex)){
111+
stop("Please provide the column name of the 'sex' variable!", call.=FALSE)
112+
}
113+
114+
if(is.null(firstPart)){
115+
stop("Please provide the column name of the 'firstPart' variable!", call.=FALSE)
116+
}
117+
118+
if(is.null(secondPart)){
119+
stop("Please provide the column name of the 'secondPart' variable!", call.=FALSE)
120+
}
121+
122+
# if 'firstPart' or 'secondPart' are not numeric return an error message
123+
typ.firstPart <- checkClass(datasources, firstPart)
124+
typ.secondPart <- checkClass(datasources, secondPart)
125+
if(!('numeric' %in% typ.firstPart)){
126+
stop("The 'firstPart' variable must be a 'numeric' variable!", call.=FALSE)
127+
}
128+
if(!('numeric' %in% typ.secondPart)){
129+
stop("The 'secondPart' variable must be a 'numeric' variable!", call.=FALSE)
130+
}
131+
132+
if(!(index %in% c("bfa", "hca", "hfa", "lfa", "mfa", "ssa", "tsa", "wfa", "wfh", "wfl"))){
133+
stop("Please provide a correct abbreviation for the index!", call.=FALSE)
134+
}
135+
136+
# If 'thirdPart' (age) is missing for BMI-for-age return an error message
137+
if(index == "bfa" & is.na(thirdPart)) {
138+
stop("'thirdPart' variable should not be missing for index 'bfa'", call.=FALSE)
139+
}
140+
141+
# If 'thirdPart' (age) is not numeric for BMI-for-age return an error message
142+
if(index == "bfa"){
143+
typ.thirdPart <- checkClass(datasources, thirdPart)
144+
if(!('numeric' %in% typ.firstPart)){
145+
stop("The 'thirdPart' variable must be a 'numeric' variable!", call.=FALSE)
146+
}
147+
}
148+
149+
# If 'standing' is not a value either 1, 2, 3, or NA return an error message
150+
if(!(standing %in% c(NA, 1, 2, 3))) {
151+
stop("The 'standing' variable must be a numeric value either 1, 2, or 3!", call.=FALSE)
152+
}
153+
154+
# check newobj not actively declared as null
155+
if(is.null(newobj)){
156+
newobj <- "getWGSR.newobj"
157+
}
158+
159+
cally <- call("getWGSRDS", sex, firstPart, secondPart, index, standing, thirdPart)
160+
DSI::datashield.assign(datasources, newobj, cally)
161+
162+
#############################################################################################################
163+
# DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED
164+
165+
# SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION
166+
test.obj.name <- newobj
167+
168+
# CALL SEVERSIDE FUNCTION
169+
calltext <- call("testObjExistsDS", test.obj.name)
170+
object.info <- DSI::datashield.aggregate(datasources, calltext)
171+
172+
# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS
173+
# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS
174+
num.datasources <- length(object.info)
175+
176+
obj.name.exists.in.all.sources <- TRUE
177+
obj.non.null.in.all.sources <- TRUE
178+
179+
for(j in 1:num.datasources){
180+
if(!object.info[[j]]$test.obj.exists){
181+
obj.name.exists.in.all.sources <- FALSE
182+
}
183+
if(is.null(object.info[[j]]$test.obj.class) || object.info[[j]]$test.obj.class=="ABSENT"){
184+
obj.non.null.in.all.sources <- FALSE
185+
}
186+
}
187+
188+
if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){
189+
return.message <- paste0("A data object <", test.obj.name, "> has been created in all specified data sources")
190+
}else{
191+
return.message.1 <- paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources")
192+
return.message.2 <- paste0("It is either ABSENT and/or has no valid content/class,see return.info above")
193+
return.message.3 <- paste0("Please use ds.ls() to identify where missing")
194+
return.message <- list(return.message.1,return.message.2,return.message.3)
195+
}
196+
197+
calltext <- call("messageDS", test.obj.name)
198+
studyside.message <- DSI::datashield.aggregate(datasources, calltext)
199+
no.errors <- TRUE
200+
for(nd in 1:num.datasources){
201+
if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){
202+
no.errors <- FALSE
203+
}
204+
}
205+
206+
if(no.errors){
207+
validity.check <- paste0("<",test.obj.name, "> appears valid in all sources")
208+
return(list(is.object.created=return.message,validity.check=validity.check))
209+
}
210+
211+
if(!no.errors){
212+
validity.check <- paste0("<",test.obj.name,"> invalid in at least one source. See studyside.messages:")
213+
return(list(is.object.created=return.message,validity.check=validity.check,
214+
studyside.messages=studyside.message))
215+
}
216+
217+
# END OF CHECK OBJECT CREATED CORECTLY MODULE
218+
#######################################################################################################
219+
220+
}

‎man/ds.getWGSR.Rd‎

Lines changed: 134 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)