tests/testthat/test-term-hamming.R

In statnet/ergm: Fit, Simulate and Diagnose Exponential-Family Models for Networks

#  File tests/testthat/test-term-hamming.R in package ergm, part of the
#  Statnet suite of packages for network analysis, https://statnet.org .
#
#  This software is distributed under the GPL-3 license.  It is free,
#  open source, and has the attribution requirements (GPL Section 7) at
#  https://statnet.org/attribution .
#
#  Copyright 2003-2023 Statnet Commons
################################################################################


# Create test bipartite network (from SMG)
gmat <- cbind(
c(1, 1, 11, 13, 13, 16, 17, 18, 21, 21, 22, 24, 25, 26, 26, 28, 28,
29, 31, 31, 32, 33, 34, 34, 36, 36, 36, 37, 37, 40, 40, 42, 42, 43,
43, 43, 44, 45, 46, 48, 51, 51, 54, 55, 57, 57, 60, 61, 64, 64, 66,
68, 70, 71, 72, 73, 75, 76, 82, 86, 86, 89, 91, 92, 92, 93, 93, 93,
94, 95, 95, 97, 97, 98, 101, 106, 107, 108, 110, 111, 113, 114, 114,
118, 122, 122, 124, 124, 126, 126, 128, 132, 135, 135, 143, 145, 147,
147, 149, 150, 153, 158, 160, 162, 163, 164, 164, 166, 166, 168, 168,
172, 172, 173, 176, 176, 178, 180, 181, 182, 183, 183, 184, 186, 192,
195, 196, 196, 198, 199, 202, 203, 203, 204, 204, 207, 209, 214, 217,
218, 219, 220, 221, 226, 226, 228, 230, 232, 232, 232, 234, 234, 235,
236, 239, 241, 242, 244, 245, 247, 263, 263, 264, 268, 269, 269, 270,
271, 274, 274, 276, 276, 276, 280, 282, 283, 285, 289, 290, 291, 293,
295, 299, 301, 301, 302, 304, 305, 306, 306, 306, 312, 313, 315, 315,
318, 318, 321, 322, 322, 322, 322, 323, 327, 332, 335, 338, 338, 339,
339, 340, 340, 340, 340, 342, 349, 354, 354, 357, 358, 359, 360, 362,
362, 363, 364, 365, 370, 371, 372, 372, 373, 374, 377, 380, 388, 391,
391, 393, 394, 394, 395, 397, 397, 400, 401, 401, 402, 403, 404, 405,
409, 411, 412, 415, 419, 419, 419, 420, 420, 422, 422, 427, 427, 430,
434, 435, 436, 436, 437, 446, 447, 447, 449, 450, 457, 459, 459, 461,
462, 462, 464, 464, 465, 465, 466, 467, 468, 470, 470, 470, 472, 472,
472, 475, 477, 479, 481, 483, 487, 490, 490, 495, 497, 497, 498, 498,
498, 499, 501, 505, 508, 509, 509, 510, 512, 513, 513, 515, 516, 517,
520, 521, 523, 526, 528, 532, 539, 540, 541, 542, 543, 544, 544, 545,
547, 549, 549, 551, 558, 558, 560, 565, 573, 573, 574, 574, 577, 578,
579, 580, 580, 582, 582, 583, 584, 587, 587, 588, 592, 595, 595, 596,
596, 599, 601, 601, 601, 604, 606, 607, 608, 610, 614, 617, 617, 617,
618, 620, 623, 624, 628, 632, 633, 634, 634, 634, 635, 638, 640, 640,
642, 643, 644, 647, 651, 651, 652, 652, 652, 653, 655, 655, 655, 660,
661, 662, 662, 663, 665, 667, 669, 676, 677, 678, 679, 679, 679, 680,
681, 681, 684, 688, 691, 692, 698, 701, 705, 709, 710, 714, 716, 716,
717, 717, 720, 724, 727, 729, 729, 730, 732, 732, 733, 737, 738, 739,
740, 741, 741, 743, 746, 746, 747, 748, 755, 761, 764, 765, 766, 767,
767, 767, 768, 770, 771, 773, 774, 775, 776, 777, 778, 782, 782, 784,
785, 786, 786, 789, 789, 790, 794, 796, 800, 800, 801, 801, 802, 802,
804, 806, 806, 810, 811, 811, 812, 815, 817, 818, 820, 820, 824, 826,
828, 828, 828, 828, 829, 831, 833, 835, 837, 839, 840, 843, 844, 845,
846, 847, 848, 848, 850, 850, 852, 854, 854, 855, 855, 857, 858, 863,
866, 867, 869, 870, 873, 874, 875, 876, 876, 877, 878, 879, 881, 883,
883, 883, 884, 884, 885, 885, 887, 891, 894, 896, 896, 896, 896, 897,
897, 900, 902, 903, 905, 906, 911, 921, 922, 925, 927, 929, 930, 931,
933, 935, 936, 936, 938, 938, 939, 943, 944, 945, 946, 947, 947, 948,
949, 955, 955, 956, 956, 957, 960, 961, 963, 964, 967, 967, 967, 972,
973, 974, 976, 976, 978, 979, 983, 984, 985, 987, 988, 988, 989, 990,
991, 994, 994, 998, 999, 1001, 1003, 1004, 1006, 1006),
c(1607, 1674, 1839, 1179, 1198, 1705, 1610, 1803, 1385, 1555, 1884, 1681,
1141, 1075, 1093, 1024, 1613, 1514, 1072, 1099, 1367, 1737, 1102, 1616,
1043, 1127, 1772, 1742, 1839, 1014, 1323, 1209, 1610, 1010, 1180, 1709,
1692, 1423, 1783, 1637, 1183, 1284, 1427, 1953, 1616, 1902, 1695, 1157,
1975, 1986, 1811, 1029, 1815, 1893, 1264, 1473, 1998, 1633, 1014, 1206,
1760, 1024, 1544, 1222, 1328, 1194, 1247, 1861, 1263, 1406, 1479, 1565,
1730, 1142, 1647, 1162, 1280, 1635, 1339, 1581, 1431, 1016, 1109, 1926,
1012, 1778, 1587, 1895, 1099, 1442, 1815, 1848, 1499, 1759, 1689, 1192,
1220, 1703, 1413, 1451, 1532, 1999, 1790, 1452, 1322, 1077, 1325, 1431,
1798, 1114, 1896, 1292, 1296, 1704, 1876, 1887, 1155, 1362, 1837, 1637,
1652, 1935, 1680, 1071, 1519, 1122, 1066, 1812, 1204, 1555, 1739, 1112,
1164, 1217, 1937, 1283, 1472, 1170, 1324, 1928, 1521, 1134, 1721, 1068,
1659, 1640, 1912, 1567, 1648, 1985, 1527, 1718, 1414, 1424, 1224, 1462,
1621, 1516, 1680, 1334, 1480, 1794, 1213, 1042, 1429, 1611, 1330, 1905,
1236, 1765, 1094, 1582, 1709, 1606, 1653, 1435, 1683, 1697, 1262, 1266,
1606, 1226, 1017, 1139, 1916, 1599, 1296, 1064, 1433, 1844, 1902, 1257,
1812, 1050, 1325, 1029, 1688, 1841, 1124, 1278, 1825, 1917, 1832, 1647,
1493, 1157, 1080, 1280, 1315, 1903, 1767, 1900, 1945, 1965, 1548, 1450,
1779, 1880, 1989, 1594, 1946, 1641, 1737, 1762, 1390, 1498, 1035, 1120,
1058, 1079, 1287, 1940, 1419, 1357, 1930, 1669, 1252, 1263, 1538, 1086,
1766, 1911, 1609, 1873, 1713, 1826, 1907, 1103, 1355, 1400, 1509, 1641,
1619, 1372, 1865, 1084, 1427, 1849, 1144, 1572, 1471, 1733, 1126, 1529,
1694, 1321, 1211, 1659, 1787, 1247, 1409, 1162, 1959, 1309, 1428, 1614,
1402, 1572, 1944, 1187, 1587, 1095, 1422, 1465, 1815, 1065, 1593, 1559,
1612, 1645, 1833, 1047, 1351, 1622, 1754, 1267, 1998, 1222, 1997, 1377,
1144, 1514, 1097, 1652, 1826, 1015, 1091, 1775, 1086, 1425, 1775, 1395,
1375, 1708, 1513, 1439, 1795, 1808, 1725, 1229, 1658, 1660, 1930, 1876,
1236, 1801, 1749, 1299, 1127, 1285, 1573, 1521, 1169, 1391, 1626, 1060,
1576, 1762, 1546, 1049, 1408, 1906, 1013, 1125, 1372, 1692, 1902, 1417,
1021, 1539, 1145, 1635, 1037, 1237, 1691, 1262, 1168, 1776, 1193, 1529,
1508, 1603, 1679, 1987, 1409, 1071, 1144, 1434, 1377, 1235, 1095, 1710,
1956, 1481, 1422, 1584, 1803, 1027, 1624, 1514, 1241, 1985, 1654, 1999,
1221, 1367, 1535, 1641, 1615, 1614, 1944, 1355, 1903, 1881, 1328, 1357,
1904, 1205, 1454, 1908, 1415, 1262, 1450, 1799, 1178, 1325, 1414, 1694,
1039, 1264, 1094, 1962, 1458, 1450, 1518, 1033, 1342, 1824, 1273, 1702,
1917, 1959, 1141, 1111, 1148, 1958, 1411, 1726, 1629, 1487, 1216, 1585,
1763, 1083, 1469, 1643, 1288, 1769, 1191, 1386, 1627, 1541, 1738, 1074,
1377, 1860, 1681, 1464, 1088, 1927, 1671, 1593, 1968, 1487, 1829, 1374,
1818, 1008, 1395, 1539, 1381, 1813, 1889, 1390, 1248, 1706, 1843, 1340,
1163, 1934, 1567, 1986, 1289, 1958, 1865, 1531, 1114, 1457, 1688, 1954,
1760, 1753, 1894, 1800, 1882, 1491, 1984, 1094, 1938, 1233, 1419, 1730,
1930, 1278, 1666, 1958, 1445, 1254, 1043, 1605, 1753, 1151, 1085, 1664,
1817, 1969, 1982, 1049, 1673, 1303, 1685, 1389, 1250, 1128, 1319, 1924,
1260, 1706, 1548, 1506, 1753, 1138, 1538, 1145, 1257, 1918, 1511, 1682,
1161, 1623, 1318, 1988, 1417, 1030, 1096, 1601, 1118, 1395, 1919, 1993,
1278, 1871, 1889, 1794, 1128, 1256, 1383, 1540, 1954, 1594, 1651, 1968,
1774, 1167, 1174, 1211, 1878, 1956, 1018, 1842, 1771, 1579, 1165, 1909,
1669, 1279, 1994, 1911, 1485, 1544, 1091, 1205, 1841, 1204, 1448, 1293,
1613, 1390, 1675, 1438, 1857, 1589, 1787, 1784, 1135, 1323, 1082, 1283,
1803, 1928, 1085, 1158, 1570, 1169, 1158, 1642, 1634, 1497, 1513, 1635,
1325, 1522, 1833, 1519, 1792, 1569, 1348, 1956, 1261, 1070, 1296, 1092,
1434, 1369, 1213, 1977, 1033, 1729, 1838, 1047, 1258, 1090, 1146, 1198,
1810))

attr(gmat, "n") <- 2000
g <- network(gmat, directed=F, bipartite=1006)

test_that("hamming", {
  en <- matrix(0, 1006, 994)
  en[1,2:5] <- 1
  en <- as.network(en,bipartite=T)
  expect_equal(summary(g~hamming(en)), 629, ignore_attr=TRUE)
  expect_equal(summary(en~hamming(g)), 629, ignore_attr=TRUE)

  bn <- matrix(0, 1006, 994)
  bn <- as.network(bn,bipartite=T)
  expect_equal(summary(g~hamming(bn)), 625, ignore_attr=TRUE)
  expect_equal(summary(bn~hamming(g)), 625, ignore_attr=TRUE)

  sn <- matrix(0, 1006, 994)
  sn[1,2] <- 1
  sn <- as.network(sn,bipartite=T)
  expect_equal(summary(g~hamming(sn)), 626, ignore_attr=TRUE)
  expect_equal(summary(sn~hamming(g)), 626, ignore_attr=TRUE)

  sn %e% "weight3" <- 3

  expect_equal(summary(g~hamming(en,cov=sn)), 1, ignore_attr=TRUE)
  expect_equal(summary(sn~hamming(g,cov=g)), 625, ignore_attr=TRUE)
  expect_equal(summary(sn~hamming(g,cov=sn)), 1, ignore_attr=TRUE)
  expect_equal(summary(sn~hamming(g,cov=en)), 1, ignore_attr=TRUE)

  expect_equal(summary(g~hamming(en,cov=sn,attrname="weight3")), 3, ignore_attr=TRUE)
  expect_equal(summary(g~hamming(en,sn,"weight3")), 3, ignore_attr=TRUE)

  net1 <- matrix(0,5,5)
  net2 <- matrix(0,5,5)
  net1[1,2] <- 1
  net1[2,3] <- 1
  net1[1,3] <- 1
  net1[1,5] <- 1
  net2[1,2] <- 1
  net2[2,3] <- 1
  net2[1,3] <- 1
  net2[2,5] <- 1
  net1 <- network(net1, directed=T)
  net2 <- network(net2, directed=T)
  expect_equal(summary(net1~hamming(net2)), 2, ignore_attr=TRUE)
})