Skip to content

GitLab

Commit 8bc6104f authored by Ashley Stewart's avatar Ashley Stewart 💃
Browse files

Merge remote-tracking branch 'Upstream/master'

parents 65fae93e bd146310
Hide whitespace changes
Inline Side-by-side
NAMESPACE
View file @ 8bc6104f
......@@ -3,9 +3,11 @@
export(ASPREEDb)
export(CalculateQueryRanges)
export(CalculateXTQueryRanges)
export(CombinedOtherCogsMeasures)
export(CombinedPathologyAU)
export(CombinedPathologyUS)
export(CombinedPhysicalMeasures)
export(CombinedPhysicalPerformanceMeasures)
export(CommentaryCodeSummary)
export(CommentaryCodesAsFactor)
export(CreateKeyPair)
......@@ -36,6 +38,7 @@ export(GetXTConsent)
export(HasVisit)
export(MergeCountryBySubjectId)
export(SDrivePaths)
export(SDrivePrefix)
export(extract_ASP_End)
export(extract_Brdg_End)
export(extract_DeathDate)
......
R/data_access.R
View file @ 8bc6104f
#' Gets the S-drive path prefix based on the operating system used
#'
#' @param default the default prefix if the operating system-specific path can't be determined
#' @return the S-drive prefix
#' @export
SDrivePrefix <- function(default = NULL) {
prefix <- switch(Sys.info()[['sysname']],
Windows="S:/MNHS-SPHPM-EPM",
Darwin="/Volumes/shared/MNHS-SPHPM-EPM"
)
ifelse(is.null(prefix), default, prefix)
}
#' Get S-drive paths
#'
#' Creates a set of file paths pointing to the official ASPREE datasets
......@@ -5,12 +18,9 @@
#' @param prefix the base path of the dataset location
#' @return a list mapping section name to file path
#' @export
SDrivePaths <- function(ver = 2, prefix = NA) {
SDrivePaths <- function(ver = 3, prefix = NA) {
if (is.na(prefix)) {
prefix <- switch(Sys.info()[['sysname']],
Windows="S:/MNHS-SPHPM-EPM",
Darwin="/Volumes/shared/MNHS-SPHPM-EPM"
)
prefix <- SDrivePrefix()
if (is.null(prefix)) {
stop("Please specify the prefix for S Drive data, e.g. \"S:/MNHS-SPHPM-EPM/ASPREE-Data/ASPREE Longitudinal Data Set/\"")
}
......@@ -237,6 +247,7 @@ GetDataBySubjectID <- function(con, tables_and_fields = list(), include_visit_ti
#' Queries the database for the union of tblPathologyAU and xt_PathologyAU
#'
#' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data
#' @import dplyr
#' @export
......@@ -348,6 +359,7 @@ CombinedPathologyAU <- function(con, measures = NULL) {
#' Queries the database for the union of tblPathologyUS and xt_PathologyUS
#'
#' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data
#' @import dplyr
#' @export
......@@ -451,11 +463,12 @@ CombinedPathologyUS <- function(con, measures = NULL) {
return(data)
}
#' Get a combined view of the pre-XT and XT physicsl measures
#' Get a combined view of the pre-XT and XT physical measures
#'
#' Queries the database for the union of tblAnnualVisits and xt_PhysExam for physical measures
#'
#' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data
#' @import dplyr
#' @export
......@@ -528,3 +541,163 @@ select submitted
}
return(data)
}
#' Get a combined view of the pre-XT and XT physical performance measures
#'
#' Queries the database for the union of tblAnnualVisits and xt_PhysPerform for physical measures
#'
#' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data
#' @import dplyr
#' @export
CombinedPhysicalPerformanceMeasures <- function(con, measures = NULL) {
data <- con %>% tbl(sql(
"SELECT submitted
,SubjectID
,visitTime
,unit
,RightGrip1No
,RightGrip1
,RightGrip2No
,RightGrip2
,RightGrip3No
,RightGrip3
,LeftGrip1No
,LeftGrip1
,LeftGrip2No
,LeftGrip2
,LeftGrip3No
,LeftGrip3
,Gait1No
,Gait1
,Gait2No
,Gait2
,WalkAid
,WalkAidOth
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
FROM xt_PhysPerform
union
select submitted
,SubjectID
,visitTime
,unit
,NULL AS RightGrip1No
,RightGrip1
,RightGrip2No
,RightGrip2
,RightGrip3No
,RightGrip3
,NULL AS LeftGrip1No
,LeftGrip1
,LeftGrip2No
,LeftGrip2
,LeftGrip3No
,LeftGrip3
,Gait1No
,Gait1
,Gait2No
,Gait2
,WalkAid
,WalkAidOth
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
from tblAnnualVisits")) %>% collect() %>% rowwise() %>% mutate(
RightGrip_Mean = mean(c(RightGrip1, RightGrip2, RightGrip3), na.rm = TRUE),
LeftGrip_Mean = mean(c(LeftGrip1, LeftGrip2, LeftGrip3), na.rm = TRUE),
Gait_Mean = mean(c(Gait1, Gait2), na.rm = TRUE),
)
data <- con %>% GetDataBySubjectID(tables_and_fields = list("PhysPerform" = data)) %>% tidyr::drop_na("visitTime")
if (!is.null(measures)) {
data <- data %>% select(c("SubjectID", "visitTime", "visitName", "visitDate", "AV", "year", measures))
}
return(data)
}
#' Get a combined view of the pre-XT and XT "other cogs" measures
#'
#' Queries the database for the union of tblAnnualVisits and xt_OtherCogs for physical measures
#'
#' @param con a database connection using the DBI package or \code{ASPREEDb()}
#' @param measures subset of measures to return
#' @return the combined data
#' @import dplyr
#' @export
CombinedOtherCogsMeasures <- function(con, measures = NULL) {
data <- con %>% tbl(sql(
"SELECT submitted
,SubjectID
,visitTime
,SLFT
,SDMT
,CT1Secs
,CT1Errs
,CT1NM
,CT1Prpts
,CT1NotComplete
,CT2Secs
,CT2ColErrs
,CT2NoErrs
,CT2NM
,CT2Prpts
,CT2NotComplete
,HVLT1
,HVLT2
,HVLT2No
,HVLT3
,HVLT3No
,HVLT4
,HVLT4No
,HVLTRec1
,HVLTRec1No
,HVLTRec2
,HVLTRec2No
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
FROM xt_OtherCogs
union
select submitted
,SubjectID
,visitTime
,SLFT
,SDMT
,NULL AS CT1Secs
,NULL AS CT1Errs
,NULL AS CT1NM
,NULL AS CT1Prpts
,NULL AS CT1NotComplete
,NULL AS CT2Secs
,NULL AS CT2ColErrs
,NULL AS CT2NoErrs
,NULL AS CT2NM
,NULL AS CT2Prpts
,NULL AS CT2NotComplete
,HVLT1
,HVLT2
,HVLT2No
,HVLT3
,HVLT3No
,HVLT4
,HVLT4No
,HVLTRec1
,HVLTRec1No
,HVLTRec2
,HVLTRec2No
,CreatedBy
,CreatedDt
,ModifiedBy
,ModifiedDt
from tblAnnualVisits")) %>% collect()
data <- con %>% GetDataBySubjectID(tables_and_fields = list("OtherCogs" = data)) %>% tidyr::drop_na("visitTime")
if (!is.null(measures)) {
data <- data %>% select(c("SubjectID", "visitTime", "visitName", "visitDate", "AV", "year", measures))
}
return(data)
}
R/data_quality.R
View file @ 8bc6104f
......@@ -204,7 +204,7 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) {
Hb = case_when(
!is.na(Hb_Pathology) ~ Hb_Pathology,
TRUE ~ Hb
),
),
Cr = Cr * 88.4,
ACR = ACR * 0.113,
Glc = Glc * 0.0555,
......@@ -221,11 +221,21 @@ CalculateXTQueryRanges <- function(con, cutoff_sd = 3) {
"DBP_Mean",
"HR_Mean",
"Wt"
)))$cutoffs,
)))$cutoffs,
CalculateQueryRanges(con, 7, 9, cutoff_sd = cutoff_sd, make_plots = FALSE,
tables_and_fields = CombinedPhysicalMeasures(con, c(
"AC"
)))$cutoffs
)))$cutoffs,
CalculateQueryRanges(con, 7, 8, cutoff_sd = cutoff_sd, make_plots = FALSE,
tables_and_fields = CombinedPhysicalPerformanceMeasures(con, c(
"LeftGrip_Mean",
"RightGrip_Mean",
"Gait_Mean"
)))$cutoffs,
CalculateQueryRanges(con, 7, 9, cutoff_sd = cutoff_sd, make_plots = FALSE,
tables_and_fields = CombinedOtherCogsMeasures(con, c(
"SLFT", "SDMT"
)))$cutoffs
)
}
......@@ -262,7 +272,7 @@ DatasetComparison <- function(dataset_version1, dataset_version2, section_name,
cols_deleted <- setdiff(colnames(dataset1), colnames(dataset2))
# Calculate diff, add in column addition and deletion information
diff <- compareDF::compare_df(dataset2[,cols], dataset1[,cols], group_col = id_column, keep_unchanged_cols = FALSE, limit_html = max_html_table_length)
diff <- compareDF::compare_df(dataset2[,cols], dataset1[,cols], group_col = id_column, keep_unchanged_cols = FALSE, limit_html = max_html_table_length, stop_on_error = FALSE)
diff$cols_added <- cols_added
diff$cols_deleted <- cols_deleted
......
man/CombinedPathologyAU.Rd
View file @ 8bc6104f
......@@ -8,6 +8,8 @@ CombinedPathologyAU(con, measures = NULL)
}
\arguments{
\item{con}{a database connection using the DBI package or \code{ASPREEDb()}}
\item{measures}{subset of measures to return}
}
\value{
the combined data
......
man/CombinedPathologyUS.Rd
View file @ 8bc6104f
......@@ -8,6 +8,8 @@ CombinedPathologyUS(con, measures = NULL)
}
\arguments{
\item{con}{a database connection using the DBI package or \code{ASPREEDb()}}
\item{measures}{subset of measures to return}
}
\value{
the combined data
......
man/CombinedPhysicalMeasures.Rd
View file @ 8bc6104f
......@@ -2,12 +2,14 @@
% Please edit documentation in R/data_access.R
\name{CombinedPhysicalMeasures}
\alias{CombinedPhysicalMeasures}
\title{Get a combined view of the pre-XT and XT physicsl measures}
\title{Get a combined view of the pre-XT and XT physical measures}
\usage{
CombinedPhysicalMeasures(con, measures = NULL)
}
\arguments{
\item{con}{a database connection using the DBI package or \code{ASPREEDb()}}
\item{measures}{subset of measures to return}
}
\value{
the combined data
......
man/SDrivePaths.Rd
View file @ 8bc6104f
......@@ -4,7 +4,7 @@
\alias{SDrivePaths}
\title{Get S-drive paths}
\usage{
SDrivePaths(ver = 2, prefix = NA)
SDrivePaths(ver = 3, prefix = NA)
}
\arguments{
\item{prefix}{the base path of the dataset location}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment