Skip to content

Commit

Permalink
Updated vdp + test
Browse files Browse the repository at this point in the history
  • Loading branch information
@TGuillerme
TGuillerme committed Jul 11, 2019
1 parent c550b3b commit 2226744
Show file tree
Hide file tree
Showing 5 changed files with 127 additions and 38 deletions.
7 changes: 4 additions & 3 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,9 +7,10 @@ import(graphics)

## Functions
export(reduce.space)
export(make.vdp)
export(dispRity.vdp)
export(plot.vdp)
export(vdp.make)
export(vdp.dispRity)
export(vdp.plot)
export(vdp.table.check)

## Plot utilities
export(plot.space)
Expand Down
49 changes: 42 additions & 7 deletions R/vdp.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -62,17 +62,19 @@ vdp.make <- function(base.range = c(-0.5, 0.5), extra.points = 0) {
base <- cbind(outer_edge, move.points(outer_edge, centre, factor = 0.5))

## Differences
vol <- move.points(base, factor = 2, centre = centre)
vol <- cbind(move.points(outer_edge, factor = 2, centre = centre),
move.points(outer_edge, factor = 1.5, centre = centre))
den <- cbind(outer_edge,
move.points(outer_edge, factor = 0.25, centre = centre))
move.points(outer_edge, factor = 0.3535, centre = centre))
pos <- max(base.range) + base
vol_den <- cbind(move.points(outer_edge, factor = 2, centre = centre),
move.points(outer_edge, factor = 0.25, centre = centre))
vol_pos <- max(base.range) +
move.points(base, factor = 0.5, centre = centre)
cbind(move.points(outer_edge, factor = 1.5, centre = centre),
move.points(outer_edge, factor = 1, centre = centre))
den_pos <- max(base.range) +
cbind(outer_edge,
move.points(outer_edge, factor = 0.25, centre = centre))
move.points(outer_edge, factor = 0.3535, centre = centre))
vol_pos_den <- max(base.range) +
cbind(move.points(outer_edge, factor = 0.1, centre = centre),
move.points(outer_edge, factor = 0.25, centre = centre))
Expand All @@ -99,7 +101,8 @@ vdp.make <- function(base.range = c(-0.5, 0.5), extra.points = 0) {
#' @param pch The dots type to plot (default = 19 - full round dots)
#' @param xlab, ylab The x and y labels (default is none - \code{""}).
#' @param disparity optional, disparity values obtained from \code{\link{vdp.dispRity}} to be displayed as x labels
#' @param ... any aditional argument to be passed to \code{\link[base]{plot}}.
#' @param plot.names optional, the plot names (passed as \code{main})
#' @param ... any additional argument to be passed to \code{\link[base]{plot}}.
#'
#' @examples
#' ## Make a Volume/density/position list
Expand All @@ -120,7 +123,7 @@ vdp.make <- function(base.range = c(-0.5, 0.5), extra.points = 0) {
#'
#' @author Thomas Guillerme
#' @export
vdp.plot <- function(vdp, limits, pch = 19, xlab = "", ylab = "", disparity = NULL, ...) {
vdp.plot <- function(vdp, limits, pch = 19, xlab = "", ylab = "", disparity = NULL, plot.names, ...) {

## Handle the limits
if(missing(limits)) {
Expand All @@ -139,6 +142,10 @@ vdp.plot <- function(vdp, limits, pch = 19, xlab = "", ylab = "", disparity = NU
}
}

if(!missing(plot.names)) {
names(vdp) <- plot.names
}

## Plotting all the
par(mfrow = c(2,4), bty = "n")
## Loop through each plot
Expand Down Expand Up @@ -208,4 +215,32 @@ vdp.dispRity <- function(vdp, volume, density, position, base.relative = TRUE) {
return(list("volume" = disp_volume,
"density" = disp_densit,
"position" = disp_positi))
}
}

#' @title checking vdp
#'
#' @description Checking the vdp results in a table
#'
#' @param vdp_disp A list output from \code{\link{vdp.dispRity}}
#' @param vdp_space A list output from \code{\link{vdp.make}}
#' @param round The number of digits to round (default = \code{3})
#'
#' @examples
#' ## Make a Volume/density/position list
#' vdp_list <- vdp.make()
#'
#' ## Calculate disparity
#' vdp_disp <- vdp.dispRity(vdp_list, volume = c(prod, ranges),
#' density = c(mean, neighbours),
#' position = c(mean, displacements))
#'
#' ## Plotting the results with disparity
#' vdp.check.table(vdp_disp, vdp_list)
#'
#' @seealso \code{\link{vdp.make}}, \code{\link{vdp.dispRity}}
#'
#' @author Thomas Guillerme
#' @export
vdp.check.table <- function(vdp_disp, vdp_space, round = 3) {
return(matrix(round(unlist(vdp_disp), round), ncol = 8, byrow = TRUE, dimnames = list(names(vdp_disp), gsub("diff.", "", names(vdp_space)))))
}
37 changes: 37 additions & 0 deletions man/vdp.check.table.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 4 additions & 2 deletions man/vdp.plot.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

66 changes: 40 additions & 26 deletions tests/testthat/test-vdp.R
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
context("vdp")

## Test make
test_that("make.vdp works", {
test_that("vdp.make works", {

## Works exactly with no extra points
test <- make.vdp()
test <- vdp.make()

## Right output
expect_is(
Expand All @@ -18,32 +18,32 @@ test_that("make.vdp works", {
, c("base", "diff.vol", "diff.den", "diff.pos", "diff.vol_den", "diff.vol_pos", "diff.den_pos", "diff.vol_pos_den"))
## Exact values
expect_equal(unique(c(test[[1]])), c(-0.5, 0.5, -0.25, 0.25))
expect_equal(unique(c(test[[2]])), c(-1, 1, -0.5, 0.5))
expect_equal(unique(c(test[[3]])), c(-0.5, 0.5, -0.125, 0.125))
expect_equal(unique(c(test[[2]])), c(-1, 1, -0.75, 0.75))
expect_equal(unique(c(test[[3]])), c(-0.5, 0.5, -0.17675, 0.17675))
expect_equal(unique(c(test[[4]])), c(0, 1, 0.25, 0.75))
expect_equal(unique(c(test[[5]])), c(-1, 1, -0.125, 0.125))
expect_equal(unique(c(test[[6]])), c(0.25, 0.75, 0.375, 0.625))
expect_equal(unique(c(test[[7]])), c(0, 1, 0.375, 0.625))
expect_equal(unique(c(test[[6]])), c(-0.25, 1.25, 0, 1))
expect_equal(unique(c(test[[7]])), c(0, 1, 0.32325, 0.67675))
expect_equal(unique(c(test[[8]])), c(0.450, 0.550, 0.375, 0.625))

## Works with extra points
test <- make.vdp(extra.points = 10)
test <- vdp.make(extra.points = 10)
for(i in 1:length(test)) {
expect_equal(dim(test[[i]]), c(2, 28))
}

## Works different base range
test <- make.vdp(base.range = c(-10, 10))
test <- vdp.make(base.range = c(-10, 10))
expect_equal(unique(c(test[[1]])), c(-10, 10, -5, 5))
})

## Test dispRity
test_that("plot.vdp works", {
expect_error(dispRity.vdp(make.vdp(), volume = "c(1, 32)",
test_that("vdp.dispRity works", {
expect_error(vdp.dispRity(vdp.make(), volume = "c(1, 32)",
density = c(mean, neighbours),
position = c(mean, displacements)))
## Get some disparity values
test <- dispRity.vdp(make.vdp(), volume = c(prod, ranges),
test <- vdp.dispRity(vdp.make(), volume = c(prod, ranges),
density = c(mean, neighbours),
position = c(mean, displacements),
base.relative = FALSE)
Expand All @@ -52,51 +52,65 @@ test_that("plot.vdp works", {
expect_equal(names(test), c("volume", "density", "position"))
expect_equal(
unname(unlist(test[[1]]))
,c(1, 4, 1, 1, 4, 0.25, 1, 0.062)
,c(1, 4, 1, 1, 4, 2.25, 1, 0.062)
)
expect_equal(
unname(unlist(test[[2]]))
,c(0.354, 0.707, 0.390, 0.354, 0.744, 0.177, 0.390, 0.103)
,c(0.354, 0.354, 0.405, 0.354, 0.744, 0.354, 0.405, 0.103)
)
expect_equal(
unname(unlist(test[[3]]))
,c(1, 1, 1, 1.663, 1, 3.090, 2.634, 7.043)
,c(1, 1, 1, 1.663, 1, 1.154, 2.061, 7.043)
)

## Get some disparity values
test <- dispRity.vdp(make.vdp(), volume = c(prod, ranges),
test <- vdp.dispRity(vdp.make(), volume = c(prod, ranges),
density = c(mean, neighbours),
position = c(mean, displacements),
base.relative = TRUE)
expect_equal(
unname(unlist(test[[1]]))
,c(1, 4, 1, 1, 4, 0.25, 1, 0.062)
,c(1, 4, 1, 1, 4, 2.25, 1, 0.062)
)
expect_equal(
unname(unlist(test[[2]]))
,c(0.354, 0.707, 0.390, 0.354, 0.744, 0.177, 0.390, 0.103)/0.354
,c(0.354, 0.354, 0.405, 0.354, 0.744, 0.354, 0.405, 0.103)/0.354
)
expect_equal(
unname(unlist(test[[3]]))
,c(1, 1, 1, 1.663, 1, 3.090, 2.634, 7.043)
,c(1, 1, 1, 1.663, 1, 1.154, 2.061, 7.043)
)
})

## Test table
test_that("vdp.plot works", {
test <- vdp.make()
## Add disparity values
disp <- vdp.dispRity(test, volume = c(prod, ranges),
density = c(mean, neighbours),
position = c(mean, displacements),
base.relative = TRUE)

test_table <- vdp.check.table(disp, test)
expect_equal(unname(test_table), matrix(round(unlist(disp), 3), nrow = 3, byrow = TRUE))
})


## Test plot
test_that("plot.vdp works", {
test <- make.vdp()
expect_null(plot.vdp(test))
expect_null(plot.vdp(test, limits = c(-100, 100)))
expect_null(plot.vdp(test, pch = 1))
expect_null(plot.vdp(test, col = "red"))
test_that("vdp.plot works", {
test <- vdp.make()
expect_null(vdp.plot(test))
expect_null(vdp.plot(test, limits = c(-100, 100)))
expect_null(vdp.plot(test, pch = 1))
expect_null(vdp.plot(test, col = "red"))

## Add disparity values
disp <- dispRity.vdp(test, volume = c(prod, ranges),
disp <- vdp.dispRity(test, volume = c(prod, ranges),
density = c(mean, neighbours),
position = c(mean, displacements),
base.relative = TRUE)

expect_null(plot.vdp(test, disparity = disp))
expect_null(vdp.plot(test, disparity = disp))

})

Expand Down

0 comments on commit 2226744

Please sign in to comment.