/
opt_diff.r
108 lines (108 loc) · 5.61 KB
/
opt_diff.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
#' Calculating the mean distances of each plot in the lineup.
#'
#' Distance metric is used to calculate the mean distance between the true plot
#' and all the null plots in a lineup. The mean distances of each null plot to all
#' the other null plots are calculated. The mean distances are returned for all the plots
#' in the lineup.
#'
#' @param lineup.dat lineup data of the lineup
#' @param var a vector of names of the variables to be used to calculate the mean distances
#' @param met distance metric needed to calculate the distance as a character
#' @param pos position of the true plot in the lineup
#' @param dist.arg a list or vector of inputs for the distance metric met; NULL by default
#' @param m number of plots in the lineup, by default m = 20
#' @return the mean distances of each plot in the lineup
#' @importFrom dplyr summarise group_by filter
#' @export
#' @examples
#' if(require('dplyr')){
#' calc_mean_dist(lineup(null_permute('mpg'), mtcars, pos = 1), var = c('mpg', 'wt'),
#' met = 'reg_dist', pos = 1, m = 10)}
calc_mean_dist <- function(lineup.dat, var, met, pos, dist.arg = NULL, m = 20){
plotno <- pos.2 <- b <- NULL
dat.pos <- expand.grid(plotno = 1:m, pos.2 = 1:m)
dat.pos <- dplyr::filter(dat.pos, plotno != pos.2 & pos.2 != pos)
lineup.dat <- lineup.dat[, c(var, ".sample")]
if (!is.character(met)) {
stop("function met should be a character")
}
func <- match.fun(met)
d <- summarise(group_by(dat.pos, plotno, pos.2), b = with(lineup.dat, ifelse(is.null(dist.arg),
do.call(func, list(dplyr::filter(lineup.dat, .sample == plotno),
dplyr::filter(lineup.dat, .sample == pos.2))),
do.call(func, append(list(dplyr::filter(lineup.dat, .sample == plotno),
dplyr::filter(lineup.dat, .sample == pos.2)), unname(dist.arg))))))
summarise(group_by(d, plotno), mean.dist = mean(b))
}
#' Calculating the difference between true plot and the null plot with the maximum distance.
#'
#' Distance metric is used to calculate the mean distance between the true plot
#' and all the null plots in a lineup. The difference between the mean
#' distance of the true plot and the maximum mean distance of the null plots is
#' calculated.
#'
#' @param lineup.dat lineup data to get the lineup
#' @param var a vector of names of the variables to be used to calculate the difference
#' @param met distance metric needed to calculate the distance as a character
#' @param pos position of the true plot in the lineup
#' @param dist.arg a list or vector of inputs for the distance metric met; NULL by default
#' @param m number of plots in the lineup, by default m = 20
#' @return difference between the mean distance of the true plot and
#' the maximum mean distance of the null plots
#' @importFrom dplyr summarise group_by
#' @export
#' @examples
#' if(require('dplyr')){
#' lineup.dat <- lineup(null_permute('mpg'), mtcars, pos = 1)
#' calc_diff(lineup.dat, var = c('mpg', 'wt'), met = 'bin_dist',
#' dist.arg = list(lineup.dat = lineup.dat, X.bin = 5, Y.bin = 5), pos = 1, m = 8)}
#'
#' if(require('dplyr')){
#' calc_diff(lineup(null_permute('mpg'), mtcars, pos = 1), var = c('mpg', 'wt'), met = 'reg_dist',
#' dist.arg = NULL, pos = 1, m = 8)}
calc_diff <- function(lineup.dat, var, met, pos, dist.arg = NULL, m = 20){
dist.mean <- calc_mean_dist(lineup.dat, var, met, pos, dist.arg, m)
with(dist.mean, mean.dist[plotno == pos] - max(mean.dist[plotno != pos]))
}
#' Finds the number of bins in x and y direction which gives the maximum binned distance.
#'
#' This function finds the optimal number of bins in both x and y direction which should
#' be used to calculate the binned distance. The binned distance is calculated for each
#' combination of provided choices of number of bins in x and y direction and finds the
#' difference using \code{calc_diff} for each combination. The combination for which the
#' difference is maximum should be used.
#'
#' @param lineup.dat lineup data to get the lineup
#' @param var a list of names of the variables to be used to calculate the difference
#' @param xlow the lowest value of number of bins on the x-direction
#' @param xhigh the highest value of number of bins on the x-direction
#' @param ylow the lowest value of number of bins on the y-direction
#' @param yhigh the highest value of number of bins on the y-direction
#' @param pos position of the true plot in the lineup
#' @param plot LOGICAL; if true, returns a tile plot for the combinations
#' of number of bins with the differences as weights
#' @param m number of plots in the lineup, by default m = 20
#' @return a dataframe with the number of bins and differences
#' the maximum mean distance of the null plots
#' @importFrom dplyr summarise group_by
#' @importFrom ggplot2 ggplot aes geom_tile scale_fill_gradient xlab ylab
#' @export
#' @examples
#' if(require('dplyr')){
#' opt_bin_diff(lineup(null_permute('mpg'), mtcars, pos = 1), var = c('mpg', 'wt'),
#' 2, 5, 4, 8, pos = 1, plot = TRUE, m = 8)
#' }
opt_bin_diff <- function(lineup.dat, var, xlow, xhigh, ylow, yhigh, pos, plot = FALSE, m = 20) {
Diff <- xbins <- ybins <- NULL
bins <- expand.grid(xbins = xlow:xhigh, ybins = ylow:yhigh)
diff.bins <- summarise(group_by(bins, xbins, ybins), Diff = calc_diff(lineup.dat, var, met = 'bin_dist', pos, dist.arg = list(lineup.dat = lineup.dat, X.bin = xbins, Y.bin = ybins), m))
if (plot) {
p <- ggplot(diff.bins, aes(x = factor(xbins), y = factor(ybins))) +
geom_tile(aes(fill = Diff)) +
scale_fill_gradient(high = "blue", low = "white") +
xlab("xbins") + ylab("ybins")
return(list(dat = diff.bins, p = p))
} else {
return(dat = diff.bins)
}
}