diff --git a/NAMESPACE b/NAMESPACE index ae50d3c..691b6f6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,10 @@ export(ds.chisqr) export(ds.geoheatmapPlot) export(ds.groupcor) +export(ds.lagsarlm) +export(ds.lmSLX) +export(ds.localmoran) +export(ds.moransI) export(ds.summarystat) importFrom(cli,cli_abort) importFrom(grDevices,colorRampPalette) diff --git a/R/ds.conleyreg.R b/R/ds.conleyreg.R new file mode 100644 index 0000000..af8e582 --- /dev/null +++ b/R/ds.conleyreg.R @@ -0,0 +1,206 @@ + +#' @title Linear Regression with Conley Spatial Standard Errors +#' +#' @description +#' Performs linear regression with spatial heteroskedasticity and +#' autocorrelation consistent (Conley) standard errors on data stored +#' across one or more DataSHIELD servers. +#' +#' The function calls the server-side \code{conleyregDS()} function, +#' which uses \code{conleyreg::conleyreg()} to estimate ordinary least +#' squares (OLS) regression coefficients with spatially adjusted +#' standard errors. +#' +#' @details +#' Conley regression accounts for spatial dependence in regression +#' errors when calculating standard errors, t-statistics, and p-values. +#' The regression coefficients themselves are estimated using OLS. +#' +#' Spatial dependence is considered within the distance specified by +#' \code{dist_cutoff}. Observations beyond this distance do not +#' contribute to the spatial covariance adjustment. +#' +#' The server-side function applies DataSHIELD disclosure checks +#' using \code{nfilter.tab} and \code{nfilter.glm} before fitting +#' the regression model. +#' +#' If \code{do.checks = TRUE}, the client function checks whether +#' the dependent variable specified in \code{formula} exists on +#' the connected DataSHIELD servers and retrieves its class information. +#' +#' Results are returned separately for each datasource. +#' Currently, only \code{type = "split"} is supported. +#' +#' @param formula An R formula specifying the dependent variable +#' and one or more independent variables for the regression model. +#' +#' @param data A character string specifying the name of the +#' server-side spatial data object containing the variables +#' specified in \code{formula}. +#' +#' @param dist_cutoff A positive numeric value specifying the +#' maximum distance over which spatial correlation is accounted +#' for when estimating standard errors. +#' The distance units depend on the spatial distance configuration +#' used by \code{conleyreg::conleyreg()}. +#' Default is \code{1000}. +#' +#' @param type A character string specifying the output format. +#' Currently, only \code{"split"} is supported, returning +#' results separately for each datasource. +#' Default is \code{"split"}. +#' +#' @param do.checks Logical. If \code{TRUE}, checks whether the +#' dependent variable exists on each datasource and retrieves +#' its class information. +#' Default is \code{TRUE}. +#' +#' @param datasources A list of \code{DSConnection} objects +#' representing the DataSHIELD servers. +#' If \code{NULL}, connections are obtained using +#' \code{datashield.connections_find()}. +#' +#' @return +#' A named list containing the results from each DataSHIELD server. +#' +#' When the model passes the server-side disclosure checks, +#' each server returns: +#' +#' \describe{ +#' \item{\code{coef}}{ +#' Regression coefficient estimates, Conley-adjusted standard +#' errors, t-statistics, and p-values. +#' } +#' } +#' +#' If the disclosure checks fail, the server may return: +#' +#' \describe{ +#' \item{\code{Table_valid}}{ +#' Logical value \code{FALSE}. +#' } +#' \item{\code{Nvalid}}{ +#' Number of complete observations. +#' } +#' \item{\code{Nmissing}}{ +#' Number of observations containing missing values. +#' } +#' \item{\code{Ntotal}}{ +#' Total number of observations. +#' } +#' \item{\code{Warning}}{ +#' Message explaining why the disclosure check failed. +#' } +#' } +#' +#' With \code{type = "split"}, each server's output is flattened +#' into a named vector using \code{unlist()}. +#' +#' @seealso +#' \code{\link[conleyreg]{conleyreg}}, +#' \code{\link[DSI]{datashield.aggregate}} +#' +#' @examples +#' \dontrun{ +#' DSOpal::Opal() +#' builder <- DSI::newDSLoginBuilder() +#' builder$append( +#' server = "mersey-demo", +#' url = "http://localhost:8880", +#' user = "administrator", +#' password = "password", +#' driver = "OpalDriver", +#' profile = "ds-geospatial" +#' ) +#' +#' logindata <- builder$build() +#' conns <- DSI::datashield.login(logins = logindata) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells", +#' resource = paste0(project, ".", "cells") +#' ) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "W", +#' resource = paste0(project, ".", "W_D_5km") +#' ) +#' ## 2.8 Materialise arbitrary R objects ---- +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells_resource", +#' resource = paste0(project, ".cells") +#' ) +#' +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "cells_object", +#' expr = quote(as.resource.object(cells_resource)) +#' ) +#' ## 2.9 Map specific columns ---- +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "obesity_qof_2024_25", +#' expr = quote(cells_object$obesity_qof_2024_25) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_object", +#' expr = quote(as.resource.object(W)) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_band800", +#' expr = quote(W_object$band800) +#' ) +#' +#' ds.conleyreg( +#' formula = obesity_qof_2024_25 ~ dist_food_fastfood, +#' data = "cells_object", +#' dist_cutoff = 1000, +#' datasources = conns) +#' @export + +ds.conleyreg <- function(formula = NULL, data = NULL, dist_cutoff = 1000, + type='split', do.checks = TRUE, datasources=NULL){ + + # look for DS connections + if(is.null(datasources)){ + datasources <- datashield.connections_find() + } + + # ensure datasources is a list of DSConnection-class + if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ + stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) + } + + if(is.null(formula)){ + stop("Please provide the input formula!", call.=FALSE) + } + + + if(do.checks){ + + # check if the input objects are defined in all the studies + #isDefined(datasources, x) + isDefined(datasources, all.vars(formula)[1]) + + # call the internal function that checks the input object is of the same class in all studies. + #typ1 <- checkClass(datasources, x) + typ2 <- checkClass(datasources, all.vars(formula)[1]) + } + + + calltext <- paste0("conleyregDS(", deparse(formula), ", ", data, ", ", dist_cutoff, ")", collapse = "") + + output <- DSI::datashield.aggregate(datasources, as.symbol(calltext)) + + ## Only type split supported now + if(type == "split"){ + + result <- output + return(result) + } +} + + diff --git a/R/ds.gwrbasic.R b/R/ds.gwrbasic.R new file mode 100644 index 0000000..4c037ac --- /dev/null +++ b/R/ds.gwrbasic.R @@ -0,0 +1,163 @@ +#' @title Fit a Spatial Lag of X (SLX) Regression Model +#' +#' @description +#' Fits a Spatial Lag of X (SLX) regression model on DataSHIELD servers +#' using the server-side function \code{lmSLXDS()}. The function +#' estimates the association between an outcome and both local and +#' neighbouring explanatory variables without transferring individual-level +#' data to the client. +#' +#' @details +#' The SLX model incorporates spatially lagged explanatory variables +#' and is defined as: +#' +#' \deqn{y = X\beta + WX\theta + \epsilon} +#' +#' where \eqn{y} is the dependent variable, \eqn{X} is the matrix of +#' explanatory variables, \eqn{W} is the spatial weights matrix, +#' \eqn{\beta} represents the coefficients of local explanatory variables, +#' and \eqn{\theta} represents the coefficients of spatially lagged +#' explanatory variables. +#' +#' The function calls \code{lmSLXDS()} on each DataSHIELD server, +#' where disclosure checks are applied before fitting the model using +#' \code{spatialreg::lmSLX()}. +#' +#' Currently, only \code{type = "split"} is supported, returning +#' results separately for each server. +#' +#' @param formula An R formula specifying the dependent variable and +#' explanatory variables. +#' @param data Character string specifying the name of the data frame +#' on the DataSHIELD servers. +#' @param listw Character string specifying the name of a server-side +#' spatial weights object of class \code{listw}. +#' @param type Character string specifying how results are returned. +#' Currently, only \code{"split"} is supported. Defaults to +#' \code{"split"}. +#' @param do.checks Logical. If \code{TRUE}, checks whether the spatial +#' weights object exists on the DataSHIELD servers and retrieves its +#' class. Defaults to \code{TRUE}. +#' @param datasources A list of \code{DSConnection} objects representing +#' the DataSHIELD connections. If \code{NULL}, existing connections +#' are retrieved using \code{datashield.connections_find()}. +#' +#' @return +#' A named list containing results from each DataSHIELD server. +#' When \code{type = "split"}, each server's output is converted +#' to a vector using \code{unlist()}. +#' +#' If the server-side disclosure checks pass, the results contain +#' estimated regression coefficients, including coefficients for +#' spatially lagged explanatory variables. +#' +#' If the disclosure checks fail, the server returns information +#' about the failed checks instead of fitting the model. +#' +#' @seealso +#' \code{\link[spatialreg]{lmSLX}} +#' +#' @examples +#' \dontrun{ +#' DSOpal::Opal() +#' builder <- DSI::newDSLoginBuilder() +#' builder$append( +#' server = "mersey-demo", +#' url = "http://localhost:8880", +#' user = "administrator", +#' password = "password", +#' driver = "OpalDriver", +#' profile = "ds-geospatial" +#' ) +#' +#' logindata <- builder$build() +#' conns <- DSI::datashield.login(logins = logindata) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells", +#' resource = paste0(project, ".", "cells") +#' ) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "W", +#' resource = paste0(project, ".", "W_D_5km") +#' ) +#' ## 2.8 Materialise arbitrary R objects ---- +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells_resource", +#' resource = paste0(project, ".cells") +#' ) +#' +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "cells_object", +#' expr = quote(as.resource.object(cells_resource)) +#' ) +#' ## 2.9 Map specific columns ---- +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "obesity_qof_2024_25", +#' expr = quote(cells_object$obesity_qof_2024_25) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_object", +#' expr = quote(as.resource.object(W)) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_band800", +#' expr = quote(W_object$band800) +#' ) +#' +#' ds.lmSLX(obesity_qof_2024_25 ~ dist_food_fastfood + obesity_qof_2023_24, +#' data = "cells_object", listw = "W_band800", datasources = conns) +#' +#' @export + +ds.gwrbasic <- function(formula = NULL, data = NULL, dMat = NULL, type='split', + do.checks = TRUE, + datasources=NULL){ + + + # look for DS connections + if(is.null(datasources)){ + datasources <- datashield.connections_find() + } + + # ensure datasources is a list of DSConnection-class + if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ + stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) + } + + if(is.null(formula)){ + stop("Please provide the input formula!", call.=FALSE) + } + + + + if(do.checks){ + + # check if the input objects are defined in all the studies + #isDefined(datasources, x) + isDefined(datasources, all.vars(formula)[1]) + + # call the internal function that checks the input object is of the same class in all studies. + #typ1 <- checkClass(datasources, x) + typ2 <- checkClass(datasources, all.vars(formula)[1]) + } + + dMat_arg <- ifelse((is.null(dMat)), "NULL", dMat) + calltext <- paste0("gwrbasicDS(", deparse(formula), ", ", data, ", ", dMat_arg,")", collapse = "") + + output <- DSI::datashield.aggregate(datasources, as.symbol(calltext)) + + ## Only type split supported now + if(type == "split"){ + result <- output + return(result) + } +} + + diff --git a/R/ds.inla.R b/R/ds.inla.R new file mode 100644 index 0000000..57dc664 --- /dev/null +++ b/R/ds.inla.R @@ -0,0 +1,47 @@ + + +ds.inla <- function(formula = NULL, data = NULL, type='split', + do.checks = TRUE, + datasources=NULL){ + + # look for DS connections + if(is.null(datasources)){ + datasources <- datashield.connections_find() + } + + # ensure datasources is a list of DSConnection-class + if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ + stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) + } + + if(is.null(formula)){ + stop("Please provide the input formula!", call.=FALSE) + } + + + + if(do.checks){ + + # check if the input objects are defined in all the studies + #isDefined(datasources, x) + isDefined(datasources, all.vars(formula)[1]) + + # call the internal function that checks the input object is of the same class in all studies. + #typ1 <- checkClass(datasources, x) + typ2 <- checkClass(datasources, all.vars(formula)[1]) + } + + browser() + calltext <- paste0("inlaDS(", deparse(formula), ", ", data, ")", collapse = "") + + output <- DSI::datashield.aggregate(datasources, as.symbol(calltext)) + + ## Only type split supported now + if(type == "split"){ + + result <- lapply(output, function(x) unlist(x)) + return(result) + } +} + + diff --git a/R/ds.lagsarlm.R b/R/ds.lagsarlm.R index 7ce698e..4366611 100644 --- a/R/ds.lagsarlm.R +++ b/R/ds.lagsarlm.R @@ -131,7 +131,7 @@ ds.lagsarlm <- function(formula = NULL, data = NULL, listw = NULL, type='split', #typ1 <- checkClass(datasources, x) typ2 <- checkClass(datasources, listw) } - browser() + calltext <- paste0("lagsarlmDS(", deparse(formula), ", ", listw, ", ", data, ")", collapse = "") diff --git a/R/ds.lmSLX.R b/R/ds.lmSLX.R new file mode 100644 index 0000000..3a97721 --- /dev/null +++ b/R/ds.lmSLX.R @@ -0,0 +1,165 @@ +#' @title Fit a Spatial Lag of X (SLX) Regression Model +#' +#' @description +#' Fits a Spatial Lag of X (SLX) regression model on DataSHIELD servers +#' using the server-side function \code{lmSLXDS()}. The function +#' estimates the association between an outcome and both local and +#' neighbouring explanatory variables without transferring individual-level +#' data to the client. +#' +#' @details +#' The SLX model incorporates spatially lagged explanatory variables +#' and is defined as: +#' +#' \deqn{y = X\beta + WX\theta + \epsilon} +#' +#' where \eqn{y} is the dependent variable, \eqn{X} is the matrix of +#' explanatory variables, \eqn{W} is the spatial weights matrix, +#' \eqn{\beta} represents the coefficients of local explanatory variables, +#' and \eqn{\theta} represents the coefficients of spatially lagged +#' explanatory variables. +#' +#' The function calls \code{lmSLXDS()} on each DataSHIELD server, +#' where disclosure checks are applied before fitting the model using +#' \code{spatialreg::lmSLX()}. +#' +#' Currently, only \code{type = "split"} is supported, returning +#' results separately for each server. +#' +#' @param formula An R formula specifying the dependent variable and +#' explanatory variables. +#' @param data Character string specifying the name of the data frame +#' on the DataSHIELD servers. +#' @param listw Character string specifying the name of a server-side +#' spatial weights object of class \code{listw}. +#' @param type Character string specifying how results are returned. +#' Currently, only \code{"split"} is supported. Defaults to +#' \code{"split"}. +#' @param do.checks Logical. If \code{TRUE}, checks whether the spatial +#' weights object exists on the DataSHIELD servers and retrieves its +#' class. Defaults to \code{TRUE}. +#' @param datasources A list of \code{DSConnection} objects representing +#' the DataSHIELD connections. If \code{NULL}, existing connections +#' are retrieved using \code{datashield.connections_find()}. +#' +#' @return +#' A named list containing results from each DataSHIELD server. +#' When \code{type = "split"}, each server's output is converted +#' to a vector using \code{unlist()}. +#' +#' If the server-side disclosure checks pass, the results contain +#' estimated regression coefficients, including coefficients for +#' spatially lagged explanatory variables. +#' +#' If the disclosure checks fail, the server returns information +#' about the failed checks instead of fitting the model. +#' +#' @seealso +#' \code{\link[spatialreg]{lmSLX}} +#' +#' @examples +#' \dontrun{ +#' DSOpal::Opal() +#' builder <- DSI::newDSLoginBuilder() +#' builder$append( +#' server = "mersey-demo", +#' url = "http://localhost:8880", +#' user = "administrator", +#' password = "password", +#' driver = "OpalDriver", +#' profile = "ds-geospatial" +#' ) +#' +#' logindata <- builder$build() +#' conns <- DSI::datashield.login(logins = logindata) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells", +#' resource = paste0(project, ".", "cells") +#' ) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "W", +#' resource = paste0(project, ".", "W_D_5km") +#' ) +#' ## 2.8 Materialise arbitrary R objects ---- +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells_resource", +#' resource = paste0(project, ".cells") +#' ) +#' +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "cells_object", +#' expr = quote(as.resource.object(cells_resource)) +#' ) +#' ## 2.9 Map specific columns ---- +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "obesity_qof_2024_25", +#' expr = quote(cells_object$obesity_qof_2024_25) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_object", +#' expr = quote(as.resource.object(W)) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_band800", +#' expr = quote(W_object$band800) +#' ) +#' +#' ds.lmSLX(obesity_qof_2024_25 ~ dist_food_fastfood + obesity_qof_2023_24, +#' data = "cells_object", listw = "W_band800", datasources = conns) +#' +#' @export + +ds.lmSLX <- function(formula = NULL, data = NULL, listw = NULL, type='split', + do.checks = TRUE, + datasources=NULL){ + + # look for DS connections + if(is.null(datasources)){ + datasources <- datashield.connections_find() + } + + # ensure datasources is a list of DSConnection-class + if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ + stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) + } + + if(is.null(formula)){ + stop("Please provide the input formula!", call.=FALSE) + } + + if(is.null(listw)){ + stop("Please provide the input vector 'listw'!, a list object", call.=FALSE) + } + + if(do.checks){ + + # check if the input objects are defined in all the studies + #isDefined(datasources, x) + isDefined(datasources, listw) + + # call the internal function that checks the input object is of the same class in all studies. + #typ1 <- checkClass(datasources, x) + typ2 <- checkClass(datasources, listw) + } + + + calltext <- paste0("lmSLXDS(", deparse(formula), ", ", listw, ", ", data, ")", collapse = "") + + output <- DSI::datashield.aggregate(datasources, as.symbol(calltext)) + + ## Only type split supported now + if(type == "split"){ + + result <- lapply(output, function(x) unlist(x)) + return(result) + } +} + + diff --git a/R/ds.plotSpatial.R b/R/ds.plotSpatial.R new file mode 100644 index 0000000..d47b55e --- /dev/null +++ b/R/ds.plotSpatial.R @@ -0,0 +1,168 @@ +#' Plot Spatial Distribution of Cases and Negatives +#' +#' @description +#' Creates a spatial map of cases and negative observations using +#' precomputed display coordinates and a basemap. The function calls +#' the corresponding server-side function, \code{plotSpatialDS()}, +#' through DataSHIELD and uses the returned data to construct a +#' \code{ggplot2} map. +#' +#' @details +#' The function requests spatial data from the server and generates +#' a map showing cases and negative observations within a specified +#' geographical window. +#' +#' The function performs the following steps: +#' \enumerate{ +#' \item Calls the server-side \code{plotSpatialDS()} function +#' using \code{DSI::datashield.aggregate()}. +#' \item Retrieves the case observations, negative observations, +#' and basemap returned by the server. +#' \item Defines a geographical display window with a 1 km buffer. +#' \item Overlays the observations on the basemap, displaying +#' negative observations as blue points and cases as orange triangles. +#' \item Adds a dashed boundary indicating the specified window +#' and a 1 km scale bar. +#' } +#' +#' Cases are selected by the server-side function according to the +#' minimum number of neighbouring cases specified by \code{k}. +#' The neighbourhood is defined by the supplied network distance +#' matrix \code{D}. +#' +#' @param D Character string specifying the name of the network +#' distance matrix assigned on the DataSHIELD server. +#' +#' @param study Character string specifying the name of the study +#' dataset assigned on the DataSHIELD server. The dataset must +#' contain the binary outcome variable specified by \code{case_var}. +#' +#' @param mapping Character string specifying the name of the +#' server-side mapping table linking study observations to +#' distance matrix row identifiers. +#' +#' @param pos Character string specifying the name of the +#' server-side object containing precomputed display coordinates. +#' +#' @param basemap Character string specifying the name of the +#' server-side basemap object containing the raster image +#' and its spatial extent. +#' +#' @param area Character string specifying the geographical area +#' to display. Defaults to \code{"east"}. +#' +#' @param case_var Character string specifying the binary outcome +#' variable, where 1 represents a case and 0 represents a +#' negative observation. Defaults to \code{"case"}. +#' +#' @param k Integer specifying the minimum number of other cases +#' required within the network neighbourhood for a case to +#' be displayed. Defaults to 5. +#' +#' @param xmin Numeric value specifying the minimum easting +#' of the geographical window. Defaults to 334000. +#' +#' @param ymin Numeric value specifying the minimum northing +#' of the geographical window. Defaults to 388500. +#' +#' @param xmax Numeric value specifying the maximum easting +#' of the geographical window. Defaults to 339000. +#' +#' @param ymax Numeric value specifying the maximum northing +#' of the geographical window. Defaults to 393500. +#' +#' @return +#' A \code{ggplot} object displaying the spatial distribution +#' of cases and negative observations over the basemap. +#' The plot includes a dashed geographical window boundary +#' and a 1 km scale bar. +#' +#' @seealso +#' \code{plotSpatialDS()} +#'ds.plotSpatial( +#' D = "D", +#' study = "study_object", +#' mapping = "mapping_object", +#' pos = "pos_object", +#' basemap = "basemap_object", +#' area = "east", +#' case_var = "case", +#' k = 5, +#' xmin = 334000, +#' ymin = 388500, +#' xmax = 339000, +#' ymax = 393500, +#' datasources = conns) +#' @export +#' +ds.plotSpatial <- function( + D, + study, + mapping, + pos, + basemap, + area = "east", + case_var = "case", + k = 5, + xmin = 334000, + ymin = 388500, + xmax = 339000, + ymax = 393500, + datasources +) { + + # Select the requested area + + window <- c(xmin = xmin, ymin = ymin, xmax = xmax, ymax = ymax) + view <- window + c(-1000, -1000, 1000, 1000) + + + calltext <- paste0( + "plotSpatialDS(", D, ",", study, ",", mapping, ",", pos, ",", + basemap, ",", + encodeString(area, quote = '"'), ",", + encodeString(case_var, quote = '"'), ",", + k, ")" + ) + + output <- DSI::datashield.aggregate(datasources, as.symbol(calltext)) + + basemap <- output[[1]]$basemap + cases <- output[[1]]$cases + negatives <- output[[1]]$negatives + + # 5. Plot on basemap + + bar_x <- view[["xmin"]] + 300 + bar_y <- view[["ymin"]] + 300 + + map_base <- ggplot2::ggplot() + + annotation_raster(basemap$img, basemap$xmin, basemap$xmax, basemap$ymin, basemap$ymax) + + annotate("rect", xmin = window[["xmin"]], xmax = window[["xmax"]], + ymin = window[["ymin"]], ymax = window[["ymax"]], + fill = NA, colour = "grey55", linetype = "dashed", linewidth = 0.3) + + annotate("segment", x = bar_x, xend = bar_x + 1000, y = bar_y, yend = bar_y, linewidth = 0.8) + + annotate("text", x = bar_x + 500, y = bar_y + 110, label = "1 km", size = 3) + + coord_equal(xlim = view[c("xmin", "xmax")], ylim = view[c("ymin", "ymax")], expand = FALSE) + + theme_void() + + p <- map_base + + ggplot2::geom_point( + data = negatives, + ggplot2::aes(x = x, y = y), + colour = "#2a78d6", + size = 1.4 + ) + + ggplot2::geom_point( + data = cases, + ggplot2::aes(x = x, y = y), + colour = "#eb6834", + shape = 17, + size = 2.2 + ) + + ggplot2::theme_void() + + return(p) +} + + diff --git a/R/ds.splm.R b/R/ds.splm.R new file mode 100644 index 0000000..b80519e --- /dev/null +++ b/R/ds.splm.R @@ -0,0 +1,225 @@ +#' @title Spatial Linear Regression in DataSHIELD +#' +#' @description +#' Performs spatial linear regression on data stored across one or more +#' DataSHIELD servers using the server-side \code{splmDS()} function, +#' which relies on \code{spmodel::splm()}. +#' +#' The function estimates regression relationships while accounting +#' for spatial dependence between observations through a spatial +#' covariance structure. +#' +#' @details +#' Spatial linear regression extends ordinary linear regression by +#' explicitly modelling spatial correlation in the regression errors. +#' Unlike geographically weighted regression (GWR), it estimates +#' global regression coefficients rather than location-specific +#' coefficients. +#' +#' The spatial linear model is expressed as: +#' +#' \deqn{y_i = \beta_0 + \sum_{k=1}^{p}\beta_k x_{ik} + \epsilon_i} +#' +#' where \eqn{y_i} is the dependent variable, \eqn{x_{ik}} represents +#' the explanatory variables, and \eqn{\epsilon_i} is a spatially +#' correlated error term. +#' +#' The underlying server-side function applies DataSHIELD disclosure +#' checks before model estimation, including: +#' +#' \itemize{ +#' \item A minimum number of complete observations, determined by +#' \code{nfilter.tab}. +#' \item A maximum ratio of model parameters to observations, +#' determined by \code{nfilter.glm}. +#' } +#' +#' If \code{do.checks = TRUE}, the client function checks whether +#' the dependent variable specified in \code{formula} is defined +#' on the connected DataSHIELD servers and retrieves its class +#' information. +#' +#' The regression is performed independently on each datasource. +#' No pooled or federated model is estimated. +#' +#' Currently, only \code{type = "split"} is supported. +#' +#' @param formula An R formula specifying the dependent variable +#' and one or more independent variables for the spatial +#' linear regression model. +#' +#' @param data A character string specifying the name of the +#' server-side spatial data object, typically an \code{sf} +#' object, containing the variables specified in \code{formula} +#' and the spatial geometry required for model estimation. +#' +#' @param type A character string specifying the output format. +#' Currently, only \code{"split"} is supported, returning +#' results separately for each datasource. +#' Default is \code{"split"}. +#' +#' @param do.checks Logical. If \code{TRUE}, performs preliminary +#' checks on the dependent variable across the connected +#' DataSHIELD servers. +#' Default is \code{TRUE}. +#' +#' @param datasources A list of \code{DSConnection} objects +#' representing the DataSHIELD servers. +#' If \code{NULL}, connections are obtained using +#' \code{datashield.connections_find()}. +#' +#' @return +#' A named list containing the spatial linear regression results +#' from each DataSHIELD server. +#' +#' When the server-side disclosure checks are satisfied, each +#' datasource returns a list containing: +#' +#' \describe{ +#' \item{\code{fixed}}{ +#' Estimated fixed-effect regression coefficients. +#' } +#' \item{\code{spcov}}{ +#' Estimated spatial covariance parameters describing the +#' spatial dependence structure of the regression errors. +#' } +#' \item{\code{randcov}}{ +#' Estimated random-effect covariance parameters, where +#' applicable. May be \code{NULL} if no random effects +#' are specified. +#' } +#' } +#' +#' If the server-side disclosure checks fail, the corresponding +#' datasource returns a list containing: +#' +#' \describe{ +#' \item{\code{Table_valid}}{ +#' Logical value \code{FALSE}, indicating that the model +#' failed the disclosure checks. +#' } +#' \item{\code{Nvalid}}{ +#' Number of complete observations. +#' } +#' \item{\code{Nmissing}}{ +#' Number of observations containing missing values. +#' } +#' \item{\code{Ntotal}}{ +#' Total number of observations. +#' } +#' \item{\code{Warning}}{ +#' Message explaining why the disclosure checks failed. +#' } +#' } +#' +#' Results are returned separately for each datasource without +#' flattening the underlying list structure. +#' +#' @seealso +#' \code{\link[spmodel]{splm}}, +#' \code{\link[DSI]{datashield.aggregate}} +#' +#' +#' @examples +#' \dontrun{ +#' DSOpal::Opal() +#' builder <- DSI::newDSLoginBuilder() +#' builder$append( +#' server = "mersey-demo", +#' url = "http://localhost:8880", +#' user = "administrator", +#' password = "password", +#' driver = "OpalDriver", +#' profile = "ds-geospatial" +#' ) +#' +#' logindata <- builder$build() +#' conns <- DSI::datashield.login(logins = logindata) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells", +#' resource = paste0(project, ".", "cells") +#' ) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "W", +#' resource = paste0(project, ".", "W_D_5km") +#' ) +#' ## 2.8 Materialise arbitrary R objects ---- +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells_resource", +#' resource = paste0(project, ".cells") +#' ) +#' +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "cells_object", +#' expr = quote(as.resource.object(cells_resource)) +#' ) +#' ## 2.9 Map specific columns ---- +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "obesity_qof_2024_25", +#' expr = quote(cells_object$obesity_qof_2024_25) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_object", +#' expr = quote(as.resource.object(W)) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_band800", +#' expr = quote(W_object$band800) +#' ) +#' +#' ds.splm( +#' formula = obesity_qof_2024_25 ~ dist_food_fastfood, +#' data = "cells_object", +#' datasources = conns +#' ) +#' @export + +ds.splm <- function(formula = NULL, data = NULL, + type='split', do.checks = TRUE, datasources=NULL){ + + # look for DS connections + if(is.null(datasources)){ + datasources <- datashield.connections_find() + } + + # ensure datasources is a list of DSConnection-class + if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ + stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) + } + + if(is.null(formula)){ + stop("Please provide the input formula!", call.=FALSE) + } + + + if(do.checks){ + + # check if the input objects are defined in all the studies + #isDefined(datasources, x) + isDefined(datasources, all.vars(formula)[1]) + + # call the internal function that checks the input object is of the same class in all studies. + #typ1 <- checkClass(datasources, x) + typ2 <- checkClass(datasources, all.vars(formula)[1]) + } + + calltext <- paste0("splmDS(", deparse(formula), ", ", data, ")", collapse = "") + + output <- DSI::datashield.aggregate(datasources, as.symbol(calltext)) + + ## Only type split supported now + if(type == "split"){ + + result <- output + return(result) + } +} + + diff --git a/R/ds.weigen.R b/R/ds.weigen.R new file mode 100644 index 0000000..bd73892 --- /dev/null +++ b/R/ds.weigen.R @@ -0,0 +1,225 @@ +#' @title Calculate Spatial Eigenvectors in DataSHIELD +#' +#' @description +#' Calculates spatial eigenvectors from geographical data using +#' \code{spmoran::weigen()} through the server-side +#' \code{weigenDS()} function. +#' +#' The function enables spatial eigenvector analysis across one or +#' more DataSHIELD servers without transferring individual-level +#' spatial data to the client. +#' +#' @details +#' Spatial eigenvectors represent spatial patterns among geographical +#' observations and can be used to account for spatial autocorrelation +#' in statistical models. +#' +#' The function calls \code{weigenDS()} independently on each +#' DataSHIELD server. The server-side function extracts centroid +#' coordinates from the supplied spatial dataset and calculates +#' spatial eigenvectors using \code{spmoran::weigen()}. +#' +#' The spatial neighbourhood structure is determined by the +#' \code{weights} argument. For example, \code{"knn"} constructs +#' a k-nearest-neighbour structure, while \code{"tri"} uses +#' Delaunay triangulation. +#' +#' The \code{k} argument specifies the number of nearest neighbours +#' when \code{weights = "knn"}. The \code{threshold} and \code{enum} +#' arguments control the selection and maximum number of spatial +#' eigenvectors. +#' +#' When \code{do.checks = TRUE}, the function checks whether the +#' input object exists on the specified servers and examines its +#' class before executing the analysis. +#' +#' The server-side function applies DataSHIELD disclosure checks +#' based on the minimum observation threshold (\code{nfilter.tab}). +#' Only the server-generated summaries are returned to the client. +#' The observation-level eigenvector matrix is not returned. +#' +#' Currently, only \code{type = "split"} is supported. Results +#' are returned separately for each DataSHIELD server, without +#' pooling estimates across studies. +#' +#' @param x A character string specifying the name of a server-side +#' \code{sf} object containing the spatial observations. +#' The object must be available on each selected DataSHIELD server. +#' +#' @param weights A character string specifying the method used to +#' construct the spatial neighbourhood structure. Supported values +#' include \code{"knn"} for k-nearest neighbours and \code{"tri"} +#' for Delaunay triangulation. Default is \code{"knn"}. +#' +#' @param k An integer specifying the number of nearest neighbours +#' when \code{weights = "knn"}. Default is \code{4}. +#' +#' @param threshold A numeric value specifying the relative eigenvalue +#' threshold used to select spatial eigenvectors. +#' Default is \code{0.25}. +#' +#' @param enum An integer specifying the maximum number of spatial +#' eigenvectors to extract. Default is \code{100}. +#' +#' @param type A character string specifying the output format. +#' Currently, only \code{"split"} is supported, returning +#' results separately for each DataSHIELD server. +#' Default is \code{"split"}. +#' +#' @param do.checks A logical value indicating whether to check +#' that the input object exists and examine its class across +#' the selected DataSHIELD servers. Default is \code{TRUE}. +#' +#' @param datasources A list of \code{DSConnection} objects specifying +#' the DataSHIELD servers on which the analysis should be performed. +#' If \code{NULL}, the currently active DataSHIELD connections +#' are used. +#' +#' @return +#' A named list containing the results returned by each DataSHIELD +#' server when \code{type = "split"}. +#' +#' For successful analyses, each server returns: +#' \describe{ +#' \item{\code{n_eigenvectors}}{ +#' Number of retained spatial eigenvectors. +#' } +#' \item{\code{eigenvalue_summary}}{ +#' Named numeric vector containing the first quartile +#' (\code{Q1}), median (\code{Median}), mean (\code{Mean}), +#' and third quartile (\code{Q3}) of the retained eigenvalues. +#' } +#' \item{\code{spectrum}}{ +#' Numeric vector containing the retained eigenvalues, +#' if included in the server-side output. +#' } +#' } +#' +#' If the server-side disclosure check fails, the returned list +#' contains \code{Table_valid = FALSE}, together with the +#' observation counts and a warning message, as provided by +#' \code{weigenDS()}. +#' +#' @note +#' The analysis is performed independently on each DataSHIELD server. +#' No individual spatial observations or eigenvector matrices are +#' returned to the client. +#' +#' The server-side minimum observation-count check does not, by +#' itself, guarantee that all returned summaries are disclosure-safe. +#' In particular, releasing the complete eigenvalue spectrum or +#' exact counts may require additional disclosure assessment. +#' +#' @seealso +#' \code{\link[spmoran]{weigen}}, +#' \code{\link[DSI]{datashield.aggregate}} +#' +#' @examples +#' \dontrun{ +#' DSOpal::Opal() +#' builder <- DSI::newDSLoginBuilder() +#' builder$append( +#' server = "mersey-demo", +#' url = "http://localhost:8880", +#' user = "administrator", +#' password = "password", +#' driver = "OpalDriver", +#' profile = "ds-geospatial" +#' ) +#' +#' logindata <- builder$build() +#' conns <- DSI::datashield.login(logins = logindata) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells", +#' resource = paste0(project, ".", "cells") +#' ) +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "W", +#' resource = paste0(project, ".", "W_D_5km") +#' ) +#' ## 2.8 Materialise arbitrary R objects ---- +#' DSI::datashield.assign.resource( +#' conns, +#' symbol = "cells_resource", +#' resource = paste0(project, ".cells") +#' ) +#' +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "cells_object", +#' expr = quote(as.resource.object(cells_resource)) +#' ) +#' ## 2.9 Map specific columns ---- +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "obesity_qof_2024_25", +#' expr = quote(cells_object$obesity_qof_2024_25) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_object", +#' expr = quote(as.resource.object(W)) +#' ) +#' DSI::datashield.assign.expr( +#' conns, +#' symbol = "W_band800", +#' expr = quote(W_object$band800) +#' ) +#' +#'ds.weigen( +#' x = "cells_object", +#' weights = "knn", +#' k = 4, +#' threshold = 0.25, +#' enum = 100, +#' datasources = conns +#' ) +#' +#' @export + +ds.weigen <- function(x = NULL, weights = "knn", + k = 4, threshold = 0.25, + enum = 100, type='split', + do.checks = TRUE, + datasources=NULL){ + + # look for DS connections + if(is.null(datasources)){ + datasources <- datashield.connections_find() + } + + # ensure datasources is a list of DSConnection-class + if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ + stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) + } + + if(is.null(x)){ + stop("Please provide the input vector 'x', an sf object!", call.=FALSE) + } + + + + if(do.checks){ + + # check if the input objects are defined in all the studies + isDefined(datasources, x) + + # call the internal function that checks the input object is of the same class in all studies. + typ1 <- checkClass(datasources, x) + } + + + calltext <- paste0("weigenDS(", x, ", ", shQuote(weights), ", ", k, ", ", threshold, ",", enum, ")") + + output <- DSI::datashield.aggregate(datasources, as.symbol(calltext)) + + ## Only type split supported now + if(type == "split"){ + result <- output + return(result) + } +} + + diff --git a/man/ds.lagsarlm.Rd b/man/ds.lagsarlm.Rd new file mode 100644 index 0000000..3549b5b --- /dev/null +++ b/man/ds.lagsarlm.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ds.lagsarlm.R +\name{ds.lagsarlm} +\alias{ds.lagsarlm} +\title{Calculate Moran's I} +\usage{ +ds.lagsarlm( + formula = NULL, + data = NULL, + listw = NULL, + type = "split", + do.checks = TRUE, + datasources = NULL +) +} +\arguments{ +\item{listw}{Character string specifying the name of the spatial weights +object of class \code{listw} on the server.} + +\item{type}{Character string specifying the output format. Currently only +\code{"split"} is supported.} + +\item{do.checks}{Logical. If \code{TRUE}, checks that the input objects are +defined and have consistent classes across the studies.} + +\item{datasources}{A list of \code{DSConnection} objects. If \code{NULL}, +active DataSHIELD connections are used.} + +\item{x}{Character string specifying the name of the numeric vector on the +server to be analysed.} + +\item{vars}{Optional variable specification. Currently unused.} + +\item{nsim}{Numeric value specifying the number of simulations used for +calculating the Monte Carlo p-value. Default is 199.} +} +\value{ +A named list with one element per study. Each study contains a +named numeric vector with: +\itemize{ +\item \code{moran_I}: Moran's I statistic. +\item \code{z}: standardised Moran's I statistic. +\item \code{p_mc}: Monte Carlo p-value. +} +} +\description{ +Calculates Moran's I for a numeric variable using a spatial weights +object across one or more DataSHIELD studies. +} diff --git a/man/ds.lmSLX.Rd b/man/ds.lmSLX.Rd new file mode 100644 index 0000000..d396f68 --- /dev/null +++ b/man/ds.lmSLX.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ds.lmSLX.R +\name{ds.lmSLX} +\alias{ds.lmSLX} +\title{Calculate Moran's I} +\usage{ +ds.lmSLX( + formula = NULL, + data = NULL, + listw = NULL, + type = "split", + do.checks = TRUE, + datasources = NULL +) +} +\arguments{ +\item{listw}{Character string specifying the name of the spatial weights +object of class \code{listw} on the server.} + +\item{type}{Character string specifying the output format. Currently only +\code{"split"} is supported.} + +\item{do.checks}{Logical. If \code{TRUE}, checks that the input objects are +defined and have consistent classes across the studies.} + +\item{datasources}{A list of \code{DSConnection} objects. If \code{NULL}, +active DataSHIELD connections are used.} + +\item{x}{Character string specifying the name of the numeric vector on the +server to be analysed.} + +\item{vars}{Optional variable specification. Currently unused.} + +\item{nsim}{Numeric value specifying the number of simulations used for +calculating the Monte Carlo p-value. Default is 199.} +} +\value{ +A named list with one element per study. Each study contains a +named numeric vector with: +\itemize{ +\item \code{moran_I}: Moran's I statistic. +\item \code{z}: standardised Moran's I statistic. +\item \code{p_mc}: Monte Carlo p-value. +} +} +\description{ +Calculates Moran's I for a numeric variable using a spatial weights +object across one or more DataSHIELD studies. +} diff --git a/man/ds.localmoran.Rd b/man/ds.localmoran.Rd new file mode 100644 index 0000000..eaf86b2 --- /dev/null +++ b/man/ds.localmoran.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ds.localmoran.R +\name{ds.localmoran} +\alias{ds.localmoran} +\title{Calculate Local Moran's I} +\usage{ +ds.localmoran( + x = NULL, + listw = NULL, + type = "split", + vars = NULL, + do.checks = TRUE, + nsim = 199, + datasources = NULL +) +} +\arguments{ +\item{x}{Character string specifying the name of the numeric vector on the +server to be analysed.} + +\item{listw}{Character string specifying the name of the spatial weights +object of class \code{listw} on the server.} + +\item{type}{Character string specifying the output format. Currently only +\code{"split"} is supported.} + +\item{vars}{Optional variable specification. Currently unused.} + +\item{do.checks}{Logical. If \code{TRUE}, checks that the input objects are +defined and have consistent classes across the studies.} + +\item{nsim}{Numeric value specifying the number of simulations used for +calculating the Monte Carlo p-value. Default is 199.} + +\item{datasources}{A list of \code{DSConnection} objects. If \code{NULL}, +active DataSHIELD connections are used.} +} +\value{ +A named list with one element per study. Each study contains a +named numeric vector with: +\itemize{ +\item \code{moran_I}: Moran's I statistic. +\item \code{z}: standardised Moran's I statistic. +} +} +\description{ +Calculates Local Moran's I for a numeric variable using a spatial weights +object across one or more DataSHIELD studies. +} diff --git a/man/ds.moransI.Rd b/man/ds.moransI.Rd new file mode 100644 index 0000000..ef7d011 --- /dev/null +++ b/man/ds.moransI.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ds.moransI.R +\name{ds.moransI} +\alias{ds.moransI} +\title{Calculate Moran's I} +\usage{ +ds.moransI( + x = NULL, + listw = NULL, + type = "split", + vars = NULL, + do.checks = TRUE, + nsim = 199, + datasources = NULL +) +} +\arguments{ +\item{x}{Character string specifying the name of the numeric vector on the +server to be analysed.} + +\item{listw}{Character string specifying the name of the spatial weights +object of class \code{listw} on the server.} + +\item{type}{Character string specifying the output format. Currently only +\code{"split"} is supported.} + +\item{vars}{Optional variable specification. Currently unused.} + +\item{do.checks}{Logical. If \code{TRUE}, checks that the input objects are +defined and have consistent classes across the studies.} + +\item{nsim}{Numeric value specifying the number of simulations used for +calculating the Monte Carlo p-value. Default is 199.} + +\item{datasources}{A list of \code{DSConnection} objects. If \code{NULL}, +active DataSHIELD connections are used.} +} +\value{ +A named list with one element per study. Each study contains a +named numeric vector with: +\itemize{ +\item \code{moran_I}: Moran's I statistic. +\item \code{z}: standardised Moran's I statistic. +\item \code{p_mc}: Monte Carlo p-value. +} +} +\description{ +Calculates Moran's I for a numeric variable using a spatial weights +object across one or more DataSHIELD studies. +} diff --git a/vignettes/Opal_functioncheck.Rmd b/vignettes/Opal_functioncheck.Rmd index dfa1614..9848f2e 100644 --- a/vignettes/Opal_functioncheck.Rmd +++ b/vignettes/Opal_functioncheck.Rmd @@ -315,3 +315,31 @@ ds.lagsarlm(obesity_qof_2024_25 ~ dist_food_fastfood + obesity_qof_2023_24, data = "cells_object", listw = "W_band800", datasources = conns) ``` + + +```{r} +ds.lmSLX(obesity_qof_2024_25 ~ dist_food_fastfood + obesity_qof_2023_24, + data = "cells_object", listw = "W_band800", datasources = conns) +``` + + +```{r} +ds.gwrbasic(obesity_qof_2024_25 ~ dist_food_fastfood, + data = "cells_object", dMat = NULL, datasources= conns) + +``` + +```{r} +ds.conleyreg(formula = obesity_qof_2024_25 ~ dist_food_fastfood, + data = "cells_object", dist_cutoff = 1000, datasources = conns) +``` + +```{r} +ds.splm(formula = obesity_qof_2024_25 ~ dist_food_fastfood, + data = "cells_object", datasources = conns) +``` + +```{r} +ds.weigen(x = "cells_object", datasources=conns) + +``` \ No newline at end of file