|
| 1 | +#' @title Apply crosstalk |
| 2 | +#' |
| 3 | +#' @description Add crosstalk, evenly spread in rook (top-right-bottom-left) |
| 4 | +#' directions, to all grain whole locations on one measurement discs |
| 5 | +#' (=on position on a measurement wheel in a reader). An |
| 6 | +#' added crosstalk value of as example 0.2 means that 0.2 of the value of |
| 7 | +#' the central grain is added to each grain in the rook directions. This is an additive |
| 8 | +#' action: the central grain itself is not affected by this operation (but will on its |
| 9 | +#' turn increase because of crosstalk from its neighbours). |
| 10 | +#' This function is used for simulations: can this added crosstalk be detected? |
| 11 | +#' |
| 12 | +#' @details If an element in `object` is `NA`, it is internally set to 0, so it will not |
| 13 | +#' be added. |
| 14 | +#' |
| 15 | +#' @param object [RLum.Results-class] or [numeric] (**required**): containing |
| 16 | +#' a numerical vector of length 100, representing one or more measurement |
| 17 | +#' discs ("positions") in a reader. |
| 18 | +#' Each element in the vector represents one grain hole location on a disc. |
| 19 | +#' |
| 20 | +#' @param n_crosstalk [numeric] (*with default*): A single number quantifying the added |
| 21 | +#' crosstalk. Defaults for testing purposes to 0.2. Can be any number, even negative, |
| 22 | +#' but for realistic simulations we suggest something between 0 and 0.25. |
| 23 | +#' |
| 24 | +#' @keywords crosstalk, simulation |
| 25 | +#' |
| 26 | +#' @return A vector of size 100, with the value at each grain hole location including simulated crosstalk. |
| 27 | +#' |
| 28 | +#' @author Anna-Maartje de Boer, Luc Steinbuch, Wageningen University & Research, 2025 |
| 29 | +#' |
| 30 | +#' @references |
| 31 | +#' de Boer, A-M., Steinbuch, L., Heuvelink, G.B.M., Wallinga, J., 2025. |
| 32 | +#' A novel tool to assess crosstalk in single-grain luminescence detection. |
| 33 | +#' Submitted. |
| 34 | +#' |
| 35 | +#' @examples |
| 36 | +#' ## Create artificial disc observation |
| 37 | +#' observations <- set_RLum(class = "RLum.Results", |
| 38 | +#' data = list(vn_values = rep(x = c(1,2), each = 50)) |
| 39 | +#' ) |
| 40 | +#' hist(get_RLum(object = observations)) |
| 41 | +#' |
| 42 | +#' ## Add crosstalk (with default set to 0.2), and visualize the difference |
| 43 | +#' ## in the resulting histogram. |
| 44 | +#' observations_with_simulated_crosstalk <- apply_Crosstalk(observations) |
| 45 | +#' hist(observations_with_simulated_crosstalk) |
| 46 | +#' |
| 47 | +#' @md |
| 48 | +#' @export |
| 49 | +apply_Crosstalk <- function(object, |
| 50 | + n_crosstalk = 0.2 |
| 51 | +) { |
| 52 | + .set_function_name("apply_Crosstalk") |
| 53 | + on.exit(.unset_function_name(), add = TRUE) |
| 54 | + |
| 55 | + ## Validate input arguments ----------------------- |
| 56 | + |
| 57 | + .validate_class(object, c("RLum.Results", "numeric", "integer")) |
| 58 | + ## To add: validation on `object` |
| 59 | + # - should contain a numerical vector of length 100 |
| 60 | + |
| 61 | + .validate_class(n_crosstalk, c("numeric")) |
| 62 | + ## To add: validate on `n_crosstalk` |
| 63 | + # - should be a single numerical value |
| 64 | + |
| 65 | + ## Set variables ----------------------- |
| 66 | + if(is.numeric(object)) |
| 67 | + { |
| 68 | + vn_values <- object |
| 69 | + } else |
| 70 | + { |
| 71 | + vn_values <- get_RLum(object) |
| 72 | + } |
| 73 | + |
| 74 | + |
| 75 | + vb_na_s <- is.na(vn_values) |
| 76 | + |
| 77 | + vn_values[vb_na_s] <- 0 |
| 78 | + |
| 79 | + ## Prepare multiplication matrix ----------------------- |
| 80 | + ## Note: the physical appearance of a measurement disc, |
| 81 | + ## 10x10 grains, is hard coded here |
| 82 | + df_disc_locations <- data.frame(location = 1:100, |
| 83 | + x = rep(1:10, times = 10), |
| 84 | + y = rep(1:10, each = 10)) |
| 85 | + |
| 86 | + # Calculate matrix with euclidean distances |
| 87 | + mn_dist <- as.matrix(dist(df_disc_locations[,c("x", "y")])) |
| 88 | + |
| 89 | + ## All distances equal to one are subject to crosstalk |
| 90 | + mn_crosstalk <- ifelse(mn_dist == 1, yes = n_crosstalk, no = 0) |
| 91 | + |
| 92 | + ## The diagonal -- all distances equal to zero -- are one |
| 93 | + diag(mn_crosstalk) <- 1 |
| 94 | + |
| 95 | + ## Matrix calculations ----------------------- |
| 96 | + |
| 97 | + vn_sig_with_crosstalk <- as.numeric(mn_crosstalk %*% vn_values) |
| 98 | + |
| 99 | + ## Assign original NA's to output |
| 100 | + vn_sig_with_crosstalk[vb_na_s] <- NA |
| 101 | + |
| 102 | + |
| 103 | + return(vn_sig_with_crosstalk) |
| 104 | + |
| 105 | +} |
0 commit comments