Unsuccesful or partly successful attempts removed from a post on cartograms and EU elections in Italy

cartograms_italy_leftovers.Rmd

```{r eval = FALSE}


partito_facet_tm <- carto_partiti_combo %>% 
  tm_shape()  + 
  tm_polygons(col = "perc",
              palette = "YlGnBu") +
  tm_facets(by = "tipo", nrow = 2, free.coords = FALSE) +
  tm_layout(main.title = "Italy's regions sized according to distribution of votes to...",
            main.title.position = "center", 
            fontfamily = "Roboto Condensed",
            panel.show = FALSE,
            panel.label.bg.color = "white",
            legend.show = FALSE,
            legend.position = c("center", "bottom"),
            legend.stack = "horizontal",
            frame = FALSE,
            inner.margins = c(0,0,0.15,0),
            legend.outside = TRUE) +
  tm_credits(text = levels(carto_partiti_combo$tipo),
             position = c("center", "top"), size = 1) 

partito_facet_tm
```

```{r eval = FALSE, fig.height=2}
carto_partiti_combo %>% 
  rename(`Share of votes (percent)` = perc) %>% 
  tm_shape()  + 
  tm_polygons(col = "Share of votes (percent)",
              palette = "YlGnBu") +
  tm_layout(panel.show = FALSE,
            panel.label.bg.color = "white",
            legend.only = TRUE,
            legend.position = c("center", "top"),
            legend.title.size = 2,
            legend.text.fontfamily = "Roboto Condensed",
            legend.text.size = 1.2,
            legend.title.fontfamily = "Roboto Condensed",
            frame = FALSE) 
```


```{r eval = FALSE}
colour_reference <- tibble(perc_cut = factor(x = levels(carto_combo$perc_cut), levels =  levels(carto_combo$perc_cut), labels = c("[0%-10%)", "[10%-20%)", "[20%-30%)", "[30%-40%)",  "[40%-50%]"), ordered = TRUE),
                   colour = RColorBrewer::brewer.pal(n = 5, name = "Purples"))


carto_combo_nogeo <- carto_combo %>% 
  left_join(y = colour_reference, by = "perc_cut") %>% 
  select(desc_lis, desc_reg, colour)

carto_combo_nogeo$geometry <- NULL

morph_nogeo <- 
tween_state(.data = carto_combo_nogeo %>% filter(desc_lis=="LEGA SALVINI PREMIER"),
                  to = carto_combo_nogeo %>% filter(desc_lis=="MOVIMENTO 5 STELLE"),
                  ease = 'cubic-in-out',
                  nframes = 100)  %>% 
  keep_state(30) %>% select(colour, .frame)

#morph_nogeo %>% filter(.frame == 50)
  
```




```{r eval = FALSE}
 
carto_lega_base <- cartogram_cont(sf::st_sf(scrutini_regione_geo_original %>% 
                                         filter(desc_lis == "LEGA SALVINI PREMIER")) %>%
                               select(voti, perc),
                             "voti",
                             itermax=7)

carto_5stelle_base <- cartogram_cont(sf::st_sf(scrutini_regione_geo_original %>% 
                                         filter(desc_lis == "MOVIMENTO 5 STELLE")) %>%
                               select(voti, perc),
                             "voti",
                             itermax=7)

morph <- tween_sf(.data = carto_lega_base,
                  to = carto_5stelle_base,
                  ease = 'cubic-in-out',
                  nframes = 100)  %>% 
  keep_state(30)



combo_animated_continuous <- morph %>%
  ggplot(mapping = aes(fill = perc/100)) +
  geom_sf() +
  coord_sf(datum = NULL) + 
  scale_fill_distiller(type = "seq",
                       palette = "YlGnBu",
                       direction = 1,
                       labels = scales::percent) +
  theme_void() +
  theme(legend.title=element_blank()) +
  transition_manual(frames = .frame) +
  labs(title = "Italy shaped as... {if_else(condition = as.numeric(current_frame)<66, 'Lega Salvini Premier', 'Movimento 5 stelle', missing = '')}'s voters") 

combo_animated_continuous

```


```{r carto_proportional, eval=FALSE}

# these are attempts at having all of Italy resized, by attributing all votes not 
# given to a party to a distant geographic entity
# it doesn't seem to get what it was supposed to

#pol <- st_sfc(st_polygon(list(cbind(c(0,30,3,20,0),c(0,32,5,25,0)))))


complement_place <- function(scrutini, lista, tipo = "perc") {
  
  # random distant geometry
  
   Moldova <- spData::world %>% filter(name_long == "Moldova") %>% st_transform(32632)
  
   st_crs(Moldova) <- "+proj=utm +zone=32 +datum=WGS84 +units=m +no_defs"
   
   perc_rest <- scrutini %>% filter(desc_lis!=lista) %>% pull(perc) %>% sum()
   voti_rest <- scrutini %>% filter(desc_lis!=lista) %>% pull(voti) %>% sum()
   
  
  rest_sf <- st_sf(tibble(desc_lis = lista,
                          desc_reg = "out",
                          voti = voti_rest,
                          perc = perc_rest,
                          geometry = Moldova$geom))
  
  base_with_rest <- rbind(
    scrutini %>% filter(desc_lis==lista) %>% select(desc_lis, desc_reg, voti, perc, geometry),
    rest_sf
  )
  
  base_with_rest_prop <- base_with_rest %>% 
    mutate(area = as.numeric(st_area(geometry))) %>% 
    mutate(voti_prop = voti*area, perc_prop = perc*area)
  
  
  carto_with_rest_prop <- cartogram_cont(base_with_rest_prop,
                                    weight = tipo,
                                    itermax = 25)
  
   
  carto_with_rest_prop
}


carto_combo_prop <- 
rbind(complement_place(scrutini = scrutini, lista = "LEGA SALVINI PREMIER"),
      complement_place(scrutini = scrutini, lista = "PARTITO DEMOCRATICO"),
      complement_place(scrutini = scrutini, lista = "MOVIMENTO 5 STELLE"),
      complement_place(scrutini = scrutini, lista = "FORZA ITALIA"),
      complement_place(scrutini = scrutini, lista = "LA SINISTRA"))

 
carto_combo_prop %>% 
  tm_shape()  + 
  tm_polygons() +
  tm_facets(by = "desc_lis", nrow = 2, free.coords = FALSE, sync = FALSE) +
  tm_layout(main.title = "Italy sized according to...",
            main.title.position = "center", 
            fontfamily = "Roboto Condensed",
            panel.show = FALSE,
            panel.label.bg.color = "white",
            frame = FALSE) 

  


```

```{r eval = FALSE}
  
  carto_combo_prop %>% 
    filter(desc_reg!="out") %>% 
    ggplot() +
    geom_sf() + 
    facet_grid(. ~ desc_lis)
```



```{r eval = FALSE}
carto_combo_prop %>% 
  filter(desc_lis == "LA SINISTRA", desc_reg!="out") %>% 
  ggplot() +
  geom_sf()
```



```{r eval = FALSE}

  res <- matrix(c(48, 12,
          48, 11,
           47.5, 11,
           47.5, 13,
          48, 12)  ## need to close the polygon
         , ncol =2, byrow = TRUE
  )
  ## create polygon objects
pol <- st_sfc(st_polygon(list(res)))




 pol <- st_sfc(st_polygon(list(cbind(c(48, 11, 47, 48),c(48, 12, 48, 48)))))

```



```{r eval=FALSE}



out_lega <- st_sf(tibble(voti = 10000000, perc = (100*length(carto_lega_base$perc)-sum(carto_lega_base$perc)), geometry = pol)) 

st_crs(out_lega) <- "+proj=utm +zone=32 +datum=WGS84 +units=m +no_defs"

lega_out <- rbind(carto_lega_base,
                  out_lega
)

out_5stelle <- st_sf(tibble(voti = 10000000, perc = (100*length(carto_5stelle_base$perc)-sum(carto_5stelle_base$perc)), geometry = pol)) 
st_crs(out_5stelle) <- "+proj=utm +zone=32 +datum=WGS84 +units=m +no_defs"

mov5stelle_out <- lega_out <- rbind(carto_5stelle_base,
                  out_5stelle
)

combo_out <- 
rbind(lega_out %>% mutate(tipo = "Lega"),
      mov5stelle_out%>% mutate(tipo = "5 stelle"))

combo_out %>% 
  tm_shape()  + 
  tm_polygons(col = "perc",
              palette = "YlGnBu") +
  tm_facets(by = "tipo", nrow = 2, free.coords = FALSE) +
  tm_layout(main.title = "Italy sized according to...",
            main.title.position = "center", 
            fontfamily = "Roboto Condensed",
            panel.show = FALSE,
            panel.label.bg.color = "white",
            legend.show = FALSE,
            legend.position = c("center", "bottom"),
            legend.stack = "horizontal",
            frame = FALSE,
            inner.margins = c(0,0,0.15,0),
            legend.outside = TRUE) +
  tm_credits(text = levels(combo_out$tipo),
             position = c("center", "top"), size = 1) 
```



```{r eval=FALSE}
crop_bbox <- c(xmin = 50, ymin = 30, xmax = 55, ymax = 40)

sf::st_as_sf(crop_bbox)
```



```{r combo_animated_nuanced, eval = FALSE}
combo_animated_nuanced <- morph %>%
  left_join(morph_nogeo, by = ".frame") %>% 
 # filter(.frame==50) %>% 
  ggplot(mapping = aes(fill = colour)) +
  geom_sf() +
  coord_sf(datum = NULL) + 
  theme_void() +
  theme(legend.title=element_blank()) +
  transition_manual(frames = .frame) +
  labs(title = "Italy shaped as {if_else(current_frame<1300, 'Lega', '5 stelle')}'s voters") +
  guides(fill=FALSE)


combo_animated_nuanced
```


```{r message=FALSE, eval = FALSE}



animated <- rbind(carto_lega, carto_5stelle) %>% 
  tm_shape()  + 
  tm_polygons("perc",
              palette = viridisLite::viridis(20, begin = 0.5, end = 1, direction = -1),
              style = "quantile") +
  tm_facets(along = "desc_lis", free.coords = FALSE)
  tm_layout(frame = FALSE)
  
  tmap_animation(tm = animated,filename = "lega_5_stelle.gif",
                 width = 640,
                 height = 640,
                 delay = 25)
```



```{r eval = FALSE}
animated_tweened <- morph %>% 
  tm_shape()  + 
  tm_polygons("perc",
              palette = viridisLite::viridis(20, begin = 0.5, end = 1, direction = -1),
              style = "quantile") +
  tm_facets(along = "desc_lis", free.coords = FALSE)
  tm_layout(frame = FALSE)
  
  tmap_animation(tm = animated,filename = "lega_5_stelle_tweened.gif",
                 width = 640,
                 height = 640,
                 delay = 25)
```


```{r eval = FALSE}

carto_lega <- cartogram_cont(sf::st_sf(scrutini_regione_geo %>% 
                                         filter(desc_lis == "LEGA SALVINI PREMIER")) %>%
                               select(voti, perc),
                             "voti",
                             itermax=7)

plot(carto_lega)


# carto_lega_perc <- cartogram_cont(sf::st_sf(scrutini_regione_geo %>% 
#                                          filter(desc_lis == "LEGA SALVINI PREMIER")) %>%
#                                select(perc),
#                              "perc",
#                              itermax=7)
# 
# plot(carto_lega_perc)


carto_tutti <- cartogram_cont(sf::st_sf(scrutini_regione_geo) %>%
                               select(voti, desc_lis),
                             "voti",
                             itermax=7)

plot(carto_tutti)

top_6 <- scrutini_regione_geo %>% 
  group_by(desc_lis) %>% 
  tally(voti, sort = TRUE) %>% 
  pull(desc_lis) %>% 
  head(6)



carto_tutti <- cartogram_cont(sf::st_sf(scrutini_regione_geo %>% 
                                          filter(is.element(el = desc_lis, set = top_6))) %>%
                                select(voti, desc_lis),
                              "voti",
                              itermax=7)

plot(carto_tutti)


tm_shape(carto_5stelle)  + 
  tm_polygons("perc_cut",
              palette = "YlGnBu",
              style = "quantile") +
  tm_layout(frame = FALSE)

#tmaptools::palette_explorer()




ggsave(filename = "carto_lega.png", plot = carto_lega)
```