Chicago crime 2022 / pSum core

> library(Polychrome)
> library(magrittr)
> n1 <- nrow(MT$nodes$primary); n2 <- nrow(MT$nodes$location); n3 <- nrow(MT$nodes$ward)
> C1 <- 1:n1; C2 <- 1:n2; C3 <- 1:n3
> F12 <- sapply(1:n1,function(u) pSum(MT,u,C2,"primary","location",weight="w"))
> F21 <- sapply(1:n2,function(v) pSum(MT,v,C1,"location","primary",weight="w"))
> table(F12)
F12
    5     7    10    16    48   116   180   185   212   320   395   436   440   707   720  1171 
    2     1     1     1     1     1     1     1     1     1     1     1     1     1     1     1 
 1516  1880  4257  4285  7620  8883  9093 14470 15274 20977 22571 27820 41097 54891 
    1     1     1     1     1     1     1     1     1     1     1     1     1     1 
> table(F21)
F21
    1     2     3     4     5     6     7     9    12    14    15    16    17    19    20    21 
   14     5     2     3     3     1     2     3     1     2     1     1     1     2     2     2 
   22    24    25    27    32    35    43    49    50    52    53    54    74    75    83    84 
    1     1     2     1     2     1     1     1     1     1     1     2     1     1     1     1 
   86    92   100   102   105   113   118   125   135   137   138   145   147   155   156   180 
    1     1     1     2     1     1     1     1     1     1     1     1     1     1     1     1 
  183   188   206   221   224   232   242   244   246   312   319   334   349   356   393   442 
    1     1     1     1     1     1     2     1     1     1     1     1     1     1     1     1 
  451   510   548   598   637   656   677   740   741   784   896  1250  1253  1376  1386  1417 
    1     1     1     1     1     1     1     1     1     1     1     1     1     1     1     1 
 1509  1654  1822  1842  2291  2520  2802  3072  3118  3150  3460  3473  3531  4901  5115  7214 
    1     1     1     1     1     1     1     1     1     1     1     1     1     1     1     1 
 9561 12162 30048 45078 69290 
    1     1     1     1     1 
> PSum <- function(MN,u,C,way1,way2,...) pSum(MN,u,C,way1,way2,weight="w",...)
> cores <- Gen2modeCore(MT,"primary","location",PSum,PSum,2000,2500)
> Cprim <- cores$core1; Cloc <- cores$core2
> cores
$core1
 [1]  2  3  4  6  8  9 17 18 23 27 30 31
$core2
 [1]  17  19  47  62  72  90  95 103 104 105 107 116 117 120 132
> FCp <- sapply(Cprim,function(u) pSum(MT,u,Cloc,"primary","location",weight="w"))
> names(FCp) <- MT$nodes$primary$ID[Cprim]
> rev(sort(FCp))
              THEFT             BATTERY     CRIMINAL DAMAGE MOTOR VEHICLE THEFT 
              45480               34338               25165               21519 
            ASSAULT       OTHER OFFENSE  DECEPTIVE PRACTICE   WEAPONS VIOLATION 
              17407               13286               12513                8209 
            ROBBERY            BURGLARY           NARCOTICS   CRIMINAL TRESPASS 
               7882                6906                3684                3100 
> FCl <- sapply(Cloc,function(u) pSum(MT,u,Cprim,"location","primary",weight="w"))
> names(FCl) <- MT$nodes$location$ID[Cloc]
> rev(sort(FCl))
                                STREET                              APARTMENT 
                                 67731                                  43158 
                             RESIDENCE                               SIDEWALK 
                                 28274                                  11809 
PARKING LOT / GARAGE (NON RESIDENTIAL)                     SMALL RETAIL STORE 
                                  9454                                   7164 
                                 ALLEY                             RESTAURANT 
                                  4900                                   4832 
                      DEPARTMENT STORE                        OTHER (SPECIFY) 
                                  3438                                   3419 
          COMMERCIAL / BUSINESS OFFICE            RESIDENCE - PORCH / HALLWAY 
                                  3388                                   3079 
                VEHICLE NON-COMMERCIAL                            GAS STATION 
                                  3041                                   3036 
                    RESIDENCE - GARAGE 
                                  2766

> MT %>%
+   extract(c("primary","location"),c("Cprim","Cloc")) %>%
+   flatten("w",c("primary","location","ward")) -> 
+   MTcore
> str(MTcore)
> MTcore$ways <- list(primary="Primary crime",location="Crime location",ward="City ward")
> MTcore$nodes$primary <- as.data.frame(data.frame(ID=MTcore$nodes$primary))
> MTcore$nodes$location <- as.data.frame(data.frame(ID=MTcore$nodes$location))
> CC <- col2rgb(createPalette(50,c("#ff0000","#00ff00","#0000ff")))/255
> LC <- MTcore$links
> Col <- cbind(CC[1,LC$ward],CC[2,LC$ward],CC[3,LC$ward])
> mwnX3D(MTcore,"primary","location","ward","w",lz="long",maxsize=0.85,col=Col,file="ChicagoCore1.x3d")
> Cou <- projection(MTcore,"primary","w")
> Sau <- salton(Cou); Du <- as.dist(1-Sau); Du[is.na(Du)] <- 1
> tu <- hclust(Du,method="ward")
> plot(tu,hang=-1,cex=1,main="Chicago crime core - primary / Ward")
> Cov <- projection(MTcore,"location","w")
> Sav <- salton(Cov); Dv <- as.dist(1-Sav); Dv[is.na(Dv)] <- 1
> tv <- hclust(Dv,method="ward")
> plot(tv,hang=-1,cex=1,main="Chicago crime core - location / Ward")
> Coz <- projection(MTcore,"ward","w")
> Saz <- salton(Coz); Dz <- as.dist(1-Saz); Dz[is.na(Dz)] <- 1
> tz <- hclust(Dz,method="ward")
> plot(tz,hang=-1,cex=0.6,main="Chicago crime core - ward / Ward")
> I <- inv(tu$order); J <- inv(tv$order); K <- inv(tz$order) 
> mwnX3D(MTcore,"primary","location","ward","w",pu=I,pv=J,pz=K,lz="long",maxsize=0.95,col=Col,file="ChicagoCoreClus.x3d")

Chicago crime sum core This is a 3D layout using X3DOM.
Use the mouse to navigate the space - rotate, zoom in/out, ...

Click a link (cube) for its identification (primary crime, location, ward)!

> (St <- sum(MT$links$w))
[1] 239607
> (Sc <- sum(MTcore$links$w))
[1] 199489
> Sc/St
[1] 0.8325675
> nrow(MTcore$links)
[1] 6934
> nrow(MT$links)
[1] 18598
> (nrow(MTcore$links)/nrow(MT$links))
[1] 0.3728358
> NC <- MTcore$nodes; NT <- MT$nodes
> nrow(NC$primary)
[1] 12
> nrow(NC$location)
[1] 15
> nrow(NC$ward)
[1] 50
> nrow(NT$primary)
[1] 31
> nrow(NT$location)
[1] 135
> nrow(NT$ward)
[1] 50
> (nrow(NC$primary)*nrow(NC$location)*nrow(NC$ward))/(nrow(NT$primary)*nrow(NT$location)*nrow(NT$ward))
[1] 0.04301075