data("pb2002") data("nuvel1_plates") # test the examples from manuscript # Load the San Andreas-Gulf of California dataset: data("san_andreas") # Load plate boundary geometries data("plates") # Extract boundary between Pacific (pa) and North American (na) plates na_pa_boundary <- subset(plates, plates$pair == "na-pa") # Load the current plate motion (cpm) models: data("cpm_models") morvel <- subset(cpm_models, model == "NNR-MORVEL56") # select MORVEL model # Relative plate motion between Pacific and North American plates: na_pa <- equivalent_rotation(morvel, fixed = "na", rot = "pa") # Transform stress data set and test against predicted left-lateral tangential plate boundary (left): stress_analysis(san_andreas, PoR = na_pa, type = "right", pb = na_pa_boundary) # Interpolate the stress field in the PoR coordinate system: PoR_stress2grid(san_andreas, na_pa) data("tibet") eu_in_boundary <- subset(plates, plates$pair == "eu-in") eu_in <- equivalent_rotation(morvel, fixed = "eu", rot = "in") stress_analysis(tibet, PoR = eu_in, type = "in", pb = eu_in_boundary) PoR_stress2grid(tibet, eu_in) data("iceland") eu_na_boundary <- subset(plates, plates$pair == "eu-na") eu_na <- equivalent_rotation(morvel, fixed = "na", rot = "eu") stress_analysis(iceland, PoR = eu_na, type = "out", pb = eu_na_boundary) PoR_stress2grid(iceland, eu_na) # PoR_stress2grid(san_andreas, na_pa, gridsize = .25, R_range = seq(50, 350, 50), stat = "mean") # PoR_stress2grid(tibet, eu_in, gridsize = .25, R_range = seq(50, 1000, 50), stat = "mean") # PoR_stress2grid(iceland, eu_na, gridsize = .125, R_range = seq(50, 1000, 50), stat = "mean") # test model_shmax euler <- subset(nuvel1, nuvel1$plate.rot == "na") # North America relative to Pacific point <- data.frame(lat = 45, lon = 20) prd <- model_shmax(point, euler) # test mistfit_shmax misfit1 <- deviation_shmax(prd, obs = 90) # test with data.frames set.seed(12) points <- dplyr::slice_sample(san_andreas, n = 10) prd2 <- model_shmax(points, euler) misfits2 <- deviation_shmax(prd2, points$azi) test2 <- norm_chisq(obs = points$azi, prd = prd2$sc, unc = 10) ep1 <- data.frame(lat = 91, lon = 0, angle = 1) sm.sf <- eulerpole_smallcircles(ep1) gc.sf <- eulerpole_greatcircles(ep1) ld.sf <- eulerpole_loxodromes(ep1, cw = FALSE) # sm.sp <- eulerpole_smallcircles(ep1, returnclass = "sp") # gc.sp <- eulerpole_greatcircles(ep1, returnclass = "sp") # ld.sp <- eulerpole_loxodromes(ep1, cw = FALSE, returnclass = "sp") eulerpole_loxodromes(ep1, cw = TRUE) eulerpole_loxodromes(ep1, cw = FALSE) eulerpole_loxodromes(ep1, angle = 0, cw = FALSE) eulerpole_loxodromes(ep1, angle = -95, cw = FALSE) eulerpole_paths(ep1) ep2 <- data.frame(lat = 90, lon = -185, angle = 1) eulerpole_smallcircles(ep2) eulerpole_greatcircles(ep2) eulerpole_loxodromes(ep2, cw = TRUE) ep3 <- data.frame() # eulerpole_smallcircles(ep3) # eulerpole_greatcircles(ep3) # eulerpole_loxodromes(ep3, cw = TRUE) # eulerpole_paths(ep3) # euler_rot(ep1, 45) p1 <- c(35, 45) # Baghdad p2 <- c(35, 135) # Osaka p3 <- c(35, NA) # add NA values get_azimuth(p3[1], p3[2], p2[1], p2[2]) euler <- subset(nuvel1, nuvel1$plate.rot == "na") plate_boundary <- subset(plates, plates$plateA %in% c("na", "pa") & plates$plateB %in% c("na", "pa")) distance_from_pb( x = san_andreas, PoR = euler, pb = plate_boundary, tangential = TRUE ) distance_from_pb( x = san_andreas, PoR = euler, pb = plate_boundary, tangential = TRUE, km = TRUE ) test.vals <- c(175, 179, 2, 4) test.weights <- 1 / c(5, 1, 2, 4) # test expected output values -------------------------------------------------- test_that("Output of functions is as expected", { expect_equal(longitude_modulo(-361), -1) expect_equal(abs_vel(0.21, 0, r = 1), 0) expect_equal(quantise_wsm_quality(c("A", "E", "F", "G", 5)), c(15, NA, NA, NA, NA)) expect_equal(circular_median(c(15, 16)), 15.5) expect_equal(circular_median(c(15, 15, 16)), 15) expect_equal(circular_IQR(c(15, 16, 15, 15)), 1) expect_equal(deviation_norm(91), 89) expect_equal(cartesian_to_geographical(c(10, 0, 0)), c(0, 0)) expect_equal(geographical_to_cartesian(c(90, 0)), c(0, 0, 1)) }) # test output is NULL ---------------------------------------------------------- # test_that("Statistics return NULL when too few numbers", { # expect_null(circular_quantiles(c(15, 16))) # }) # test type -------------------------------------------------------------------- test_that("type of object returned is as expected", { expect_vector(get_azimuth(p1[1], p1[2], p2[1], p2[2]), ptype = double(), size = 1) expect_s3_class(sm.sf, "sf") expect_s3_class(gc.sf, "sf") expect_s3_class(ld.sf, "sf") }) # test message ----------------------------------------------------------------- test_that("Message expected", { # expect_message(norm_chisq(c(12, NA), 1, 1)) expect_message(circular_quantiles(c(15, 16))) expect_message(circular_quantiles(c(15, 15, 16))) }) # test warning ----------------------------------------------------------------- # test_that("Warning expected", { # expect_warning(rotation_angle(rotation_matrix(c(0, 0, 1), 0.000001))) # }) # test error ------------------------------------------------------------------- test_that("Error message if incorrect type argument", { expect_error(deviation_shmax(c(1, 2), c(1))) expect_error(cartesian_to_geographical(1)) expect_error(geographical_to_cartesian(1)) expect_error(cartesian_to_geographical(NA)) expect_error(geographical_to_cartesian(NA)) expect_error(norm_chisq(1, NA, NA)) expect_error(norm_chisq(NA, NA, NA)) expect_error(norm_chisq(2, 3, 3, na.rm = "typo")) expect_error(norm_chisq(obs = c(1, 2), prd = 1, unc = c(1, 2, 3))) expect_error(euler_pole(90, 0, NA, "test")) expect_error(circular_quasi_IQR(c(12, NA, 10, 9, "Inf", 7))) expect_error(PoR_shmax(stress, 10)) expect_error(distance_from_pb(san_andreas, euler, plate_boundary, tangential = "typo")) expect_error(distance_from_pb(x = stress, PoR = euler, pb = san_andreas, tangential = TRUE)) expect_error(equivalent_rotation(nuvel1, fixed = "test")) expect_error(eulerpole_smallcircles(ep3)) expect_error(eulerpole_greatcircles(ep3)) expect_error(eulerpole_loxodromes(ep3)) expect_error(eulerpole_loxodromes(ep1, angle = 90, cw = FALSE)) expect_error(eulerpole_paths(ep3)) })