From c86f5dd4f70adcb208a118a0ac15384cd11421b0 Mon Sep 17 00:00:00 2001 From: Theertha Kariyathan Date: Tue, 8 Sep 2026 10:09:18 +0100 Subject: [PATCH] plot multipleregions --- .Rhistory | 988 +++++++++++++++---------------- R/ds.summarystat.R | 75 ++- vignettes/Opal_functioncheck.Rmd | 4 +- 3 files changed, 561 insertions(+), 506 deletions(-) diff --git a/.Rhistory b/.Rhistory index 46f0bdf..5b2f53d 100644 --- a/.Rhistory +++ b/.Rhistory @@ -1,332 +1,165 @@ -results, -function(x) x$`Correlation Matrix`[1, 2] -), -server = if (type == "split") names(results) else rep("combine", length(results)), +N.gp <- (t(n.matrix) %*% nsum.vector) +SEM.gp <- SD.gp/sqrt(N.gp) +# create names +names.gp <- rep(NA,length(mean.gp)) +for(k in 1:length(mean.gp)){ +names.gp[k] <- paste0(yvarname,"_",k) +} +dimnames(mean.gp) <- c(list(names.gp),list("Mean_gp")) +dimnames(SD.gp) <- c(list(names.gp),list("SD_gp")) +dimnames(N.gp) <- c(list(names.gp),list("Nvalid_gp")) +dimnames(SEM.gp) <- c(list(names.gp),list("SEM_gp")) +} +# SPLIT +if(type!="combine"){ +numsources <- length(output) +mean.matrix <- NULL +sd.matrix <- NULL +n.matrix <- NULL +Nvalid <- 0 +Nmissing <- 0 +Ntotal <- 0 +for(j in 1:numsources){ +mean.matrix <- rbind(mean.matrix,as.numeric(unlist(output[[j]][2]))) +sd.matrix <- rbind(sd.matrix,as.numeric(unlist(output[[j]][3]))) +n.matrix <- rbind(n.matrix,as.numeric(unlist(output[[j]][4]))) +Nvalid <- Nvalid+as.numeric(unlist(output[[j]][5])) +Nmissing <- Nmissing+as.numeric(unlist(output[[j]][6])) +Ntotal <- Ntotal+as.numeric(unlist(output[[j]][7])) +} +var.matrix <- sd.matrix^2 +mean.gp.study <- t(mean.matrix) +SD.gp.study <- t(sd.matrix) +N.gp.study <- t(n.matrix) +SEM.gp.study <- SD.gp.study/sqrt(N.gp.study) +# create names +names.gp <- rep(NA,dim(mean.gp.study)[1]) +for(k in 1:dim(mean.gp.study)[1]){ +names.gp[k] <- paste0(yvarname,"_",k) +} +names.study <- names(datasources) +dimnames(mean.gp.study) <- c(list(names.gp),list(names.study)) +dimnames(SD.gp.study) <- c(list(names.gp),list(names.study)) +dimnames(N.gp.study) <- c(list(names.gp),list(names.study)) +dimnames(SEM.gp.study) <- c(list(names.gp),list(names.study)) +} +if(type=="combine"){ +# if type is combine check whether lsoa levels are same in the two studies +names.identical <- all(vapply(lsoa_names, identical, logical(1),y = lsoa_names[[1]])) +if (!names.identical) { +warning( +"LSOA levels across studies are not the same. ", +"Cannot proceed with type = 'combine'. ", +"Defaulting to type = 'split'." +) +type <- "split" +} else { +lsoanames <- lsoa_names[[1]] +if(draw.plot){ +## If plot is TRUE please select which metric to plot else table is returned +sel.metric <- get(metric_map[[metric]]) +sel.metric.data <- data.frame(lsoa11cd = lsoanames, +value = as.numeric(sel.metric), +server = 'combine') +shape_sf <- shape_list[[1]] |> +dplyr::left_join(sel.metric.data, by = "lsoa11cd") |> +sf::st_as_sf() +} else { +result <- list(mean.gp,SD.gp,N.gp,SEM.gp,Nvalid,Nmissing,Ntotal, lsoa_names[[1]]) +names(result) <- list("Mean_gp","StDev_gp","Nvalid_gp","SEM_gp","Total_Nvalid", +"Total_Nmissing","Total_Ntotal", "LSOAnames") +return(result) +} +} +} +if(type=="split"){ +if(draw.plot){ +sel.metric <- get(metric_map[[metric]]) +sel.metric.data <- +lapply(seq_len(ncol(sel.metric)), function(i) { +data.frame( +server = colnames(sel.metric)[i], +value = sel.metric[, i], +lsoa11cd = lsoa_names[[i]], row.names = NULL ) -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -source("dsExampleClient/R/ds.groupcor.R") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -results_data %>% head() -if(type == 'split' && length(names_region) != length(stdnames)){ -names_region <- rep(names_region, times = length(stdnames)) -} -shape_list <- lapply(names_region, function(region) { -boundr::bounds( -"lsoa", -within_level = "lad", -within_names = region, -lookup_year = 2011, -opts = boundr::boundr_options(resolution = "BFC") -) |> -dplyr::select(lsoa11cd, geometry) }) -head(shape_list[[1]]) -shape_list[[1]] %>% head() -shape_list[[2]] %>% head() -shape_list[[3]] %>% head() -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -shape_list %>% names() -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -names(shape_list) -shape_list[[1]] -shape_list[[1]] %>% head() -shape_list[[2]] %>% head() -stdnames -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -head(results_data) -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -correlation_data %>% head() -correlation_data %>% tail() -shape_list[[1]] %>% head() -server_name -shape_list[[server_name]] %>% head() -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -head(results_data) -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -head(results_data) -levels(factor(results_data$server)) -ggplot2::ggplot(results_data) + -ggplot2::geom_sf(ggplot2::aes(fill = correlation.coef)) + -ggplot2::scale_fill_gradientn( -colours = grDevices::colorRampPalette(c( -"#440154", -"#414487", -"#2A788E", -"#22A884", -"#7AD151", -"#FDE725" -))(100), -na.value = "grey90" -) + -ggplot2::labs(fill = "Correlation Coefficient") + -ggplot2::facet_wrap(~server) + -ggplot2::theme_minimal() -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "split") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -shape_list[[1]] -shape_list[[2]] -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/groupcorDS.R") -source("dsExample/R/groupcorDS.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -names(result) -source("dsExample/R/groupcorDS.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExample/R/groupcorDS.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -result[["Nfilter.tab"]] -names(result) %>% tail() -source("dsExample/R/groupcorDS.R") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -names(output) -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -!is.null(common_lsoas) -is.null(common_lsoas) -length(common_lsoas) -length(unique(common_lsoas)) -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -pwd -getwd() -pdf("Personal/images/combined_correlation_map.pdf", width = 8, height = 6) -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -png("Personal/images/combined_correlation_map.png", width = 8, height = 6) -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -png("Personal/images/combined_correlation_map.png", width = 8, height = 6) -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -is.null(common_lsoas) || length(common_lsoas) < output[[1]][["Nfilter.tab"]] -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -reference <- output[[1]][[lsoa]] -reference -combined.sums.of.products <- matrix( -0, -nrow = nrow(reference[[1]]), -ncol = ncol(reference[[1]]), -dimnames = dimnames(reference[[1]]) -) -combined.sums.of.products -combined.sums.of.products <- matrix( -0, -nrow = nrow(reference[[1]]), -ncol = ncol(reference[[1]]), -dimnames = dimnames(reference[[1]]) -) -combined.sums <- matrix( -0, -nrow = nrow(reference[[2]]), -ncol = ncol(reference[[2]]), -dimnames = dimnames(reference[[2]]) -) -combined.complete.cases <- matrix( -0, -nrow = nrow(reference[[3]]), -ncol = ncol(reference[[3]]), -dimnames = dimnames(reference[[3]]) -) -combined.missing.cases.vector <- matrix( -0, -nrow = nrow(reference[[4]][[1]]), -ncol = ncol(reference[[4]][[1]]), -dimnames = dimnames(reference[[4]][[1]]) -) -combined.missing.cases.matrix <- matrix( -0, -nrow = nrow(reference[[4]][[2]]), -ncol = ncol(reference[[4]][[2]]), -dimnames = dimnames(reference[[4]][[2]]) -) -combined.sums.of.squares <- matrix( -0, -nrow = nrow(reference[[5]]), -ncol = ncol(reference[[5]]), -dimnames = dimnames(reference[[5]]) -) -reference[[4]][[2]] -dimnames(reference[[4]][[2]]) -nrow(reference[[4]][[2]]) -ncol(reference[[4]][[2]]) -reference[[6]] -reference[[5]] -tail(common_lsoas) -names(output[[1]]) %>% tail() -common_lsoas <- sort(Reduce(intersect, lapply(head(output, -1), names))) -tail(common_lsoas) -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -png("Personal/images/combined_correlation_map.png", width = 8, height = 6) -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -dev.off() -source("dsExampleClient/R/ds.groupcor.R") -png("Personal/images/combined_correlation_map.png", width = 8, height = 6) -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -dev.off() -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -png("Personal/images/combined_correlation_map.png", width = 12, height = 10) -ds.groupcor("D$has_asthma", "D$distance_local_greenspace", "D$lsoa11cd", datasources = conns, type = "combine") -dev.off() -png( -filename = "Personal/images/combined_correlation_map.png", -width = 12, -height = 10, -units = "in", -res = 300 -) -p <- ds.groupcor( -"D$has_asthma", -"D$distance_local_greenspace", -"D$lsoa11cd", -datasources = conns, -type = "combine" -) -print(p) -dev.off() -png( -filename = "Personal/images/split_correlation_map.png", -width = 12, -height = 10, -units = "in", -res = 300 -) -p <- ds.groupcor( -"D$has_asthma", -"D$distance_local_greenspace", -"D$lsoa11cd", -datasources = conns, -type = "split" -) -source("dsExampleClient/R/ds.groupcor.R") -source("dsExampleClient/R/ds.groupcor.R") -png( -filename = "Personal/images/split_correlation_map.png", -width = 12, -height = 10, -units = "in", -res = 300 -) -p <- ds.groupcor( -"D$has_asthma", -"D$distance_local_greenspace", -"D$lsoa11cd", -datasources = conns, -type = "split" -) -source("dsExampleClient/R/ds.groupcor.R") -png( -filename = "Personal/images/split_correlation_map.png", -width = 12, -height = 10, -units = "in", -res = 300 -) -p <- ds.groupcor( -"D$has_asthma", -"D$distance_local_greenspace", -"D$lsoa11cd", -datasources = conns, -type = "split" -) -source("dsExampleClient/R/ds.groupcor.R") -ds.groupcor( -"D$has_asthma", -"D$distance_local_greenspace", -"D$lsoa11cd", -datasources = conns, -type = "split" -) -length(output$server_1) -output[[1]][["Nfilter.tab"]] -nfilter.tab <- output[[1]][["Nfilter.tab"]] -output <- lapply(output, function(x) { -x[-length(x)] +shape_sf <- do.call( +rbind, +lapply(1:numsources, function(i){ +shape_list[[i]] |> +dplyr::left_join(sel.metric.data[[i]], by = "lsoa11cd") |> +sf::st_as_sf() }) -length(output) -length(output[[1]]) -length(output[[2]]) -source("dsExampleClient/R/ds.groupcor.R") -png( -filename = "Personal/images/split_correlation_map.png", -width = 12, -height = 10, -units = "in", -res = 300 -) -p <- ds.groupcor( -"D$has_asthma", -"D$distance_local_greenspace", -"D$lsoa11cd", -datasources = conns, -type = "split" ) -print(p) -dev.off() -getwd() -dat <- dd -getwd() -setwd("dsGeospatial/") -usethis::create_package(".", open = FALSE) -usethis::use_roxygen_md() -usethis::use_readme_rmd() -usethis::use_news_md() -usethis::use_vignette() -usethis::use_vignette("getting_started") -usethis::use_package_doc() -usethis::use_spell_check() -getwd() -library(devtools) -devtools::document() -devtools::document() -?dsGeospatial -rm(list = ls()) -knitr::opts_chunk$set(echo = TRUE) -# retrieve LSOA boundaries for Cheshire and Merseyside -# to reduce coverage, remove names from the `within_names` -cm_lsoa_sf <- boundr::bounds( -"lsoa", -within_level = "lad", -within_names = c( -"Cheshire East", +} else { +lsoanames <- matrix(unlist(lsoa_names), ncol = numsources) +dimnames(lsoanames) <- dimnames(mean.gp.study) +result <- list(mean.gp.study,SD.gp.study,N.gp.study,SEM.gp.study,Nvalid, +Nmissing,Ntotal, lsoanames) +names(result) <- list("Mean_gp_study","StDev_gp_study","Nvalid_gp_study", +"SEM_gp_study","Total_Nvalid","Total_Nmissing", +"Total_Ntotal", "LSOAnames") +return(result) +} +} +} +all.tables.valid +type +numsources <- length(output) +mean.matrix <- NULL +sd.matrix <- NULL +n.matrix <- NULL +Nvalid <- 0 +Nmissing <- 0 +Ntotal <- 0 +for(j in 1:numsources){ +mean.matrix <- rbind(mean.matrix,as.numeric(unlist(output[[j]][2]))) +sd.matrix <- rbind(sd.matrix,as.numeric(unlist(output[[j]][3]))) +n.matrix <- rbind(n.matrix,as.numeric(unlist(output[[j]][4]))) +Nvalid <- Nvalid+as.numeric(unlist(output[[j]][5])) +Nmissing <- Nmissing+as.numeric(unlist(output[[j]][6])) +Ntotal <- Ntotal+as.numeric(unlist(output[[j]][7])) +} +var.matrix <- sd.matrix^2 +nsum.vector <- rep(1,numsources) +# Calculate weighted means across studies in each group +mean.gp <- (diag(t(mean.matrix)%*%n.matrix))/(t(n.matrix)%*%nsum.vector) +numsources <- length(output) +mean.matrix <- NULL +sd.matrix <- NULL +n.matrix <- NULL +Nvalid <- 0 +Nmissing <- 0 +Ntotal <- 0 +for(j in 1:numsources){ +mean.matrix <- rbind(mean.matrix,as.numeric(unlist(output[[j]][2]))) +sd.matrix <- rbind(sd.matrix,as.numeric(unlist(output[[j]][3]))) +n.matrix <- rbind(n.matrix,as.numeric(unlist(output[[j]][4]))) +Nvalid <- Nvalid+as.numeric(unlist(output[[j]][5])) +Nmissing <- Nmissing+as.numeric(unlist(output[[j]][6])) +Ntotal <- Ntotal+as.numeric(unlist(output[[j]][7])) +} +var.matrix <- sd.matrix^2 +nsum.vector <- rep(1,numsources) +# Calculate weighted means across studies in each group +mean.gp <- (diag(t(mean.matrix)%*%n.matrix))/(t(n.matrix)%*%nsum.vector) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='combine', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='combine', do.checks=FALSE, +draw.plot = TRUE, names_region = list("ChesterMercyside"), +metric = "Mean", datasources=conns) +names_region +names_region = list("ChesterMercyside") +names_region +names_region[[1]] <- c("Cheshire East", "Cheshire West and Chester", "Halton", "Knowsley", @@ -334,179 +167,346 @@ within_names = c( "Sefton", "St. Helens", "Warrington", -"Wirral" -), -lookup_year = 2011, # can be either 2011 or 2021 -opts = boundr::boundr_options(resolution = "BFC") +"Wirral") +names_region +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='combine', do.checks=FALSE, +draw.plot = TRUE, names_region = list("ChesterMercyside"), +metric = "Mean", datasources=conns) +names_region +length(shape_list) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='combine', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool", "Sefton")), +metric = "Mean", datasources=conns) +length(names_region) +length(shape_list) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='combine', do.checks=FALSE, +draw.plot = TRUE, names_region = list("ChesterMercyside"), +metric = "Mean", datasources=conns) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("ChesterMercyside"), +metric = "Mean", datasources=conns) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +type +length(shape_list) +numsources +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +length(names_region) +lapply(1:length(numsources), function(i) { +names_region[[i]] <- names_region[[1]] +}) +numsources +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +names_region +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool","Liverpool","Halton"), +metric = "Mean", datasources=conns) +names_region +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool","Liverpool","Halton"), +metric = "Mean", datasources=conns) +names_region +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","Liverpool","Halton")), +metric = "Mean", datasources=conns) +names_region +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","Liverpool","Halton")), +metric = "Mean", datasources=conns) +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","Liverpool","Halton")), +metric = "Mean", datasources=conns) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='combine', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","Liverpool","Halton")), +metric = "Mean", datasources=conns) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='combine', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","Liverpool","Halton"), c("Sefton")), +metric = "Mean", datasources=conns) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","Liverpool","Halton"), c("Sefton")), +metric = "Mean", datasources=conns) +names_region <- list() +names_region <- list(c("ChesterMercyside","Liverpool")) +any(names_region=="ChesterMercyside") +which(names_region=="ChesterMercyside") +lapply(names_region, function(i){which(i)=="ChesterMercyside"}) +"ChesterMercyside" %in% names_region[[1]] +any(unlist(names_region) == "ChesterMercyside") +which(unlist(names_region) == "ChesterMercyside") +names_region +names_region <- list(c( "Liverpool" , "ChesterMercyside")) +which(unlist(names_region) == "ChesterMercyside") +names_region <- list(c("Liverpool"),c( "Liverpool" , "ChesterMercyside")) +which(unlist(names_region) == "ChesterMercyside") +names_region +lapply(names_region, function(i){ +which(unlist(names_region) == "ChesterMercyside") +} ) -liverpool_sf <- cm_lsoa_sf |> -dplyr::filter(lad22nm %in% "Liverpool") -uprn_gs_sf <- "https://pldr.org/download/2k6r3/n12/UPRN_2_1_greenspace_distances_with_coords.csv" |> -readr::read_csv() |> -# convert to spatial object -sf::st_as_sf(coords = c("longitude", "latitude"), crs = 4326) |> -# add LSOA details -sf::st_join(cm_lsoa_sf) -qof_asthma_tbl <- "https://pldr.org/download/e6nzv/ng1/QOF_4_03_Asthma_LSOA.csv" |> -readr::read_csv() |> -# filter out CM LSOAs -dplyr::filter(lsoa11 %in% cm_lsoa_sf$lsoa11cd) |> -# filter out last year -dplyr::filter(year == 2024) -# set seed for reproducibility -set.seed(20250603) -qof_asthma_cohort_tbl <- qof_asthma_tbl |> -purrr::pmap(function(lsoa11, den, num, ...) { -# recalculate pop to be a multiple of 2 -pop <- ifelse(den %% 2 != 0, den + 1, den) -# extract UPRNs for this LSOA -uprn_tbl <- uprn_gs_sf |> -sf::st_drop_geometry() |> -dplyr::filter(lsoa11cd == lsoa11) |> -dplyr::mutate( -dist_gs_dec = dplyr::ntile(distance_local_greenspace, 10) -) |> -dplyr::arrange(dist_gs_dec) -# create cohort table -cohort_tbl <- tibble::tibble( -lsoa11cd = lsoa11, -sex = rep(c(0, 1), each = pop / 2), -has_asthma = FALSE, -uprn = sample(uprn_tbl$UPRN, size = pop, replace = TRUE) +lapply(names_region, function(i){ +which(unlist(i) == "ChesterMercyside") +} ) -# randomly assigned the outcome to `num` patients -idx <- sample(seq_len(pop), ceiling(num), replace = FALSE) -cohort_tbl$has_asthma[idx] <- TRUE -# randomly re-assigned UPRNs with higher distances to patients with outcome -## create vector of probabilities, so further distances are favoured -p <- c(0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.1, 0.2, 0.2, 0.2) -idx_uprn_tile <- sample(1:10, ceiling(num), replace = TRUE, prob = p) -## subset UPRNs with match tile as per `idx_uprn_tile` -cohort_tbl$uprn[idx] <- purrr::map(idx_uprn_tile, function(x) { -# subset based on tile decile -aux <- dplyr::filter(uprn_tbl, dist_gs_dec == x) -# extract UPRN -aux$UPRN[sample(seq_len(nrow(aux)), 1)] -}) |> -purrr::list_c() -# return final cohort table -return(cohort_tbl) -}) |> -purrr::list_c() -qof_asthma_cohort_dist_gs_sf <- qof_asthma_cohort_tbl |> -dplyr::left_join(uprn_gs_sf, by = c("uprn" = "UPRN", "lsoa11cd")) |> -dplyr::arrange(lsoa11cd, uprn) |> -sf::st_as_sf() -library(dsGeospatial) -knitr::opts_chunk$set(echo = TRUE) -library(DSLite) -library(devtools) +lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +i[which(unlist(i) == "ChesterMercyside")] <- c("a") +} +} +lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +i[which(unlist(i) == "ChesterMercyside")] <- c("a") +} +}) +lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +i[which(unlist(i) == "ChesterMercyside")] <- c("a") +}else{ +i <- i +} +}) +names_region +lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +print(i[which(unlist(i) == "ChesterMercyside")]) +}else{ +i <- i +} +}) +names_region +lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +print(which(unlist(i) == "ChesterMercyside")) +}else{ +i <- i +} +}) +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +print(which(unlist(i) == "ChesterMercyside")) +}else{ +i <- i +} +}) +x +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +replace(i, "ChesterMercyside", "w") +}else{ +i <- i +} +}) +x +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +d <- which(unlist(i) == "ChesterMercyside") +replace(i, d, "w") +}else{ +i <- i +} +}) +x +CheshireMercyside <- c("Cheshire East", +"Cheshire West and Chester", +"Halton", +"Knowsley", +"Liverpool", +"Sefton", +"St. Helens", +"Warrington", +"Wirral") +} +CheshireMercyside <- c("Cheshire East", +"Cheshire West and Chester", +"Halton", +"Knowsley", +"Liverpool", +"Sefton", +"St. Helens", +"Warrington", +"Wirral") +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +indx <- which(unlist(i) == "ChesterMercyside") +replace(i, indx, CheshireMercyside) +}else{ +i <- i +} +}) +x +CheshireMercyside <- c("Cheshire East", +"Cheshire West and Chester", +"Halton", +"Knowsley", +"Liverpool", +"Sefton", +"St. Helens", +"Warrington", +"Wirral") +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +indx <- which(unlist(i) == "ChesterMercyside") +i <- c(i, CheshireMercyside) +#replace(i, indx, CheshireMercyside) +}else{ +i <- i +} +}) +x +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +indx <- which(unlist(i) == "ChesterMercyside") +replace(i, indx, "") +i <- c(i, CheshireMercyside) +}else{ +i <- i +} +}) +x +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +indx <- which(unlist(i) == "ChesterMercyside") +replace(i, indx, "") +#i <- c(i, CheshireMercyside) +}else{ +i <- i +} +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +indx <- which(unlist(i) == "ChesterMercyside") +replace(i, indx, "") +#i <- c(i, CheshireMercyside) +}else{ +i <- i +} +}) +x +x <- lapply(names_region, function(i){ +if("ChesterMercyside" %in% i){ +indx <- which(unlist(i) == "ChesterMercyside") +i <- i[-indx] +i <- c(i, CheshireMercyside) +}else{ +i <- i +} +}) +x +source("R/ds.summarystat.R") +source("R/ds.summarystat.R") +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","CheshireMercyside"), c("Sefton")), +metric = "Mean", datasources=conns) +datashield.errors() +library(DSOpal) library(dsBase) library(dsBaseClient) -library(dsGeospatial) -dat <- qof_asthma_cohort_dist_gs_sf |> -dplyr::select("lsoa11cd", "has_asthma","uprn","distance_local_greenspace") |> -sf::st_drop_geometry() -devtools::load_all("/Users/tkariya/Documents/DataSHIELD/dsExample") -#devtools::load_all("/Users/tkariya/Documents/DataSHIELD/dsExampleClient") -dslite.server1 <- newDSLiteServer( -tables = list( -uprn_asthma_green1 = dat -) -) -dslite.server2 <- newDSLiteServer( -tables = list( -uprn_asthma_green2 = dat -) -) -dslite.server1$config(defaultDSConfiguration(include=c("dsBase", "dsExample"))) -dslite.server1$aggregateMethod("MeanSdGpDS", "MeanSdGpDS") -dslite.server2$config(defaultDSConfiguration(include=c("dsBase", "dsExample"))) -dslite.server2$aggregateMethod("MeanSdGpDS", "MeanSdGpDS") -options( -datashield.privacyControlLevel = "banana", -nfilter.tab = 3, -nfilter.subset = 3, -nfilter.glm = 0.33, -nfilter.string = 80, -nfilter.stringShort = 20, -nfilter.kNN = 3, -nfilter.levels.density = 0.33, -nfilter.levels.max = 40, -nfilter.noise = 0.25, -nfilter.privacy.old = 5 -) builder <- DSI::newDSLoginBuilder() -builder$append( -server = "server_1", -url = "dslite.server1", -table = "uprn_asthma_green1", -driver = "DSLiteDriver" -) -builder$append( -server = "server_2", -url = "dslite.server2", -table = "uprn_asthma_green2", -driver = "DSLiteDriver" -) +builder$append(server = "study1", +url = "http://localhost:8880", +user = "administrator", +password = "password", +table = "UPRN.greenspace_distance_metrics", +profile = "ds-geospatial") +builder$append(server = "study2", +url = "http://localhost:8880", +user = "administrator", +password = "password", +table = "UPRN.greenspace_distance_metrics", +profile = "ds-geospatial") logindata <- builder$build() -conns <- DSI::datashield.login(logins = logindata, assign = FALSE) -datashield.assign.table(conns, "D", logindata) -nfilter.tab <- 3 -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns) -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns, -type='split') -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns) -p <- ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns) -print(p) -source("R/ds.geoheatmapPlot.R") -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns) -source("R/ds.geoheatmapPlot.R") -dev.off() -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns) -library(devtools) -devtools::document() -library(dsGeospatial) -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns) -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns, -type='split') -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns, -type='split', names_region = c("Liverpool", "Sefton")) -ds.geoheatmapPlot(x="D$distance_local_greenspace", y = "D$lsoa11cd", -datasources = conns) -ds.geoheatmapPlot(x="D$has_asthma", y = "D$lsoa11cd", datasources = conns, -type = 'split', names_region = c("Liverpool", "Sefton")) -install.packages("dsGeospatial") -rm(list = ls()) -pak::pak("FederatedMethods/dsGeospatial") -pak::pak("git::git@github.com:FederatedMethods/dsGeospatial.git") -pak::pak("git::git@github.com:FederatedMethods/dsGeospatial.git") -pak::pak( -"git::ssh://git@github.com/FederatedMethods/dsGeospatial.git" -) -pak::pkg_install( -"git::ssh://git@github.com/FederatedMethods/dsGeospatial.git" -) -pak::local_install( -"/Users/tkariya/Documents/DataSHIELD/dsGeospatial/" -) -pak::local_install( -"/Users/tkariya/Documents/DataSHIELD/dsGeospatial/" -) -pak::local_install( -"/Users/tkariya/Documents/DataSHIELD/dsGeospatial/" -) -pak::local_install( -"/Users/tkariya/Documents/DataSHIELD/dsGeospatial/" -) -getwd() -setwd("/Users/tkariya/Documents/DataSHIELD/") -setwd("/Users/tkariya/Documents/DataSHIELD/dsGeospatialClient/") -usethis::create_package() -usethis::create_package(".", open = FALSE) -usethis::use_roxygen_md() -usethis::use_readme_rmd() -getwd() -usethis::use_readme_rmd() -usethis::use_news_md() -usethis::use_vignette("getting-started") +conns <- DSI::datashield.login(logins = logindata, assign = TRUE, symbol = "D") +ds.colnames("D", conns) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list(c("Liverpool","CheshireMercyside"), c("Sefton")), +metric = "Mean", datasources=conns) +library(dsGeospatialClient) +ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", +type='split', do.checks=FALSE, +draw.plot = TRUE, names_region = list("Liverpool"), +metric = "Mean", datasources=conns) +library(DSOpal) +library(dsBase) +library(dsBaseClient) +builder <- DSI::newDSLoginBuilder() +builder$append(server = "study1", +url = "http://localhost:8880", +user = "administrator", +password = "password", +table = "UPRN.greenspace_distance_metrics", +profile = "ds-geospatial") +builder$append(server = "study2", +url = "http://localhost:8880", +user = "administrator", +password = "password", +table = "UPRN.greenspace_distance_metrics", +profile = "ds-geospatial") +logindata <- builder$build() +conns <- DSI::datashield.login(logins = logindata, assign = TRUE, symbol = "D") diff --git a/R/ds.summarystat.R b/R/ds.summarystat.R index c1e0380..137eaee 100644 --- a/R/ds.summarystat.R +++ b/R/ds.summarystat.R @@ -198,18 +198,71 @@ ds.summarystat <- function(x=NULL, y=NULL, type='combine', do.checks=FALSE, plot_matrix <- list() split <- type == 'split' - if(!is.null(names_region) && all(is.character(names_region))){ + ## names_region check + # check if list and all elements are character + + if (is.list(names_region) && + length(names_region) > 0 && + all(is.character(unlist(names_region)))) { names_region.valid = TRUE - if(!split && length(names_region) > 1){ - warning(paste0("more than one region selected for type = ", type, - ", using only first names_region to return")) - names_region = names_region[1] - } - if(split && length(names_region) != numsources){ - names_region <- rep(names_region, times = numsources) - } + names_region <- lapply(names_region, function(i){ + if("CheshireMercyside" %in% i){ + indx <- which(unlist(i) == "CheshireMercyside") + i <- i[-indx] + i <- c(i, "Cheshire East","Cheshire West and Chester", + "Halton","Knowsley","Liverpool","Sefton", + "St. Helens","Warrington","Wirral") + }else{ + i <- i + } + }) + + # names_region is valid check type combination + + if (split) { + if (numsources == 1) { + warning( + "type 'split', expects length of datasources to be more than 1, + defaulting to type 'combine'" + ) + split = FALSE + } else{ + # check list length = numsources + # check is all entries match when length is >1 + if (length(names_region) != numsources) { + warning( + paste0( + "length of names_region should match length of datasources, + using only first elements in names_region to return" + ) + ) + names_region <- lapply(1:numsources, function(i) { + names_region[[i]] <- names_region[[1]] + }) + names_region <- lapply(names_region, unique) + } else{ + names_region <- lapply(names_region, unique) + } + } + } else if(!split) { + # when combine, list must have length 1 + # ifnot repeat list[[1]] for all numsources + if (length(names_region) != 1) { + warning( + "length of names_region must be 1 for type 'combine', + using only first elements in names_region to return" + ) + names_region = list(names_region[[1]]) + names_region <- lapply(names_region, unique) + + } else{ + names_region = list(names_region[[1]]) + names_region <- lapply(names_region, unique) + } + } + shape_list <- lapply(names_region, function(region) { boundr::bounds( @@ -239,11 +292,11 @@ ds.summarystat <- function(x=NULL, y=NULL, type='combine', do.checks=FALSE, } }else{ - warning("invalid region names, returning the whole table") + warning("invalid region names/format, returning the whole table") draw.plot = FALSE names_region.valid = FALSE } - + ########## diff --git a/vignettes/Opal_functioncheck.Rmd b/vignettes/Opal_functioncheck.Rmd index bcb8269..12f71fb 100644 --- a/vignettes/Opal_functioncheck.Rmd +++ b/vignettes/Opal_functioncheck.Rmd @@ -110,9 +110,11 @@ ds.colnames("D", conns) ```{r} library(dsGeospatialClient) +names_region <- list(c("Liverpool", "Sefton"), c("Liverpool")) + ds.summarystat(x = "D$has_asthma", y = "D$lsoa11cd", type='combine', do.checks=FALSE, - draw.plot = TRUE, names_region = "Liverpool", + draw.plot = TRUE, names_region = names_region, metric = "Mean", datasources=conns) ```