# ============================================================================== # quickblock -- Quick Threshold Blocking # https://github.com/fsavje/quickblock # # Copyright (C) 2017 Fredrik Savje, Jasjeet Sekhon, Michael Higgins # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see http://www.gnu.org/licenses/ # ============================================================================== library(quickblock) context("quickblock") raw_data <- matrix(c( -0.4872, 0.7451, -0.5165, 1.9151, -1.0990, 0.1415, -1.6650, -0.7701, 0.8870, -1.7677, 0.4690, -0.7884, -1.5393, -1.7362, -0.2024, 1.0733, -1.3620, -0.4470, 0.8180, -0.0763, 0.9161, 0.1498, -0.4148, -0.3479, 0.0125, 0.4151, -0.7968, -1.1322, 0.3485, 1.4876, 0.0120, -0.6994, 1.3863, 0.8316, 1.5635, -0.8186, -1.1553, 0.9905, 0.4355, -0.3541, 0.1017, 1.6381, -1.0360, -0.3388, -0.3153, -0.8831, 1.5329, 0.8185, 0.6928, 0.3537, 1.3176, 1.0420, 0.9509, 0.0724, 1.1712, 1.4547, -1.2928, -0.7068, 0.9908, 0.9348, 0.7290, -1.1964, -0.5767, 1.4289, 0.1575, 0.8106, 1.8869, -2.1967, 1.1377, -0.4083, -0.1881, 1.0856, 0.3577, 1.5250, 0.2335, -1.0602, 0.1323, -0.1126, 0.3117, 0.7388, -0.2705, 0.6851, 0.1205, 0.9823, 0.9160, -1.3916, -0.0303, -2.6696, 0.4105, -0.5251, 0.2119, 0.5794, 0.8496, 1.3887, 0.4537, 0.2799, -0.6344, 0.1534, 0.3601, 1.7681, 0.0953, 3.1733, -0.6397, 0.6969, 1.2124, 0.0444, 0.2699, 0.5722, 1.4017, -2.0091, -0.2097, 1.1762, -0.8968, 0.4630, -1.0038, 0.9264, 0.0769, 0.6999, -0.7871, -0.1970, 1.6685, 2.2448, 1.8787, -0.0526, -0.3524, 0.1996, 0.4861, -2.3330, 1.7631, -0.2454, 1.9811, 1.7298, -1.3136, 0.4381, -1.7302, -0.5488, -0.4629, 1.0734, 0.4401, 1.9076, 0.7295, 0.8086, -1.1172, -1.0829, 0.2377, 0.5529, 0.8747, -0.3075, 0.3003, 0.0108, -0.9400, -2.3602, -0.6517, 0.3543, 1.1219, 1.2237, 1.2876, -0.4258, -0.5316, 1.5097, -0.9258, -0.2263, -1.6545, -0.5118, 0.8067, -0.4161, -1.3016, 0.6354, 0.5915, -1.3470, -0.8744, 0.1387, 0.6643, -0.2910, -0.3412, 0.1793, 0.7138, 0.2433, 0.6125, -0.2464, 0.0057, 0.6646, 0.0736, 0.6896, -0.7782, -1.8728, 0.8456, 0.9308, -0.4463, -1.8400, -0.5621, 1.5114, -1.0632, 0.1462, 1.9489, 0.3121, -0.6328, 0.0918, 0.2918, 0.4331, 1.2829, 0.3552, 0.4426, 0.2720, 2.3246, 0.7779, 0.9825, 1.7908, -0.6747, 1.0587, 0.2962, 1.2923, -1.1576, 0.4971, -2.0785, 0.8715, 2.2522, -0.4881, 0.2309, -0.0164, -1.4632, 1.7606, -0.3353, -0.1725, -0.4967, 0.1605, 1.3567, 0.4294, 1.8146, -0.5629, 0.0107, 1.0025, -0.9478, -0.1239, -0.9951, 1.4195, 0.4877, -1.8599, 1.7040, 0.0246, 1.1572, -0.4044, 0.2038, -0.6518, 0.5821, 0.3766, -0.7009, -1.0738, 0.9604, 0.1802, 0.5913, 0.0365, 0.4543, -1.0197, -0.7051, -0.6344, -1.0327, -0.9951, 0.6972, 0.8006, 0.8440, -1.3340, -0.4797, -0.2743, -1.0535, -0.0091, -0.4318, 0.3279, -0.1839, -0.5958, 1.5160, -0.0422, 0.3614, -0.8697, -1.1830, -1.1213, 1.5815, 1.6135, -0.3470, 0.0419, -0.4221, -0.6461, -1.0033, -0.0900, -0.5785, 1.7861, -0.1090, -1.0358, 0.1087, -0.0332, -0.3088, -0.4634, -0.0462, 0.6296, 1.7265, 0.4197, -0.7898, -1.7844, 1.9471, 0.7274, -0.8677, -0.2795, 0.2455, -0.9393, 1.1793, -0.3175, -0.8311, -0.6760, 0.2970, -0.9475, -0.2148, 0.5637, 0.4079, 0.0066, 0.9437, -0.0163, -1.0125, 0.2154, -0.2482, -1.8247, -1.0617, 0.7498, 0.4034, 0.5635, -0.4876, 1.9992, 0.9648, -0.8537, 0.0063, -1.1641, -1.6558, 0.8655, 0.9480, -0.5356, 0.2981, 0.5342, -1.0418, 1.0282, -0.2379, 0.1199, 1.4087, 0.5974, 1.0881, -0.6855, 2.0377, -0.5227, -1.0928, 0.6629, 1.2590, 1.7140, 0.3889, -1.1810, 0.5250, 1.0377, -2.8392, 0.2053, -0.2867, 0.0450, -1.3993, 0.4165, 2.9334, -0.0015, 0.5121, 0.1672, -0.5330, -0.1301, -0.6468, 0.4862, 1.4244, 0.3494, -0.7650, -3.0832, -0.2569, -0.7141, -0.9665, -1.2767, 0.6289, -0.6010, -0.2776, -1.5355, -0.5862, -0.6076, -0.3462, -1.6480, -0.4506, -0.0737, 2.1826, 0.3112, -1.4866, 0.3100, -0.1294, 0.0274, 1.0829, -0.0825, -1.6882, 0.8567, -0.2415, 0.1970, -1.1719, 0.8883, -0.3625, 0.5567, 0.3272, -0.7696, -0.6935, 0.2545, -0.4362, -1.0174, 0.9380, 0.8912, 0.6014, -0.4535, 0.8919, 0.3829, -0.2889, -1.6220, -0.3766, -0.0062, 1.2260, -1.3599, -0.9028, 0.8031, 0.4731, 1.1029, -0.4523, -1.4486, -0.5979, 0.3783, 0.0164, 0.8578, -1.5953, -0.8259, -1.6055, 0.4267, -1.4018, 0.0276, 1.3672, 0.0181, 1.1177, -1.7308, 1.0657, -0.1088, 2.4203, -0.5355, -2.0901, -1.5322, -1.7706, 0.2952, 1.5633, 0.3468, -0.7159, 0.7950, 0.5505, -0.5370, -0.4594, 0.1716, -0.8158, 1.3633, -0.9603, 1.1322, -0.4228, -0.3554, 1.2230, 0.2992, 1.7149, -0.0627, 0.2368, -0.1479, -2.0702, -1.8919, 0.6002, -0.3636, -1.5506, 0.2206, -0.8984, 0.9310, 1.5714, 1.0776, 0.7620, -1.2547, 2.2364, -0.5050, 1.1581, 0.9402, -0.2105, 0.5425, -1.7107, 0.9627, 0.2343, 1.0857, 0.4265, 0.9014, -2.2587, -0.4009, 0.1736, 0.5412, -0.6627, 1.0283, -0.3611, -0.0952, 1.1076, 0.1142, -0.8730, -0.4041, -0.1622, 0.6180, -1.4230, 0.7598, -1.1315, -1.4547, 0.9569, -1.1144, -0.8974, -1.8576, 0.3025, -0.2148, 0.0795, 1.7697, 0.5964, 1.3837, -0.3508, -0.4489, -1.0038, 0.7689, -0.9172, -0.2032, 0.1305, 0.7555, -1.1910, 0.6642, 1.8022, -0.2778, 0.2482, -2.1934, 0.9776, -0.5258, 1.4201, 0.9297, 0.7087, 1.1819, -0.8285, 0.5929, -1.6667, 1.4040, 0.6843, 0.1170, -2.5217, 0.5207, -0.5059, -1.8744, 0.8313, -0.0058, -1.4890, 1.7169, -0.9529, 0.1913, 1.5248, 0.9072, 0.6951, 0.9039, 1.1450, -0.7990, -0.8951, 0.0930, 1.8007, -0.8398, 0.1976, 0.0284, 1.6596, -0.2373, 1.6222, 0.5146, 0.5970, -0.9764, -1.1838, 0.9578, -0.1807, 0.0804, 0.1399, 1.5009, 1.1879, 0.4374, -0.5793, 0.5963, -1.2124, 1.2813, -0.7977, -0.2510, -0.4962, -0.5805, 0.5271, -0.1430, -0.4335, 0.3752, 0.4296, 0.9512, 2.5223, 0.0944, 0.4732, 0.8319, 0.1064, -1.5534, 0.5204, -0.3217, 0.6548, 1.8891, 1.8319, -0.5004, -0.5851, -0.4657, 1.5465, -1.3594, 1.0047, -0.4412, -0.0397, 0.2357, 2.0599, 1.0330, -0.3042, 1.4978, 1.4697, 0.0848, 0.5442, -0.3818, 0.0743, 1.9379, 1.3631, 0.2789, 0.3412, -0.9296, 0.6453, -0.4919, 1.4866, -0.2201, 1.9315, 0.0905, -1.8105, 0.8638, -0.7237, -0.2104, -0.4444, 0.7172, -0.3825, 0.2067, -0.0333, -1.1909, 1.1056, 0.9053, -0.6597, -0.6914, 0.4585, -0.7110, 0.0690, 0.5465, 1.9854, 0.8117, 1.0793, 1.2360, -1.9689, -0.6541, -0.2067, -0.9436, -0.2843, 0.3925, -0.5058, 0.2156, -0.2359, 0.3010, 2.1301, 1.5143, 0.0042, 0.3615, -0.6853, 0.8183, -0.5962, -0.5115, -0.0717, -0.3841, -0.5058, -1.0159, 0.8669, 0.0163, -0.3912, 0.9714, 2.1844, 0.9561, 1.2363, -1.2320, 1.0044, -2.8297, -0.5989, 0.9072, -0.4030, -1.9363, -0.7543, 1.0802, 0.2087, 0.0241, 1.7565, -0.8564, 0.2633, 1.1214, 1.1939, -0.1404, -0.5400, -0.5482, -0.6363, 1.5533, -1.0036, 0.0684, -0.7229, -0.3722, 2.0825, 0.1669, 1.1343, 0.8718, -1.0742, 0.6947, 0.6584, -1.5386, -0.4617, -0.4007, -0.4141, -0.9637, 1.2189, 0.0330, 0.8760, -0.7897, -0.2739, 0.1020, -0.0052, -1.2279, 0.7426, -0.2921, -0.1473, 0.9460, 2.2570, -0.9717, 1.4505, 1.0058, 2.1400, 0.4182, -1.3513, -0.0570, -0.3588, 0.1365, 0.6475, -0.6026, 0.4890, -1.7305, 0.4392, -1.6688, -0.4057, 0.2632, -1.7420, -0.1697, 0.6454, 1.6009, 0.2703, -0.2497, -0.5316, 0.8671, 0.6408, 0.9662, 1.7522, -0.4981, -0.6324, 0.7571, -0.4545, -1.5518, 0.7337, 0.4030, 0.1092, -0.2047, -0.7430, 1.1214, 0.7836, -0.3992, -0.3865, -0.9020, -0.9157, -0.0421, 0.3431, -0.8068, 0.1751, 0.5083, -0.5680, 0.1369, -0.4947, 2.2623, 1.2339, 0.3881, -0.2316, -1.6752, 0.2572, 1.0593, -0.4890, -0.0756, -0.5038, -1.8795, -1.5513, -1.0853, 1.0083, 1.1964, -2.1472, 0.6647, 0.2958, 0.0789, 0.5603, 2.5896, -0.5381, -0.7058, 0.1116, 0.1473, -0.5630, 0.6310, -0.0618, 0.4437, 0.7692, -2.1426, -2.2755, -0.1039, -0.1375, -0.2636, -0.0682, 0.4290, 1.5298, -0.4661, 0.2780, -0.3979, 0.9276, -0.4869, 1.5589, 0.7911, 0.0278, 0.1342, 0.6081, -1.2963, 0.6305, -0.5811, -1.3431, -0.3408, 2.7015, -0.0249, -1.5477, -0.7342, -0.5546, 0.4840, -0.1092, -0.3016, -0.4935, -0.8670, -1.3928, 0.3843, -0.1520, -0.6043, -1.5804, -0.2794, -0.0220, -0.3274, 0.3435, 0.4598, -0.0506, -0.0693, -0.5182, -0.7082, -0.2513, 0.5971, -0.0448, -1.1931, 0.2547, 0.5547, 0.7275, 0.0790, 0.7290, -1.7580, 1.4076, 0.0707, -1.3745, -0.9425, -1.7886, 1.0114, 0.6533, -2.4790, 0.7734, -1.2740, 1.4678, 1.0326, 2.4520, -0.3818, 0.4637, 0.0647, 0.5835, -0.6451, 0.1827, 0.3267, 2.9147, 0.8831, 0.3677, 0.0840, 1.8727, -1.9208, 0.5406, -0.9817, 0.4599, 0.6025, -0.0785, 0.2673, 0.3753, -2.0838, -0.7829, 1.3637, 1.2702, 0.6830, -0.2844, 1.1863, -0.1296, -0.7212, 1.1061, 0.5191, -2.0950, -1.1772, 1.4060, -0.5879, -0.2722, 0.7108, -0.3690, 0.0525, 1.3578, -1.4684, 0.0200, -1.5456, 0.7970, -0.4809, -0.7506, -0.5057, -1.5580, 1.0935, -1.0784, -1.0562, -0.1146, -0.9110, 0.8766, -0.7964, -2.4560, 0.1778, 1.4359, 0.2717, -0.5767, 0.2234, 1.2251, 1.5370, -0.5174, 1.1125, 0.1106, 0.6372, 0.1512, 0.3230, 2.2387, -0.4424, -1.0800, 1.3210, -1.2190, -0.6978, 0.2300, 0.3607, 1.8892, 0.5572, 0.9886, 1.3938, 0.3778, 0.9841, -0.4031, -0.9848, 0.2440, -1.3726, -0.9412, 0.2147, -0.4574, 0.5361, 1.0282, 0.9216, 0.4758, 0.3440, 1.2460, -0.3306, -0.3788, 0.0800, 1.2618, 0.7217, -0.5614, 0.1019, 0.0530, -0.2299, 0.8542, -0.4069, 0.5273, 0.1136, -1.4586, 1.5515), ncol = 2) distancesEucl <- distances(raw_data) distancesMaha <- distances(raw_data, normalize = "mahalanobize") t_quickblock <- function(distances = distancesEucl, size_constraint = 2L, caliper = NULL, ...) { quickblock(distances = distances, size_constraint = size_constraint, caliper = caliper, ...) } t_sc_clustering <- function(distances = distancesEucl, size_constraint = 2L, seed_method = "inwards_updating", primary_data_points = NULL, primary_unassigned_method = "closest_seed", secondary_unassigned_method = "ignore", seed_radius = NULL, primary_radius = "seed_radius", secondary_radius = "estimated_radius", batch_size = 100L, break_large_blocks = FALSE) { out_blocking <- scclust::sc_clustering(distances = distances, size_constraint = size_constraint, type_labels = NULL, type_constraints = NULL, seed_method = seed_method, primary_data_points = primary_data_points, primary_unassigned_method = primary_unassigned_method, secondary_unassigned_method = secondary_unassigned_method, seed_radius = seed_radius, primary_radius = primary_radius, secondary_radius = secondary_radius, batch_size = batch_size) if (break_large_blocks) { out_blocking <- scclust::hierarchical_clustering(distances, size_constraint, TRUE, out_blocking) } class(out_blocking) <- c("qb_blocking", class(out_blocking)) out_blocking } test_that("`quickblock` returns correct output", { expect_identical(t_quickblock(), t_sc_clustering()) expect_identical(t_quickblock(break_large_blocks = TRUE), t_sc_clustering(break_large_blocks = TRUE)) expect_identical(t_quickblock(distances = distancesEucl), t_sc_clustering(distances = distancesEucl)) expect_identical(t_quickblock(distances = distancesMaha), t_sc_clustering(distances = distancesMaha)) expect_identical(t_quickblock(distances = raw_data), t_sc_clustering(distances = distancesEucl)) expect_identical(t_quickblock(distances = raw_data, normalize = "mahalanobize"), t_sc_clustering(distances = distancesMaha)) expect_identical(t_quickblock(size_constraint = 4L), t_sc_clustering(size_constraint = 4L)) expect_identical(t_quickblock(size_constraint = 4L, break_large_blocks = TRUE), t_sc_clustering(size_constraint = 4L, break_large_blocks = TRUE)) expect_identical(t_quickblock(seed_method = "exclusion_updating"), t_sc_clustering(seed_method = "exclusion_updating")) expect_identical(t_quickblock(break_large_blocks = TRUE, seed_method = "exclusion_updating"), t_sc_clustering(break_large_blocks = TRUE, seed_method = "exclusion_updating")) expect_identical(t_quickblock(distances = distancesEucl, seed_method = "exclusion_updating"), t_sc_clustering(distances = distancesEucl, seed_method = "exclusion_updating")) expect_identical(t_quickblock(distances = distancesMaha, seed_method = "exclusion_updating"), t_sc_clustering(distances = distancesMaha, seed_method = "exclusion_updating")) expect_identical(t_quickblock(distances = raw_data, seed_method = "exclusion_updating"), t_sc_clustering(distances = distancesEucl, seed_method = "exclusion_updating")) expect_identical(t_quickblock(distances = raw_data, normalize = "mahalanobize", seed_method = "exclusion_updating"), t_sc_clustering(distances = distancesMaha, seed_method = "exclusion_updating")) expect_identical(t_quickblock(size_constraint = 4L, seed_method = "exclusion_updating"), t_sc_clustering(size_constraint = 4L, seed_method = "exclusion_updating")) expect_identical(t_quickblock(size_constraint = 4L, break_large_blocks = TRUE, seed_method = "exclusion_updating"), t_sc_clustering(size_constraint = 4L, break_large_blocks = TRUE, seed_method = "exclusion_updating")) expect_identical(t_quickblock(caliper = 1.0), t_sc_clustering(seed_radius = 0.5)) expect_identical(t_quickblock(primary_unassigned_method = "ignore"), t_sc_clustering(primary_unassigned_method = "ignore")) expect_identical(t_quickblock(primary_radius = 0.5), t_sc_clustering(primary_radius = 0.5)) expect_warning(expect_identical(t_quickblock(seed_radius = 0.5, caliper = 2.0), t_sc_clustering(seed_radius = 0.5))) expect_identical(t_quickblock(caliper = 1.0, primary_unassigned_method = "ignore"), t_sc_clustering(seed_radius = 0.5, primary_unassigned_method = "ignore", secondary_radius = "seed_radius")) expect_warning(expect_identical(t_quickblock(caliper = 1.0, primary_unassigned_method = "closest_assigned"), t_sc_clustering(seed_radius = 0.25, primary_unassigned_method = "closest_assigned"))) expect_warning(expect_identical(t_quickblock(caliper = 1.0, primary_radius = "estimated_radius"), t_sc_clustering(seed_radius = 0.5, primary_radius = "estimated_radius", secondary_radius = "seed_radius"))) expect_identical(t_quickblock(primary_data_points = c(2, 3, 4, 5, 6, 8, 10, 13, 15, 16, 18, 20, 21, 22, 23, 25, 27, 29, 32, 33, 34, 35, 36, 38, 39, 40, 41, 42, 45, 46, 47, 49, 50, 56, 57, 58, 60, 63, 64, 65, 70, 71, 75, 76, 77, 80, 82, 83, 88, 89, 95, 98, 99, 105, 106, 109, 110, 114, 116, 118, 123, 125, 130, 132, 134, 135, 136, 137, 138, 139, 141, 142, 143, 144, 147, 149, 153, 154, 156, 158, 159, 161, 162, 163, 164, 165, 168, 169, 172, 175, 179, 180, 182, 183, 184, 186, 187, 188, 189, 191, 192, 198, 199, 202, 203, 204, 205, 208, 209, 210, 211, 216, 218, 219, 221, 222, 223, 224, 225, 226, 229, 230, 232, 234, 235, 236, 237, 239, 253, 255, 256, 258, 266, 271, 273, 274, 278, 279, 280, 282, 283, 284, 285, 296, 297, 299, 301, 305, 306, 307, 308, 310, 313, 314, 315, 316, 317, 318, 321, 322, 324, 325, 328, 332, 334, 335, 336, 339, 340, 344, 345, 349, 350, 351, 353, 355, 360, 362, 365, 366, 367, 371, 372, 374, 375, 376, 382, 383, 384, 389, 390, 393, 394, 395, 396, 397, 399, 401, 402, 404, 405, 407, 408, 412, 413, 414, 416, 417, 418, 419, 424, 425, 426, 431, 432, 434, 435, 436, 437, 439, 441, 442, 445, 447, 448, 449, 452, 453, 458, 459, 461, 464, 465, 469, 474, 475, 476, 477, 478, 481, 484, 486, 488, 489, 490, 491, 494, 497, 498, 500)), t_sc_clustering(primary_data_points = c(2, 3, 4, 5, 6, 8, 10, 13, 15, 16, 18, 20, 21, 22, 23, 25, 27, 29, 32, 33, 34, 35, 36, 38, 39, 40, 41, 42, 45, 46, 47, 49, 50, 56, 57, 58, 60, 63, 64, 65, 70, 71, 75, 76, 77, 80, 82, 83, 88, 89, 95, 98, 99, 105, 106, 109, 110, 114, 116, 118, 123, 125, 130, 132, 134, 135, 136, 137, 138, 139, 141, 142, 143, 144, 147, 149, 153, 154, 156, 158, 159, 161, 162, 163, 164, 165, 168, 169, 172, 175, 179, 180, 182, 183, 184, 186, 187, 188, 189, 191, 192, 198, 199, 202, 203, 204, 205, 208, 209, 210, 211, 216, 218, 219, 221, 222, 223, 224, 225, 226, 229, 230, 232, 234, 235, 236, 237, 239, 253, 255, 256, 258, 266, 271, 273, 274, 278, 279, 280, 282, 283, 284, 285, 296, 297, 299, 301, 305, 306, 307, 308, 310, 313, 314, 315, 316, 317, 318, 321, 322, 324, 325, 328, 332, 334, 335, 336, 339, 340, 344, 345, 349, 350, 351, 353, 355, 360, 362, 365, 366, 367, 371, 372, 374, 375, 376, 382, 383, 384, 389, 390, 393, 394, 395, 396, 397, 399, 401, 402, 404, 405, 407, 408, 412, 413, 414, 416, 417, 418, 419, 424, 425, 426, 431, 432, 434, 435, 436, 437, 439, 441, 442, 445, 447, 448, 449, 452, 453, 458, 459, 461, 464, 465, 469, 474, 475, 476, 477, 478, 481, 484, 486, 488, 489, 490, 491, 494, 497, 498, 500))) })