Nothing
context("BAUs")
test_that("real_line_BAUs",{
library(sp)
data <- data.frame(x = seq(0,10,by=0.01), y = 0, z= runif(1001),std=0.5)
coordinates(data) <- ~x+y
Grid1D_df <- auto_BAUs(manifold = real_line(),
cellsize = 1,
data=data)
expect_is(Grid1D_df,"SpatialPixelsDataFrame")
expect_equal(names(Grid1D_df),c("x","y"))
expect_equal(mean(diff(Grid1D_df$x)),1)
f <- z ~ 1
binned_data1 <- map_data_to_BAUs(data,Grid1D_df,average_in_BAU = TRUE)
binned_data2 <- map_data_to_BAUs(data,Grid1D_df,average_in_BAU = FALSE)
expect_is(binned_data1,"SpatialPointsDataFrame")
expect_is(binned_data2,"SpatialPointsDataFrame")
expect_true(nrow(binned_data1) <= nrow(Grid1D_df))
C1 <- BuildC(binned_data1,Grid1D_df)
C2 <- BuildC(binned_data2,Grid1D_df)
expect_is(C1,"list")
expect_equal(names(C1),c("i_idx","j_idx", "x_idx"))
expect_equal(length(C1$i_idx),nrow(binned_data1))
expect_equal(length(C1$j_idx),nrow(binned_data1))
})
test_that("plane_BAUs",{
library(sp)
set.seed(1)
data <- data.frame(x = rnorm(5),y=rnorm(5),z = rnorm(5),std=1)
coordinates(data) <- ~x+y
#if(require("fmesher") & require("rgdal", quietly = TRUE)) {
if(require("fmesher")) {
Grid2D <- auto_BAUs(manifold = plane(),
type="grid",
cellsize = 0.5,
data=data,
nonconvex_hull = TRUE)
expect_is(Grid2D,"SpatialPixelsDataFrame")
expect_equal(names(Grid2D),c("x","y"))
}
## Now without fmesher
Grid2D <- auto_BAUs(manifold = plane(),
type="grid",
cellsize = 0.5,
data=data,
nonconvex_hull = FALSE)
expect_is(Grid2D,"SpatialPixelsDataFrame")
expect_equal(names(Grid2D),c("x","y"))
f <- z ~ 1
binned_data <- map_data_to_BAUs(data,Grid2D)
expect_is(binned_data,"SpatialPointsDataFrame")
expect_true(nrow(binned_data) <= nrow(Grid2D))
C <- BuildC(binned_data,Grid2D)
expect_is(C,"list")
expect_equal(names(C),c("i_idx","j_idx", "x_idx"))
expect_equal(length(C$i_idx),nrow(binned_data))
expect_equal(length(C$j_idx),nrow(binned_data))
## Limited 2D grid
Grid2D_limited <- auto_BAUs(manifold = plane(),
type="grid",
cellsize = 0.5,
data=data,
nonconvex_hull = FALSE,
xlims=c(-2,2),
ylims=c(-2,2))
expect_is(Grid2D_limited,"SpatialPixelsDataFrame")
expect_equal(names(Grid2D_limited),c("x","y"))
expect_equal(min(Grid2D_limited@data[,1]),-2)
expect_equal(max(Grid2D_limited@data[,1]),2)
expect_equal(min(Grid2D_limited@data[,2]),-2)
expect_equal(max(Grid2D_limited@data[,2]),2)
})
test_that("sphere_BAUs",{
isea3h_1 <- auto_BAUs(manifold=sphere(),
type="hex",
isea3h_res=1,
data=NULL)
expect_is(isea3h_1,"SpatialPolygonsDataFrame")
expect_equal(nrow(isea3h_1@data),39)
expect_equal(names(isea3h_1@data),c("id","lon","lat"))
expect_true(grepl("+proj=longlat",.rawproj4string(isea3h_1)))
sphere_grid <- auto_BAUs(manifold=sphere(),
type="grid",
data=NULL,
cellsize=c(20,10))
expect_is(sphere_grid,"SpatialPolygonsDataFrame")
expect_equal(nrow(sphere_grid@data),324)
expect_equal(names(sphere_grid@data),c("lon","lat"))
expect_true(grepl("+proj=longlat",.rawproj4string(sphere_grid)))
sphere_grid_limited <- auto_BAUs(manifold=sphere(),
type="grid",
data=NULL,
cellsize=c(20,10),
xlims=c(-100,120),
ylims=c(-80,70))
expect_is(sphere_grid_limited,"SpatialPolygonsDataFrame")
expect_equal(nrow(sphere_grid_limited@data),165)
expect_equal(names(sphere_grid_limited@data),c("lon","lat"))
expect_true(grepl("+proj=longlat",.rawproj4string(sphere_grid_limited)))
expect_equal(min(sphere_grid_limited@data[,1]),-90)
expect_equal(max(sphere_grid_limited@data[,1]),110)
expect_equal(min(sphere_grid_limited@data[,2]),-75)
expect_equal(max(sphere_grid_limited@data[,2]),65)
})
test_that("sphere_BAUs_subset_BAUs",{
set.seed(1)
df <- data.frame(lon = runif(n = 1000, min = 120, max = 160),
lat = runif(n = 1000, min = 57, max = 88))
coordinates(df) <- c("lon", "lat")
slot(df, "proj4string") <- CRS('+proj=longlat +ellps=sphere')
isea3h_1 <- auto_BAUs(manifold = sphere(),
type = "hex",
isea3h_res = 5,
data = df)
sf::sf_use_s2(FALSE)
data_in_BAUs <- sf::st_contains(as(isea3h_1, "sf"), as(df, "sf"))
expect_equal(all(colSums(as.matrix(data_in_BAUs)) == 1), TRUE)
#plot(isea3h_1, col = "red")
#plot(df, add = TRUE)
})
test_that("SpaceTime_BAUs",{
library(sp)
library(spacetime)
sim_process <- expand.grid(x = seq(0.005,0.995,by=0.1),
y = seq(0.005,0.995,by=0.1),
t = seq(1,5,by = 1),
std = 0.5)
sim_process$z <- 1
time1 <- as.POSIXct("2015-09-01",tz="") + 3600*24*(sim_process$t-1)
space1 <- sim_process[,c("x","y")]
coordinates(space1) <- ~x+y
STobj1 <- STIDF(space1,time1,data=sim_process)
time_grid <- auto_BAUs(real_line(),
cellsize = 1,
d = as.Date(time(STobj1)),
tunit="days")
expect_is(time_grid,"POSIXct")
#if(require("INLA") & require("rgdal", quietly = TRUE)) {
if(require("fmesher")) {
space_time_grid <- auto_BAUs(STplane(),
type="hex",
cellsize = c(0.1,0.1,1),
data = STobj1,
tunit="days",
convex= -0.2,
nonconvex_hull = TRUE)
expect_is(space_time_grid,"STFDF")
expect_is(time(space_time_grid),"POSIXct")
}
space_time_grid <- auto_BAUs(STplane(),
type="hex",
cellsize = c(0.1,0.1,1),
data = STobj1,
tunit="days",
convex= -0.2,
nonconvex_hull = FALSE)
expect_is(space_time_grid,"STFDF")
expect_is(time(space_time_grid),"POSIXct")
STobj2 <- space_time_grid[1:5,1:3] # mock space-time STFDF data
STobj2$z <- 1
f <- z ~ 1
binned_data1 <- FRK:::map_data_to_BAUs(STobj1,
space_time_grid,
average_in_BAU = TRUE)
binned_data2 <- FRK:::map_data_to_BAUs(STobj1,
space_time_grid,
average_in_BAU = FALSE)
expect_true(ncol(binned_data2) >= ncol(binned_data1))
expect_is(binned_data1,"STIDF")
expect_is(binned_data2,"STIDF")
C1 <- BuildC(binned_data1,space_time_grid)
C2 <- BuildC(binned_data2,space_time_grid)
expect_is(C1,"list")
expect_is(C2,"list")
expect_equal(names(C1),c("i_idx","j_idx", "x_idx"))
expect_equal(names(C2),c("i_idx","j_idx", "x_idx"))
expect_equal(length(C1$i_idx),as.numeric(nrow(binned_data1)))
expect_equal(length(C1$j_idx),as.numeric(nrow(binned_data1)))
## Now do the same but with a slightly shifted time
STobj3 <- STIDF(space1,time1 + 4000,data=sim_process)
STobj3$z <- 1
f <- z ~ 1
binned_data3 <- FRK:::map_data_to_BAUs(STobj3,
space_time_grid,
average_in_BAU = TRUE)
binned_data4 <- FRK:::map_data_to_BAUs(STobj3,
space_time_grid,
average_in_BAU = FALSE)
expect_true(ncol(binned_data4) >= ncol(binned_data3))
expect_is(binned_data3,"STIDF")
expect_is(binned_data4,"STIDF")
space_time_grid2 <- auto_BAUs(STplane(),
type="hex",
cellsize = c(0.1,0.1,1),
data = STobj3,
tunit="days",
convex= -0.2,
nonconvex_hull = FALSE)
expect_equal(attr(space_time_grid@time,"tzone"),attr(STobj1@time,"tzone"))
})
test_that("Point from BAUs works",{
library(sp)
dat <- data.frame(x = rnorm(100),
y = rnorm(100))
coordinates(dat) <- ~x+y
BAUs <- BAUs_from_points(dat)
expect_is(BAUs,"SpatialPolygonsDataFrame")
expect_equal(length(BAUs),100)
dat$z <- rnorm(100)
BAUs <- BAUs_from_points(dat)
expect_is(BAUs,"SpatialPolygonsDataFrame")
expect_equal(length(BAUs),100)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.