From 83e2951ab1fb59408c62b8b5cb70a42b94c8c9a1 Mon Sep 17 00:00:00 2001 From: mathesong Date: Wed, 14 Aug 2024 13:54:52 +0200 Subject: [PATCH] Added weighting for blood fitting models --- NAMESPACE | 1 + R/kinfitr_bloodfuncs.R | 63 ++++++++++++ R/kinfitr_bloodmodels.R | 192 ++++++++++++++++++++++-------------- man/blmod_exp.Rd | 16 ++- man/blmod_feng.Rd | 16 ++- man/blmod_fengconv.Rd | 16 ++- man/blmod_fengconvplus.Rd | 16 ++- man/blmod_splines.Rd | 43 ++++++-- man/blood_weights_create.Rd | 46 +++++++++ 9 files changed, 317 insertions(+), 92 deletions(-) create mode 100644 man/blood_weights_create.Rd diff --git a/NAMESPACE b/NAMESPACE index d3246b8..d1a417a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,6 +40,7 @@ export(blmod_triexp_model) export(blood_dispcor) export(blood_interp) export(blood_smooth) +export(blood_weights_create) export(bloodstream_import_aifpars) export(bloodstream_import_inputfunctions) export(create_blooddata_bids) diff --git a/R/kinfitr_bloodfuncs.R b/R/kinfitr_bloodfuncs.R index 29b04ce..cfdaf39 100644 --- a/R/kinfitr_bloodfuncs.R +++ b/R/kinfitr_bloodfuncs.R @@ -657,3 +657,66 @@ blood_smooth <- function(time, activity, iterations = 1) { tibble::tibble(time = time, activity = activity) } + +#' Create Weights for Modelling Whole Blood and AIF Data +#' +#' @param time The time of each measurement. +#' @param activity The radioactivity of each measurement. +#' @param Method Optional. The method of collection, i.e. "Discrete" or +#' "Continuous". +#' @param Method_weights Should the weights be divided by discrete and +#' continuous samples equally (i.e. with more continuous samples, the +#' continuous samples each get less weight). Default is TRUE. +#' @param taper_weights Should the weights be tapered to gradually trade off +#' between the continuous and discrete samples after the peak? +#' @param weightscheme Which weighting scheme should be used before +#' accommodating Method_divide and taper_weights? 1 represents a uniform +#' weighting before accommodating Method_divide and taper_weights. 2 +#' represents time/AIF as used by Columbia PET Centre. Default is 2. +#' +#' @return A vector of model weights +#' @export +#' +#' @examples +#' blooddata <- pbr28$blooddata[[1]] +#' aif <- bd_extract(blooddata, output = "AIF") +#' blood_weights_create(aif$time, aif$aif, aif$Method) +blood_weights_create <- function(time, activity, + Method = NULL, + Method_weights = TRUE, + taper_weights = TRUE, + weightscheme=2) { + + if(!Method_weights) Method <- NULL + + blood <- blmod_tidyinput(time, activity, Method, weights=NULL) + + peak_index <- which(activity==max(activity)) + peaktime <- time[peak_index] + + # Remove pre-peak discrete + if( length(unique(blood$Method)) == 2 ) { # i.e. both cont and discrete + discrete_before_peak <- which(blood$Method=="Discrete" & + blood$time < peaktime) + + blood$weights[discrete_before_peak] <- 0 + } + + if(taper_weights) { + blood$weights <- ifelse(blood$Method=="Continuous", + yes = blood$weights * (1-blood$peakfrac), + no = blood$weights * blood$peakfrac) + } + + # Set a minimum value to prevent extreme weights + blood$activity[blood$activity < max(blood$activity / 1e4)] <- max(blood$activity / 1e4) + + basicweights <- dplyr::case_when( + weightscheme==1 ~ 1, + weightscheme==2 ~ blood$time / blood$activity, + ) + + out <- basicweights * blood$weights + + return(out) +} diff --git a/R/kinfitr_bloodmodels.R b/R/kinfitr_bloodmodels.R index a5fddf9..97ebb12 100644 --- a/R/kinfitr_bloodmodels.R +++ b/R/kinfitr_bloodmodels.R @@ -85,20 +85,39 @@ blmod_tidyinput <- function(time, activity, Method = NULL, weights = NULL) { #' Blood Model: Splines #' -#' Fits two or three (if both discrete and continuous) splines to blood or AIF data to smooth it +#' Fits two or three (if both discrete and continuous) splines to blood or AIF +#' data to smooth it #' #' @param time The time of each measurement in seconds #' @param activity The radioactivity of each measurement -#' @param Method Optional. The method of collection, i.e. "Discrete" or "Continuous" +#' @param Method Optional. The method of collection, i.e. "Discrete" or +#' "Continuous" #' @param weights Optional. Weights of each measurement. -#' @param bs_before Optional. Defines the basis function for the points before the peak. -#' @param bs_after_c Optional. Defines the basis function for the continuous points after the peak. -#' @param bs_after_d Optional. Defines the basis function for the discrete points after the peak. -#' @param k_before Optional. Defines the dimension of the basis for the points before the peak. -#' @param k_after_c Optional. Defines the dimension of the basis for the continuous points after the peak. -#' @param k_after_d Optional. Defines the dimension of the basis for the discrete points after the peak. -#' -#' @return A model fit including all of the individual models of class blood_splines. +#' @param Method_weights If no weights provided, should the weights be divided +#' by discrete and continuous samples equally (i.e. with more continuous +#' samples, the continuous samples each get less weight). Default is TRUE. +#' @param taper_weights If no weights provided, should the weights be tapered to +#' gradually trade off between the continuous and discrete samples after the +#' peak? +#' @param weightscheme If no weights provided, which weighting scheme should be +#' used before accommodating Method_divide and taper_weights? 1 represents a +#' uniform weighting before accommodating Method_divide and taper_weights. 2 +#' represents time/AIF as used by Columbia PET Centre. Default is 2. +#' @param bs_before Optional. Defines the basis function for the points before +#' the peak. +#' @param bs_after_c Optional. Defines the basis function for the continuous +#' points after the peak. +#' @param bs_after_d Optional. Defines the basis function for the discrete +#' points after the peak. +#' @param k_before Optional. Defines the dimension of the basis for the points +#' before the peak. +#' @param k_after_c Optional. Defines the dimension of the basis for the +#' continuous points after the peak. +#' @param k_after_d Optional. Defines the dimension of the basis for the +#' discrete points after the peak. +#' +#' @return A model fit including all of the individual models of class +#' blood_splines. #' @export #' #' @examples @@ -109,11 +128,21 @@ blmod_tidyinput <- function(time, activity, Method = NULL, weights = NULL) { #' blood$activity, #' Method = blood$Method) blmod_splines <- function(time, activity, Method = NULL, weights = NULL, + Method_weights = TRUE, + taper_weights = TRUE, + weightscheme=2, bs_before="cr", bs_after_c="cr", bs_after_d="cr", k_before=-1, k_after_c=-1, k_after_d=-1) { blood <- blmod_tidyinput(time, activity, Method, weights) + if(is.null(weights)) { + blood$weights <- blood_weights_create(blood$time, blood$activity, blood$Method, + Method_weights = Method_weights, + taper_weights = taper_weights, + weightscheme = weightscheme) + } + peaktime <- blood$time[blood$activity == max(blood$activity)] before_peak <- dplyr::filter(blood, time <= peaktime) @@ -201,7 +230,8 @@ blmod_splines <- function(time, activity, Method = NULL, weights = NULL, after_c = after_c, peaktime = peaktime, start_overlap = start_overlap, - stop_overlap = stop_overlap + stop_overlap = stop_overlap, + time = blood$time ) class(out) <- c("blood_splines", "blmod", class(out)) @@ -230,6 +260,7 @@ blmod_splines <- function(time, activity, Method = NULL, weights = NULL, #' predict_blood_splines(blood_fit, newdata=list(time=1:10)) #' @export predict_blood_splines <- function(object, newdata = NULL) { + if (is.null(newdata)) { pred_before <- as.numeric(predict(object$before)) pred_x_before <- object$before$model$time @@ -575,8 +606,16 @@ blmod_exp_startpars <- function(time, activity, fit_exp3=TRUE, #' @param multstart_iter The number of fits to perform with different starting #' parameters. If set to 1, then the starting parameters will be used for a #' single fit. -#' @param taper_weights Should the weights be tapered to gradually trade off -#' between the continuous and discrete samples after the peak? +#' @param Method_weights If no weights provided, should the weights be divided +#' by discrete and continuous samples equally (i.e. with more continuous +#' samples, the continuous samples each get less weight). Default is TRUE. +#' @param taper_weights If no weights provided, should the weights be tapered to +#' gradually trade off between the continuous and discrete samples after the +#' peak? +#' @param weightscheme If no weights provided, which weighting scheme should be +#' used before accommodating Method_divide and taper_weights? 1 represents a +#' uniform weighting before accommodating Method_divide and taper_weights. 2 +#' represents time/AIF as used by Columbia PET Centre. Default is 2. #' @param check_startpars Optional. Return only the starting parameters. Useful #' for debugging fits which do not work. #' @param expdecay_props What proportions of the decay should be used for @@ -606,7 +645,9 @@ blmod_exp <- function(time, activity, Method = NULL, multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 100, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme=2, check_startpars = FALSE, expdecay_props = c(1/60, 0.1)) { @@ -614,6 +655,13 @@ blmod_exp <- function(time, activity, Method = NULL, # Tidy up blood <- blmod_tidyinput(time, activity, Method, weights) + if(is.null(weights)) { + blood$weights <- blood_weights_create(blood$time, blood$activity, blood$Method, + Method_weights = Method_weights, + taper_weights = taper_weights, + weightscheme = weightscheme) + } + # Create starting parameters ## Note: start contains actual starting parameters. Startvals useful for other @@ -625,20 +673,6 @@ blmod_exp <- function(time, activity, Method = NULL, start <- startvals } - # Fix weights - if( length(unique(blood$Method)) == 2 ) { # i.e. both cont and discrete - discrete_before_peak <- which(blood$Method=="Discrete" & - blood$time < startvals$peaktime) - - blood$weights[discrete_before_peak] <- 0 - } - - if(taper_weights) { - blood$weights <- ifelse(blood$Method=="Continuous", - yes = blood$weights * (1-blood$peakfrac), - no = blood$weights * blood$peakfrac) - } - # Set up start, upper and lower parameter lists if(is.null(lower)) { @@ -1472,8 +1506,16 @@ blmod_feng_startpars <- function(time, activity, #' @param multstart_iter The number of fits to perform with different starting #' parameters. If set to 1, then the starting parameters will be used for a #' single fit. -#' @param taper_weights Should the weights be tapered to gradually trade off -#' between the continuous and discrete samples after the peak? +#' @param Method_weights If no weights provided, should the weights be divided +#' by discrete and continuous samples equally (i.e. with more continuous +#' samples, the continuous samples each get less weight). Default is TRUE. +#' @param taper_weights If no weights provided, should the weights be tapered to +#' gradually trade off between the continuous and discrete samples after the +#' peak? +#' @param weightscheme If no weights provided, which weighting scheme should be +#' used before accommodating Method_divide and taper_weights? 1 represents a +#' uniform weighting before accommodating Method_divide and taper_weights. 2 +#' represents time/AIF as used by Columbia PET Centre. Default is 2. #' @param check_startpars Optional. Return only the starting parameters. Useful #' for debugging fits which do not work. #' @param expdecay_props What proportions of the decay should be used for @@ -1510,7 +1552,9 @@ blmod_feng <- function(time, activity, Method = NULL, multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 100, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme=2, check_startpars = FALSE, expdecay_props = c(1/60, 0.1)) { @@ -1518,6 +1562,13 @@ blmod_feng <- function(time, activity, Method = NULL, # Tidy up blood <- blmod_tidyinput(time, activity, Method, weights) + if(is.null(weights)) { + blood$weights <- blood_weights_create(blood$time, blood$activity, blood$Method, + Method_weights = Method_weights, + taper_weights = taper_weights, + weightscheme = weightscheme) + } + # Create starting parameters ## Note: start contains actual starting parameters. Startvals useful for other @@ -1528,20 +1579,6 @@ blmod_feng <- function(time, activity, Method = NULL, start <- startvals } - # Fix weights - if( length(unique(blood$Method)) == 2 ) { # i.e. both cont and discrete - discrete_before_peak <- which(blood$Method=="Discrete" & - blood$time < startvals$peaktime) - - blood$weights[discrete_before_peak] <- 0 - } - - if(taper_weights) { - blood$weights <- ifelse(blood$Method=="Continuous", - yes = blood$weights * (1-blood$peakfrac), - no = blood$weights * blood$peakfrac) - } - # Set up start, upper and lower parameter lists if(is.null(lower)) { @@ -1798,8 +1835,16 @@ predict_blood_feng <- function(object, newdata = NULL) { #' @param multstart_iter The number of fits to perform with different starting #' parameters. If set to 1, then the starting parameters will be used for a #' single fit. -#' @param taper_weights Should the weights be tapered to gradually trade off -#' between the continuous and discrete samples after the peak? +#' @param Method_weights If no weights provided, should the weights be divided +#' by discrete and continuous samples equally (i.e. with more continuous +#' samples, the continuous samples each get less weight). Default is TRUE. +#' @param taper_weights If no weights provided, should the weights be tapered to +#' gradually trade off between the continuous and discrete samples after the +#' peak? +#' @param weightscheme If no weights provided, which weighting scheme should be +#' used before accommodating Method_divide and taper_weights? 1 represents a +#' uniform weighting before accommodating Method_divide and taper_weights. 2 +#' represents time/AIF as used by Columbia PET Centre. Default is 2. #' @param check_startpars Optional. Return only the starting parameters. Useful #' for debugging fits which do not work. #' @param expdecay_props What proportions of the decay should be used for @@ -1840,7 +1885,9 @@ blmod_fengconv <- function(time, activity, inftime = NULL, multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 500, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme=2, check_startpars = FALSE, expdecay_props = c(0, 0.5)) { @@ -1848,6 +1895,12 @@ blmod_fengconv <- function(time, activity, inftime = NULL, # Tidy up blood <- blmod_tidyinput(time, activity, Method, weights) + if(is.null(weights)) { + blood$weights <- blood_weights_create(blood$time, blood$activity, blood$Method, + Method_weights = Method_weights, + taper_weights = taper_weights, + weightscheme = weightscheme) + } # Create starting parameters ## Note: start contains actual starting parameters. Startvals useful for other @@ -1858,20 +1911,6 @@ blmod_fengconv <- function(time, activity, inftime = NULL, start <- startvals } - # Fix weights - if( length(unique(blood$Method)) == 2 ) { # i.e. both cont and discrete - discrete_before_peak <- which(blood$Method=="Discrete" & - blood$time < startvals$peaktime) - - blood$weights[discrete_before_peak] <- 0 - } - - if(taper_weights) { - blood$weights <- ifelse(blood$Method=="Continuous", - yes = blood$weights * (1-blood$peakfrac), - no = blood$weights * blood$peakfrac) - } - # Set up start, upper and lower parameter lists if(is.null(lower)) { @@ -2209,8 +2248,16 @@ predict_blood_fengconv <- function(object, newdata = NULL) { #' @param multstart_iter The number of fits to perform with different starting #' parameters. If set to 1, then the starting parameters will be used for a #' single fit. -#' @param taper_weights Should the weights be tapered to gradually trade off -#' between the continuous and discrete samples after the peak? +#' @param Method_weights If no weights provided, should the weights be divided +#' by discrete and continuous samples equally (i.e. with more continuous +#' samples, the continuous samples each get less weight). Default is TRUE. +#' @param taper_weights If no weights provided, should the weights be tapered to +#' gradually trade off between the continuous and discrete samples after the +#' peak? +#' @param weightscheme If no weights provided, which weighting scheme should be +#' used before accommodating Method_divide and taper_weights? 1 represents a +#' uniform weighting before accommodating Method_divide and taper_weights. 2 +#' represents time/AIF as used by Columbia PET Centre. Default is 2. #' @param check_startpars Optional. Return only the starting parameters. Useful #' for debugging fits which do not work. #' @param expdecay_props What proportions of the decay should be used for @@ -2244,7 +2291,9 @@ blmod_fengconvplus <- function(time, activity, inftime = NULL, multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 500, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme=2, check_startpars = FALSE, expdecay_props = c(0, 0.5)) { @@ -2252,6 +2301,13 @@ blmod_fengconvplus <- function(time, activity, inftime = NULL, # Tidy up blood <- blmod_tidyinput(time, activity, Method, weights) + if(is.null(weights)) { + blood$weights <- blood_weights_create(blood$time, blood$activity, blood$Method, + Method_weights = Method_weights, + taper_weights = taper_weights, + weightscheme = weightscheme) + } + # Create starting parameters ## Note: start contains actual starting parameters. Startvals useful for other @@ -2262,20 +2318,6 @@ blmod_fengconvplus <- function(time, activity, inftime = NULL, start <- startvals } - # Fix weights - if( length(unique(blood$Method)) == 2 ) { # i.e. both cont and discrete - discrete_before_peak <- which(blood$Method=="Discrete" & - blood$time < startvals$peaktime) - - blood$weights[discrete_before_peak] <- 0 - } - - if(taper_weights) { - blood$weights <- ifelse(blood$Method=="Continuous", - yes = blood$weights * (1-blood$peakfrac), - no = blood$weights * blood$peakfrac) - } - # Set up start, upper and lower parameter lists if(is.null(lower)) { diff --git a/man/blmod_exp.Rd b/man/blmod_exp.Rd index b73d8d7..a24e44b 100644 --- a/man/blmod_exp.Rd +++ b/man/blmod_exp.Rd @@ -21,7 +21,9 @@ blmod_exp( multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 100, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme = 2, check_startpars = FALSE, expdecay_props = c(1/60, 0.1) ) @@ -77,8 +79,18 @@ they will be selected using \code{blmod_exp_startpars}.} parameters. If set to 1, then the starting parameters will be used for a single fit.} -\item{taper_weights}{Should the weights be tapered to gradually trade off -between the continuous and discrete samples after the peak?} +\item{Method_weights}{If no weights provided, should the weights be divided +by discrete and continuous samples equally (i.e. with more continuous +samples, the continuous samples each get less weight). Default is TRUE.} + +\item{taper_weights}{If no weights provided, should the weights be tapered to +gradually trade off between the continuous and discrete samples after the +peak?} + +\item{weightscheme}{If no weights provided, which weighting scheme should be +used before accommodating Method_divide and taper_weights? 1 represents a +uniform weighting before accommodating Method_divide and taper_weights. 2 +represents time/AIF as used by Columbia PET Centre. Default is 2.} \item{check_startpars}{Optional. Return only the starting parameters. Useful for debugging fits which do not work.} diff --git a/man/blmod_feng.Rd b/man/blmod_feng.Rd index 942bfe0..27d7877 100644 --- a/man/blmod_feng.Rd +++ b/man/blmod_feng.Rd @@ -16,7 +16,9 @@ blmod_feng( multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 100, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme = 2, check_startpars = FALSE, expdecay_props = c(1/60, 0.1) ) @@ -52,8 +54,18 @@ they will be selected using \code{blmod_exp_startpars}.} parameters. If set to 1, then the starting parameters will be used for a single fit.} -\item{taper_weights}{Should the weights be tapered to gradually trade off -between the continuous and discrete samples after the peak?} +\item{Method_weights}{If no weights provided, should the weights be divided +by discrete and continuous samples equally (i.e. with more continuous +samples, the continuous samples each get less weight). Default is TRUE.} + +\item{taper_weights}{If no weights provided, should the weights be tapered to +gradually trade off between the continuous and discrete samples after the +peak?} + +\item{weightscheme}{If no weights provided, which weighting scheme should be +used before accommodating Method_divide and taper_weights? 1 represents a +uniform weighting before accommodating Method_divide and taper_weights. 2 +represents time/AIF as used by Columbia PET Centre. Default is 2.} \item{check_startpars}{Optional. Return only the starting parameters. Useful for debugging fits which do not work.} diff --git a/man/blmod_fengconv.Rd b/man/blmod_fengconv.Rd index 7c51355..7671fd3 100644 --- a/man/blmod_fengconv.Rd +++ b/man/blmod_fengconv.Rd @@ -17,7 +17,9 @@ blmod_fengconv( multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 500, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme = 2, check_startpars = FALSE, expdecay_props = c(0, 0.5) ) @@ -58,8 +60,18 @@ they will be selected using \code{blmod_feng_startpars}.} parameters. If set to 1, then the starting parameters will be used for a single fit.} -\item{taper_weights}{Should the weights be tapered to gradually trade off -between the continuous and discrete samples after the peak?} +\item{Method_weights}{If no weights provided, should the weights be divided +by discrete and continuous samples equally (i.e. with more continuous +samples, the continuous samples each get less weight). Default is TRUE.} + +\item{taper_weights}{If no weights provided, should the weights be tapered to +gradually trade off between the continuous and discrete samples after the +peak?} + +\item{weightscheme}{If no weights provided, which weighting scheme should be +used before accommodating Method_divide and taper_weights? 1 represents a +uniform weighting before accommodating Method_divide and taper_weights. 2 +represents time/AIF as used by Columbia PET Centre. Default is 2.} \item{check_startpars}{Optional. Return only the starting parameters. Useful for debugging fits which do not work.} diff --git a/man/blmod_fengconvplus.Rd b/man/blmod_fengconvplus.Rd index 0dd07d0..13de4ee 100644 --- a/man/blmod_fengconvplus.Rd +++ b/man/blmod_fengconvplus.Rd @@ -17,7 +17,9 @@ blmod_fengconvplus( multstart_lower = NULL, multstart_upper = NULL, multstart_iter = 500, + Method_weights = TRUE, taper_weights = TRUE, + weightscheme = 2, check_startpars = FALSE, expdecay_props = c(0, 0.5) ) @@ -59,8 +61,18 @@ they will be selected using \code{blmod_exp_startpars}.} parameters. If set to 1, then the starting parameters will be used for a single fit.} -\item{taper_weights}{Should the weights be tapered to gradually trade off -between the continuous and discrete samples after the peak?} +\item{Method_weights}{If no weights provided, should the weights be divided +by discrete and continuous samples equally (i.e. with more continuous +samples, the continuous samples each get less weight). Default is TRUE.} + +\item{taper_weights}{If no weights provided, should the weights be tapered to +gradually trade off between the continuous and discrete samples after the +peak?} + +\item{weightscheme}{If no weights provided, which weighting scheme should be +used before accommodating Method_divide and taper_weights? 1 represents a +uniform weighting before accommodating Method_divide and taper_weights. 2 +represents time/AIF as used by Columbia PET Centre. Default is 2.} \item{check_startpars}{Optional. Return only the starting parameters. Useful for debugging fits which do not work.} diff --git a/man/blmod_splines.Rd b/man/blmod_splines.Rd index f4c52b0..c48894f 100644 --- a/man/blmod_splines.Rd +++ b/man/blmod_splines.Rd @@ -9,6 +9,9 @@ blmod_splines( activity, Method = NULL, weights = NULL, + Method_weights = TRUE, + taper_weights = TRUE, + weightscheme = 2, bs_before = "cr", bs_after_c = "cr", bs_after_d = "cr", @@ -22,27 +25,49 @@ blmod_splines( \item{activity}{The radioactivity of each measurement} -\item{Method}{Optional. The method of collection, i.e. "Discrete" or "Continuous"} +\item{Method}{Optional. The method of collection, i.e. "Discrete" or +"Continuous"} \item{weights}{Optional. Weights of each measurement.} -\item{bs_before}{Optional. Defines the basis function for the points before the peak.} +\item{Method_weights}{If no weights provided, should the weights be divided +by discrete and continuous samples equally (i.e. with more continuous +samples, the continuous samples each get less weight). Default is TRUE.} -\item{bs_after_c}{Optional. Defines the basis function for the continuous points after the peak.} +\item{taper_weights}{If no weights provided, should the weights be tapered to +gradually trade off between the continuous and discrete samples after the +peak?} -\item{bs_after_d}{Optional. Defines the basis function for the discrete points after the peak.} +\item{weightscheme}{If no weights provided, which weighting scheme should be +used before accommodating Method_divide and taper_weights? 1 represents a +uniform weighting before accommodating Method_divide and taper_weights. 2 +represents time/AIF as used by Columbia PET Centre. Default is 2.} -\item{k_before}{Optional. Defines the dimension of the basis for the points before the peak.} +\item{bs_before}{Optional. Defines the basis function for the points before +the peak.} -\item{k_after_c}{Optional. Defines the dimension of the basis for the continuous points after the peak.} +\item{bs_after_c}{Optional. Defines the basis function for the continuous +points after the peak.} -\item{k_after_d}{Optional. Defines the dimension of the basis for the discrete points after the peak.} +\item{bs_after_d}{Optional. Defines the basis function for the discrete +points after the peak.} + +\item{k_before}{Optional. Defines the dimension of the basis for the points +before the peak.} + +\item{k_after_c}{Optional. Defines the dimension of the basis for the +continuous points after the peak.} + +\item{k_after_d}{Optional. Defines the dimension of the basis for the +discrete points after the peak.} } \value{ -A model fit including all of the individual models of class blood_splines. +A model fit including all of the individual models of class + blood_splines. } \description{ -Fits two or three (if both discrete and continuous) splines to blood or AIF data to smooth it +Fits two or three (if both discrete and continuous) splines to blood or AIF +data to smooth it } \examples{ blooddata <- pbr28$blooddata[[1]] diff --git a/man/blood_weights_create.Rd b/man/blood_weights_create.Rd new file mode 100644 index 0000000..2ce29ae --- /dev/null +++ b/man/blood_weights_create.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/kinfitr_bloodfuncs.R +\name{blood_weights_create} +\alias{blood_weights_create} +\title{Create Weights for Modelling Whole Blood and AIF Data} +\usage{ +blood_weights_create( + time, + activity, + Method = NULL, + Method_weights = TRUE, + taper_weights = TRUE, + weightscheme = 2 +) +} +\arguments{ +\item{time}{The time of each measurement.} + +\item{activity}{The radioactivity of each measurement.} + +\item{Method}{Optional. The method of collection, i.e. "Discrete" or +"Continuous".} + +\item{Method_weights}{Should the weights be divided by discrete and +continuous samples equally (i.e. with more continuous samples, the +continuous samples each get less weight). Default is TRUE.} + +\item{taper_weights}{Should the weights be tapered to gradually trade off +between the continuous and discrete samples after the peak?} + +\item{weightscheme}{Which weighting scheme should be used before +accommodating Method_divide and taper_weights? 1 represents a uniform +weighting before accommodating Method_divide and taper_weights. 2 +represents time/AIF as used by Columbia PET Centre. Default is 2.} +} +\value{ +A vector of model weights +} +\description{ +Create Weights for Modelling Whole Blood and AIF Data +} +\examples{ +blooddata <- pbr28$blooddata[[1]] +aif <- bd_extract(blooddata, output = "AIF") +blood_weights_create(aif$time, aif$aif, aif$Method) +}