column_objects <- c( "type", "id", "visible", "version", "changeset", "timestamp", "user", "uid", "lat", "lon", "members", "tags" ) class_columns <- list( type = "character", id = "character", visible = "logical", version = "integer", changeset = "character", timestamp = "POSIXct", user = "character", uid = "character", lat = "character", lon = "character", members = "list", tags = "list" ) ## osm_get_objects ---- test_that("osm_get_objects works", { ## Test errors expect_error( osm_get_objects(osm_type = "relation", osm_id = 1, version = 1, full_objects = TRUE), "Getting full objects with specific version is not supported." ) expect_error( osm_get_objects(osm_type = c("node", "relation"), osm_id = 1:3), "`osm_id` length must be a multiple of `osm_type` length." ) expect_error( osm_get_objects(osm_type = c("node", "relation"), osm_id = 1), "`osm_id` length must be a multiple of `osm_type` length." ) expect_error( osm_get_objects(osm_type = "relation", osm_id = 1:3, version = 1:2), "`osm_id` length must be a multiple of `version` length." ) expect_error( osm_get_objects(osm_type = "relation", osm_id = 1:2, version = 1:3), "`osm_id` length must be a multiple of `version` length." ) with_mock_dir("mock_get_objects", { expect_warning( objs <- osm_get_objects( osm_type = c("way", "way", "relation"), osm_id = c(235744929, 235744929, 6002785), full_objects = TRUE, tags_in_columns = TRUE ), "Duplicated elements discarded." ) }) }) ## Read: `GET /api/0.6/[node|way|relation]/#id` ---- test_that("osm_read_object works", { read <- list() xml_read <- list() json_read <- list() with_mock_dir("mock_read_object", { read$node <- osm_get_objects(osm_type = "node", osm_id = 35308286) read$way <- osm_get_objects(osm_type = "way", osm_id = 13073736L) read$rel <- osm_get_objects(osm_type = "relation", osm_id = "40581") xml_read$node <- osm_get_objects(osm_type = "node", osm_id = 35308286, format = "xml") xml_read$way <- osm_get_objects(osm_type = "way", osm_id = 13073736L, format = "xml") xml_read$rel <- osm_get_objects(osm_type = "relation", osm_id = "40581", format = "xml") json_read$node <- osm_get_objects(osm_type = "node", osm_id = 35308286, format = "json") json_read$way <- osm_get_objects(osm_type = "way", osm_id = 13073736L, format = "json") json_read$rel <- osm_get_objects(osm_type = "relation", osm_id = "40581", format = "json") }) lapply(read, expect_s3_class, c("osmapi_objects", "data.frame")) lapply(read, function(x) { lapply(x$members, function(y) { expect_true(is.null(y) | inherits(y, "way_members") | inherits(y, "relation_members")) }) }) expect_named(read$node, column_objects) lapply(read[c("way", "rel")], function(x) expect_named(x, column_objects)) lapply(read, function(x) { mapply(function(y, cl) expect_true(inherits(y, cl)), y = x, cl = class_columns[names(x)]) }) # Check that time is extracted, otherwise it's 00:00:00 in local time lapply(read, function(x) expect_false(strftime(as.POSIXct(x$timestamp), format = "%M:%S") == "00:00")) # methods lapply(read, function(x) expect_snapshot(print(x))) lapply(xml_read, expect_s3_class, "xml_document") lapply(json_read, expect_type, "list") # Compare xml, json & R mapply(function(d, x) { expect_identical(nrow(d), xml2::xml_length(x)) }, d = read, x = xml_read) mapply(function(d, x) { expect_identical(nrow(d), length(x$elements)) }, d = read, x = json_read) }) test_that("edit OSM object works", { x <- data.frame( type = c("node", "node", "way", "relation"), changeset = NA, lat = c(89, 89.001, NA, NA), lon = c(0, 0, NA, NA) ) x$members <- list( NULL, NULL, c("", ""), data.frame(type = c("node", "node", "way"), ref = c("", "", ""), role = c("", "", "")) ) x$tags <- list( data.frame(), data.frame(), data.frame(key = "name", value = "My way"), data.frame(key = "name", value = "Rel") ) with_mock_dir("mock_edit_objects", { expect_message( changeset_id <- osm_create_changeset( comment = "Test object creation", created_by = "osmapiR", # avoid changes in calls when updating version source = "Imagination", hashtags = "#testing;#osmapiR", verbose = TRUE ), "New changeset with id = " ) ## Create: `PUT /api/0.6/[node|way|relation]/create` ---- create_id <- character(nrow(x)) for (i in seq_len(nrow(x))) { if (x$type[i] == "way") { x$members[[i]] <- create_id[1:(i - 1)] } if (x$type[i] == "relation") { x$members[[i]] <- data.frame(type = x$type[1:(i - 1)], ref = create_id[1:(i - 1)], role = c(NA, NA, NA)) } create_id[i] <- osm_create_object(x[i, ], changeset_id = changeset_id) } ## Update: `PUT /api/0.6/[node|way|relation]/#id` ---- x$lon[1:2] <- 1 x$tags[[3]]$value <- "Our way" x$tags[[4]]$value <- "Relation" x$visible <- TRUE x$id <- create_id x$version <- 1L update_version <- character(nrow(x)) for (i in seq_len(nrow(x))) { update_version[i] <- osm_update_object(x[i, ], changeset_id = changeset_id) } ## Delete: `DELETE /api/0.6/[node|way|relation]/#id` ---- x$version <- 2 delete_version <- character(nrow(x)) for (i in rev(seq_len(nrow(x)))) { delete_version[i] <- osm_delete_object(x[i, ], changeset_id = changeset_id) } osm_close_changeset(changeset_id) }) expect_match(create_id, "[0-9]+") lapply(update_version, expect_identical, "2") lapply(delete_version, expect_identical, "3") ## Test errors expect_error( osm_create_object(x = "doesnt_exist", changeset_id = changeset_id), "`x` is interpreted as a path to an xml file, but it can't be found " ) expect_error(osm_create_object(x = data.frame(), changeset_id = changeset_id), "`x` lacks ") expect_error( osm_create_object(x = list(), changeset_id = changeset_id), "`x` must be a path to a xml file, a `xml_document` " ) expect_error( osm_update_object(x = "doesnt_exist", changeset_id = changeset_id), "`x` is interpreted as a path to an xml file, but it can't be found " ) expect_error(osm_update_object(x = data.frame(), changeset_id = changeset_id), "`x` lacks ") expect_error( osm_update_object(x = list(), changeset_id = changeset_id), "`x` must be a path to a xml file, a `xml_document` " ) expect_error( osm_delete_object(x = "doesnt_exist", changeset_id = changeset_id), "`x` is interpreted as a path to an xml file, but it can't be found " ) expect_error(osm_delete_object(x = data.frame(), changeset_id = changeset_id), "`x` lacks ") expect_error( osm_delete_object(x = list(), changeset_id = changeset_id), "`x` must be a path to a xml file, a `xml_document` " ) }) ## History: `GET /api/0.6/[node|way|relation]/#id/history` ---- test_that("osm_history_object works", { history <- list() xml_history <- list() json_history <- list() with_mock_dir("mock_history_object", { history$node <- osm_history_object(osm_type = "node", osm_id = 35308286) history$way <- osm_history_object(osm_type = "way", osm_id = 13073736L) history$rel <- osm_history_object(osm_type = "relation", osm_id = "40581") xml_history$node <- osm_history_object(osm_type = "node", osm_id = 35308286, format = "xml") xml_history$way <- osm_history_object(osm_type = "way", osm_id = 13073736L, format = "xml") xml_history$rel <- osm_history_object(osm_type = "relation", osm_id = "40581", format = "xml") json_history$node <- osm_history_object(osm_type = "node", osm_id = 35308286, format = "json") json_history$way <- osm_history_object(osm_type = "way", osm_id = 13073736L, format = "json") json_history$rel <- osm_history_object(osm_type = "relation", osm_id = "40581", format = "json") }) lapply(history, expect_s3_class, c("osmapi_objects", "data.frame")) lapply(history, function(x) { lapply(x$members, function(y) { expect_true(is.null(y) | inherits(y, "way_members") | inherits(y, "relation_members")) }) }) expect_named(history$node[, seq_len(length(column_objects))], column_objects) lapply(history[c("way", "rel")], function(x) { expect_named(x[, seq_len(length(column_objects))], column_objects) }) # methods lapply(history, function(x) expect_snapshot(print(x))) lapply(xml_history, expect_s3_class, "xml_document") lapply(json_history, expect_type, "list") # Compare xml, json & R mapply(function(d, x) { expect_identical(nrow(d), xml2::xml_length(x)) }, d = history, x = xml_history) mapply(function(d, x) { expect_identical(nrow(d), length(x$elements)) }, d = history, x = json_history) }) ## Version: `GET /api/0.6/[node|way|relation]/#id/#version` ---- test_that("osm_version_object works", { version <- list() xml_version <- list() json_version <- list() with_mock_dir("mock_version_object", { version$node <- osm_get_objects(osm_type = "node", osm_id = 35308286, version = 1) version$way <- osm_get_objects(osm_type = "way", osm_id = 13073736L, version = 2) version$rel <- osm_get_objects(osm_type = "relation", osm_id = "40581", version = 3) xml_version$node <- osm_get_objects(osm_type = "node", osm_id = 35308286, version = 1, format = "xml") xml_version$way <- osm_get_objects(osm_type = "way", osm_id = 13073736L, version = 2, format = "xml") xml_version$rel <- osm_get_objects(osm_type = "relation", osm_id = "40581", version = 3, format = "xml") json_version$node <- osm_get_objects(osm_type = "node", osm_id = 35308286, version = 1, format = "json") json_version$way <- osm_get_objects(osm_type = "way", osm_id = 13073736L, version = 2, format = "json") json_version$rel <- osm_get_objects(osm_type = "relation", osm_id = "40581", version = 3, format = "json") }) lapply(version, expect_s3_class, c("osmapi_objects", "data.frame")) lapply(version, function(x) { lapply(x$members, function(y) { expect_true(is.null(y) | inherits(y, "way_members") | inherits(y, "relation_members")) }) }) expect_named(version$node[, seq_len(length(column_objects))], column_objects) lapply(version[c("way", "rel")], function(x) { expect_named(x[, seq_len(length(column_objects))], column_objects) }) # methods lapply(version, function(x) expect_snapshot(print(x))) lapply(xml_version, expect_s3_class, "xml_document") lapply(json_version, expect_type, "list") # Compare xml, json & R mapply(function(d, x) { expect_identical(nrow(d), xml2::xml_length(x)) }, d = version, x = xml_version) mapply(function(d, x) { expect_identical(nrow(d), length(x$elements)) }, d = version, x = json_version) }) ## Multi fetch: `GET /api/0.6/[nodes|ways|relations]?#parameters` ---- test_that("osm_fetch_objects works", { fetch <- list() fetch_xml <- list() with_mock_dir("mock_fetch_objects", { fetch$node <- osm_get_objects(osm_type = "node", osm_id = c(35308286, 1935675367)) fetch$way <- osm_get_objects(osm_type = "way", osm_id = c(13073736L, 235744929L)) fetch$way_wide_tags <- osm_get_objects(osm_type = "way", osm_id = c(13073736L, 235744929L), tags_in_columns = TRUE) # Specific versions fetch$rel <- osm_get_objects(osm_type = "relation", osm_id = c("40581", "341530"), version = c(3, 1)) fetch_xml$node <- osm_get_objects(osm_type = "node", osm_id = c(35308286, 1935675367), format = "xml") fetch_xml$way <- osm_get_objects(osm_type = "way", osm_id = c(13073736L, 235744929L), format = "xml") # Specific versions fetch_xml$rel <- osm_get_objects( osm_type = "relation", osm_id = c("40581", "341530"), version = c(3, 1), format = "xml" ) }) lapply(fetch, expect_s3_class, c("osmapi_objects", "data.frame")) lapply(fetch, function(x) { lapply(x$members, function(y) { expect_true(is.null(y) | inherits(y, "way_members") | inherits(y, "relation_members")) }) }) expect_named(fetch$node[, seq_len(length(column_objects))], column_objects) lapply(fetch[c("way", "rel")], function(x) { expect_named(x[, seq_len(length(column_objects))], column_objects) }) lapply(fetch_xml, expect_s3_class, "xml_document") ### test transformation df <-> xml ---- mapply(function(df, xml) { expect_identical(xml2::xml_children(object_DF2xml(df)), xml2::xml_children(xml)) expect_identical(object_xml2DF(xml), df) }, df = fetch[names(fetch_xml)], xml = fetch_xml) ### Test long URL in batches to avoid ERROR: HTTP 414 URI Too Long ---- # osm_ids <- unique(sort(toponimsCat::municipis$id)) # seq_ids <- list(osm_ids[1]) # k <- 1 # for (i in seq_len(length(osm_ids))[-1]) { # if (osm_ids[i] - osm_ids[i - 1] > 1) { # k <- k + 1 # seq_ids[[k]] <- osm_ids[i] # } else if (osm_ids[i + 1] - osm_ids[i] > 1) { # seq_ids[[k]] <- c(seq_ids[[k]], osm_ids[i]) # } # } # cmd <- paste0("osm_ids <- c(", paste(sapply(seq_ids, function(x) paste(x, collapse = ":")), collapse = ", "), ")") # all.equal(osm_ids, eval(parse(text = cmd))) # cat(cmd) osm_ids <- c( ## Municipis PPCC 18000, 18311, 18316, 18318, 18326, 18328, 18349:18352, 18354, 18362:18363, 18375, 18391, 18409, 18416:18417, 18419, 18428, 18475:18479, 18482, 18484, 18496, 20224, 20339, 22531, 22588, 23234, 23237, 23266, 23303, 23308, 23315, 23324, 23340, 23759, 23763, 23790, 23795, 23804, 23814, 23823, 23895, 24457:24459, 24858, 24940, 25873, 27529, 34167, 40581, 51547, 53365, 54461, 54467, 54469, 54471, 74277, 74281, 74284, 74308:74310, 74988, 74993, 80067, 81599, 123160, 269776, 270405, 271192, 271356, 271429, 271495, 271536, 271664, 271713, 272157, 273497:273498, 274180, 339488:339490, 339492:339493, 339495, 339498:339503, 339506:339511, 339513:339515, 339534, 339536:339537, 339568, 339572:339574, 339577, 339584, 339613:339622, 339664, 339809:339811, 339815:339821, 339823:339824, 339847, 339849:339852, 339854:339855, 339858, 339862, 339873:339880, 339887, 339928, 339930, 339963:339972, 340014, 340016, 340030, 340174:340179, 340193:340204, 340206:340211, 340216:340217, 340257, 340259, 340261, 340307, 340319, 340328:340331, 340341:340351, 340373:340375, 340377, 340379:340382, 340390, 340413, 340438:340439, 340441:340442, 340445:340448, 340454, 340476, 340485, 340487:340488, 340492, 340498, 340500:340502, 340506:340507, 340518, 340526:340528, 340530:340553, 340555, 340561:340562, 340661, 340689, 340694, 340696:340697, 340700, 340791, 340826, 340828, 340843, 340848:340856, 340858:340859, 340865:340872, 340908, 340920, 340928, 340930:340933, 340935, 340975, 341046:341047, 341049:341051, 341053, 341056, 341135, 341140:341142, 341144:341148, 341193, 341195, 341224, 341230:341236, 341240:341241, 341308:341311, 341314:341315, 341318:341321, 341323, 341330, 341355, 341395:341397, 341410, 341413, 341416:341418, 341444:341450, 341473, 341476, 341484:341486, 341497, 341530, 341537, 341540, 341559, 341695:341702, 341709, 341711, 341730, 341733, 341745, 341762, 341774:341775, 341787, 341789, 341791, 341802:341809, 341814:341815, 341826:341829, 341831:341834, 341837, 341841, 341843, 341845:341846, 341848, 341850:341852, 341894:341901, 341903:341904, 341981, 341996:341999, 342001:342007, 342064:342073, 342133:342134, 342136:342143, 342152:342153, 342164, 342166:342171, 342210, 342212, 342214:342217, 342250:342258, 342333:342345, 342347:342349, 342355:342364, 342416, 342418:342419, 342422:342423, 342427, 342447, 342454, 342456, 342470, 342477:342478, 342491:342499, 342502, 342505:342507, 342517:342526, 342544, 342552, 342590, 342597:342603, 342605, 342670:342671, 342673:342675, 342677:342678, 342680:342681, 342688:342696, 342698, 342712, 342726:342734, 342737, 342742, 342784, 342788:342789, 342792, 342826, 342829:342830, 342833:342839, 342890:342891, 342903, 342910, 342912, 342914:342922, 342934, 342939, 342959:342961, 342985:342993, 343010:343014, 343017:343018, 343020:343023, 343059, 343063, 343117, 343119, 343121, 343123:343126, 343185:343190, 343215:343222, 343235:343236, 343242, 343305:343320, 343322:343324, 343328:343329, 343332, 343334:343335, 343347:343352, 343396:343398, 343400:343401, 343406:343410, 343436, 343441, 343444:343445, 343447:343449, 343470:343471, 343500, 343505:343506, 343511, 343534:343542, 343586, 343589, 343629:343640, 343642, 343644:343645, 343647:343648, 343659, 343668:343672, 343710:343719, 343729, 343818, 343834:343842, 343893:343894, 343936:343937, 343939:343945, 343953:343962, 343964:343967, 343970:343971, 344060:344069, 344117:344118, 344126:344135, 344174, 344198:344206, 344255, 344257:344262, 344264, 344266:344273, 344294:344301, 344372:344381, 344392, 344394, 344403:344406, 344419, 344437, 344515:344523, 344537, 344563, 344581, 344583, 344585, 344591, 344610:344617, 344624:344634, 344648, 344674, 344730:344731, 344742, 344744:344745, 344825, 344856, 344858, 344861:344862, 344864, 344867, 344873, 344885, 344887, 344919:344925, 344927:344929, 344932:344935, 344940:344948, 344950, 344953, 344956, 344964, 344966, 345011, 345022, 345031, 345033:345041, 345064, 345154, 345165, 345172:345173, 345185, 345204:345208, 345210:345214, 345216:345217, 345219:345225, 345244:345246, 345248, 345267:345269, 345272, 345282, 345284:345292, 345327, 345329, 345361, 345368, 345396:345398, 345400:345402, 345405:345406, 345415, 345423, 345430, 345448, 345466:345467, 345484:345486, 345489:345498, 345513:345515, 345517:345519, 345521:345522, 345526, 345549, 345553:345554, 345583, 345587, 345594:345595, 345598:345599, 345601:345603, 345694:345696, 345698:345699, 345701:345702, 345704, 345708:345709, 345761, 345764, 345773, 345806:345807, 345816, 345823, 345855, 345920:345923, 345937, 345941:345946, 345952, 345972, 345996:345997, 345999:346000, 346003:346005, 346025:346028, 346030:346032, 346037, 346042, 346046, 346050, 346070:346076, 346099, 346101, 346110:346113, 346131, 346228:346237, 346241, 346254, 346265, 346321, 346327:346328, 346333:346334, 346336:346337, 346345:346349, 346361, 346363:346365, 346367, 346371:346374, 346383, 346387, 346389, 346437:346446, 346485, 346487:346488, 346540:346541, 346543:346552, 346555:346558, 346560:346561, 346608:346617, 346643, 346680:346688, 346690, 346698, 346710:346711, 346717, 346719, 346721:346731, 346734, 346746, 346758:346759, 346793, 346802:346803, 346844:346845, 346847:346852, 346854:346871, 346883, 346900:346901, 346941:346944, 346981:346983, 346985:346989, 346992:346993, 346995:347001, 347018, 347020, 347180, 347188, 347244, 347246:347251, 347253, 347348:347357, 347361:347362, 347364, 347416, 347418:347424, 347468:347470, 347477:347480, 347510:347518, 347535, 347537:347538, 347540:347541, 347543:347553, 347608:347611, 347614, 347616:347625, 347634:347645, 347656:347657, 347678:347679, 347682, 347684:347686, 347764:347773, 347785, 347791, 347826, 347836, 347860:347862, 347864:347867, 347869:347880, 347882, 347884:347885, 347889:347896, 347898, 347911, 347946, 347949:347958, 348026, 348044:348046, 348048:348051, 348053:348059, 348103, 348113, 348131:348150, 348154, 348158, 348160, 348399, 348402, 348405, 348409, 348412, 348822:348833, 348882, 348886:348895, 348910, 348943:348952, 348970:348971, 348973, 356747, 392022, 392027, 392033, 392223, 392304, 392308, 401880, 409332, 409377, 409749, 1069580, 1209766, 1235861, 1382208, 1430537, 1664392:1664395, 1664419:1664420, 1798944:1798945, 1809101:1809102, 1809104, 1809108, 1809111, 1809113, 1809115, 1809117, 1809121, 1820709, 1821272, 1918699, 1918726, 1918771, 1918812, 1918955, 1919150, 1919385, 1919494, 1920120, 1920644, 1920758, 1952519, 1966208, 2084436, 2181768, 2548784, 2593113, 2621923, 2768132:2768134, 2804753:2804759, 2814309, 2814313, 2814562, 2814982, 2815058, 2815362, 2815369, 2816871, 2817026, 2820388, 2820610, 2820751, 2820851, 2827098, 2827311, 2828302, 2828560, 2829664, 2853657, 2853759, 2853831, 2853900, 2854010, 2854137, 2858704, 2858743, 2858774, 2862615, 2862650, 2862710, 2862762, 2863980, 2864868, 2865282, 2868083, 2875269, 2875472, 2897486, 2897517, 2897645, 2912280, 2912304, 2912344, 2912375, 2912388, 2913416, 2913446, 2913461, 2913485, 2913659, 2913745, 2913805, 2913808, 2913877, 2918640, 2918769, 2918951, 2918996, 2919019, 2919091, 2919179, 2924113, 2924251, 2924277, 2924304, 2924446, 2926262:2926263, 5245866, 11755232 ) osm_ids <- as.character(osm_ids) expect_message(set_osmapi_connection(), "Logged out from ") # TODO: why it fails without changing the server? # Tests work when running interactively but fail in R CMD check: # # Error in `stop_request(req)`: An unexpected request was made: # GET https://master.apis.dev.openstreetmap.org/api/0.6/relations?relations=... # # Expected mock file: osm.org/api/0.6/relations-13eee2.* fetch_many <- list() fetch_many_xml <- list() with_mock_dir("mock_fetch_many_objects", { fetch_many$rel <- osm_get_objects(osm_type = "relation", osm_id = osm_ids) fetch_many$rel_wide_tags <- osm_get_objects(osm_type = "relation", osm_id = osm_ids, tags_in_columns = TRUE) # Specific versions fetch_many$rel_version <- osm_get_objects( osm_type = "relation", osm_id = osm_ids, version = rep(1, length(osm_ids)) ) fetch_many_xml$rel <- osm_get_objects(osm_type = "relation", osm_id = osm_ids, format = "xml") # Specific versions fetch_many_xml$rel_version <- osm_get_objects( osm_type = "relation", osm_id = osm_ids, version = rep(1, length(osm_ids)), format = "xml" ) }) lapply(fetch_many, function(x) { id <- x[[intersect(names(x), c("id", "osm_id"))]] expect_identical(id, osm_ids) expect_false(any(duplicated(id))) }) lapply(fetch_many_xml, function(x) { id <- xml2::xml_attr(xml2::xml_children(x), attr = "id") expect_identical(id, osm_ids) expect_false(any(duplicated(id))) }) mapply(function(d, x) { expect_identical(nrow(d), xml2::xml_length(x)) }, d = fetch_many[1:2], x = fetch_many_xml) expect_message(set_osmapi_connection("testing"), "Logged out from") # TODO # methods lapply(fetch, function(x) expect_snapshot(print(x))) }) ## Relations for element: `GET /api/0.6/[node|way|relation]/#id/relations` ---- test_that("osm_relations_object works", { rels <- list() xml_rels <- list() json_rels <- list() with_mock_dir("mock_relations_object", { rels$node <- osm_relations_object(osm_type = "node", osm_id = 1470837704) rels$way <- osm_relations_object(osm_type = "way", osm_id = 372011578) rels$rel <- osm_relations_object(osm_type = "relation", osm_id = 342792) xml_rels$node <- osm_relations_object(osm_type = "node", osm_id = 1470837704, format = "xml") xml_rels$way <- osm_relations_object(osm_type = "way", osm_id = 372011578, format = "xml") xml_rels$rel <- osm_relations_object(osm_type = "relation", osm_id = 342792, format = "xml") json_rels$node <- osm_relations_object(osm_type = "node", osm_id = 1470837704, format = "json") json_rels$way <- osm_relations_object(osm_type = "way", osm_id = 372011578, format = "json") json_rels$rel <- osm_relations_object(osm_type = "relation", osm_id = 342792, format = "json") }) lapply(rels, expect_s3_class, c("osmapi_objects", "data.frame")) lapply(rels, function(x) { lapply(x$members, function(y) { expect_true(is.null(y) | inherits(y, "way_members") | inherits(y, "relation_members")) }) }) lapply(rels, function(x) expect_named(x[, seq_len(length(column_objects))], column_objects)) # methods lapply(rels, function(x) expect_snapshot(print(x))) lapply(xml_rels, expect_s3_class, "xml_document") lapply(json_rels, expect_type, "list") # Compare xml, json & R mapply(function(d, x) { expect_identical(nrow(d), xml2::xml_length(x)) }, d = rels, x = xml_rels) mapply(function(d, x) { expect_identical(nrow(d), length(x$elements)) }, d = rels, x = json_rels) }) ## Ways for node: `GET /api/0.6/node/#id/ways` ---- test_that("osm_ways_node works", { with_mock_dir("mock_ways_node", { ways_node <- osm_ways_node(node_id = 35308286) xml_ways_node <- osm_ways_node(node_id = 35308286, format = "xml") json_ways_node <- osm_ways_node(node_id = 35308286, format = "json") }) expect_s3_class(ways_node, c("osmapi_objects", "data.frame")) lapply(ways_node$members, function(x) { expect_true(is.null(x) | inherits(x, "way_members") | inherits(x, "relation_members")) }) expect_named(ways_node[, seq_len(length(column_objects))], column_objects) # methods expect_snapshot(print(ways_node)) expect_s3_class(xml_ways_node, "xml_document") expect_type(json_ways_node, "list") # Compare xml, json & R expect_identical(nrow(ways_node), xml2::xml_length(xml_ways_node)) expect_identical(nrow(ways_node), length(json_ways_node$elements)) }) ## Full: `GET /api/0.6/[way|relation]/#id/full` ---- test_that("osm_full_object works", { full <- list() with_mock_dir("mock_full_object", { full$way <- osm_get_objects(osm_type = "way", osm_id = 13073736, full_objects = TRUE) full$rel <- osm_get_objects(osm_type = "relation", osm_id = "6002785", full_objects = TRUE) full$df <- osm_get_objects( osm_type = c("relation", "way", "way", "node"), osm_id = c(6002785, 13073736, 235744929, 35308286), full_objects = TRUE, format = "R" ) full_xml <- osm_get_objects( osm_type = c("relation", "way", "way", "node"), osm_id = c(6002785, 13073736, 235744929, 35308286), full_objects = TRUE, format = "xml" ) full_json <- osm_get_objects( osm_type = c("relation", "way", "way", "node"), osm_id = c(6002785, 13073736, 235744929, 35308286), full_objects = TRUE, format = "json" ) }) lapply(full, expect_s3_class, c("osmapi_objects", "data.frame")) lapply(full, function(x) { lapply(x$members, function(y) { expect_true(is.null(y) | inherits(y, "way_members") | inherits(y, "relation_members")) }) }) lapply(full, function(x) expect_named(x[, seq_len(length(column_objects))], column_objects)) # methods lapply(full, function(x) expect_snapshot(print(x))) expect_s3_class(full_xml, "xml_document") expect_type(full_json, "list") expect_named(full_json, c("version", "generator", "copyright", "attribution", "license", "elements")) lapply(full_json$elements, function(x) { expect_contains(names(x), c("type", "id", "timestamp", "version", "changeset", "user", "uid")) }) # Compare xml, json & R expect_identical(nrow(full$df), xml2::xml_length(full_xml)) expect_identical(nrow(full$df), length(full_json$elements)) id_df <- full$df$id id_xml <- sapply(xml2::xml_children(full_xml), xml2::xml_attr, attr = "id") id_json <- as.character(sapply(full_json$elements, function(x) x$id)) expect_setequal(id_df, id_xml) expect_setequal(id_df, id_json) }) ## Redaction: `POST /api/0.6/[node|way|relation]/#id/#version/redact?redaction=#redaction_id` ---- test_that("osm_redaction_object works", { x <- data.frame(type = "node", lat = 0, lon = 0, name = "Test redaction.") obj <- osmapi_objects(x, tag_columns = "name") with_mock_dir("mock_redact_object", { expect_message( changeset_id <- osm_create_changeset( comment = "Test object redaction", created_by = "osmapiR", # avoid changes in calls when updating version hashtags = "#testing;#osmapiR", verbose = TRUE ), "New changeset with id = " ) node_id <- osm_create_object(x = obj, changeset_id = changeset_id) node_osm <- osm_get_objects(osm_type = "node", osm_id = node_id) deleted_version <- osm_delete_object(x = node_osm, changeset_id = changeset_id) redaction <- osm_redaction_object(osm_type = node_osm$type, osm_id = node_osm$id, version = 1, redaction_id = 1) unredaction <- osm_redaction_object(osm_type = node_osm$type, osm_id = node_osm$id, version = 1) osm_close_changeset(changeset_id = changeset_id) }) expect_null(redaction) expect_null(unredaction) })