2019-04-climate-change | R code underlying the maps and chart in the Apr | Data Visualization library

my_data$order = c(1, 5, 2, 3, 4)

ggplot(my_data[order(my_data$order),], aes(x = x_cor, y = y_cor)) +
  geom_path() +
  geom_point(size = 2)

ggplot(my_data[order(my_data$order),], aes(x = x_cor, y = y_cor)) +
  geom_polygon(fill = NA, color = "black") +
  geom_point(size = 2)

library(visNetwork)
library(tidyverse)
library(igraph)
library(manipulateWidget)
library(htmltools)

create_trip_graph <-
  function(x, distance = NULL) {
    n <- 15
    data <- tibble(d = 1:n,
                   name =
                     c(
                       "new york",
                       "chicago",
                       "los angeles",
                       "orlando",
                       "houston",
                       "seattle",
                       "washington",
                       "baltimore",
                       "atlanta",
                       "las vegas",
                       "oakland",
                       "phoenix",
                       "kansas",
                       "miami",
                       "newark"
                     ))
    
    relations <-  tibble(from = sample(data$d),
                         to = lead(from, default = from[1]))    
    graph <-
      graph_from_data_frame(relations, directed = TRUE, vertices = data)
    
    V(graph)$color <-
      ifelse(data$d == relations$from[1], "red", "orange")
    
    if (is.null(distance))
      # This generates a random distance value if none is 
      # specified in the function call. Values are just for 
      # demonstration, no actual distances are calculated.
      distance <- sample(seq(19, 25, .1), 1)
    
    toVisNetworkData(graph) %>%
      c(., list(
        main = paste0("Trip ", x, " : "),
        submain = paste0(distance, "KM")
      )) %>%
      do.call(visNetwork, .) %>%
      visIgraphLayout(layout = "layout_in_circle") %>%
      visInteraction(navigationButtons = TRUE) %>%
      visEdges(arrows = 'to')
  }

comb_vgraphs <- lapply(1:25, function (x) list(
  create_trip_graph(x),
  htmltools::a("NEXT TRIP", 
               onclick = 'window.scrollBy(0,950)', 
               style = 'color:blue; text-decoration:underline;')))  %>%
  unlist(recursive = FALSE)


ff <-
  combineWidgets(
    list = comb_vgraphs,
    ncol = 1,
    height = 25 * 950,
    rowsize = c(24, 1)
  )

htmltools::save_html(html = ff, file = "widgets.html")

comb_vgraphs2 <- lapply(1:25, function(x) {
  a <- list(create_trip_graph(x))
  # We detect whenever we are creating the 5th, 10th, 15th etc. network map
  # and add the link after that one.
  if (x %% 5 == 0 & x < 25) a[[2]] <- htmltools::a("NEXT 5 TRIPS", 
                                          onclick = 'window.scrollBy(0,500)', 
                                          style = 'color:blue; text-decoration:underline;')
  a
}) %>%
  unlist(recursive = FALSE)

ff2 <-
  combineWidgets(
    list = comb_vgraphs2,
    ncol = 6, # We need six columns, 5 for the network maps 
              # and 1 for the link to scroll the page.
    height = 6 * 500,
    width = 1700
    #rowsize = c(24, 1)
  )

# We need to add some white space in for the scrolling by clicking the link to 
# still work for the last row.
ff2$widgets[[length(ff2$widgets) + 1]] <- htmltools::div(style = "height: 1000px;")

htmltools::save_html(html = ff2, file = "widgets2.html")

plot_ly(x = input_1, y = input_2, z = z,
        contours = list(
          z = list(show = TRUE, start = round(min(z),-2),
                                end = round(max(z),-2), 
                                size = 100))) %>% 
        add_surface()

plot_ly(x = input_1, y = input_2, z = z,
        colors = 'Oranges',
        contours = list(
          z = list(show = TRUE))) %>% 
  add_surface()

const arc = d3.arc()
    .innerRadius(50)
    .outerRadius(70);
const arc_corner = d3.arc()
    .innerRadius(50)
    .outerRadius(70)
    .cornerRadius(10);

const svg = d3.select("svg"),
    width = +svg.attr("width"),
    height = +svg.attr("height"),
    g = svg.append("g").attr("transform", "translate(" + width / 2 + "," + height / 2 + ")");

const clipPath = g.append("clipPath")
  .attr("id", "clip_corners");

const c = d3.scaleQuantile()
  .range(["#f7fcf0","#e0f3db","#ccebc5","#a8ddb5","#7bccc4","#4eb3d3","#2b8cbe","#08589e"]);

const pie = d3.pie().value(d => d);

function render(values) {
  c.domain(values);
  const arcs = pie(values);
  const corners = pie(values).map(d => {
    d.startAngle = d.endAngle - 0.2;
    d.endAngle = d.endAngle + 0.2;
    return d;
  });
  const clip = pie(values).map(d => {
    d.startAngle = d.endAngle - 0.01;
    d.endAngle = d.endAngle + 0.2;
    return d;
  });

  g.selectAll(".arc")
      .data(arcs)
      .join("path")
        .attr("class", "arc")
        .style("fill", d => c(d.value))
        .attr("d", arc);

  clipPath.selectAll("path")
    .data(clip)
    .join("path")
      .attr("d", arc);

  g.selectAll(".corner")
    .data(corners)
    .join("path")
      .raise()
      .attr("class", "corner")
      .attr("clip-path", "url(#clip_corner)")
      .style("fill", d => c(d.value))
      .attr("d", arc_corner)
      .sort((a, b) => b.index - a.index);
}

function randomData() {
  const num = Math.ceil(8 * Math.random()) + 2;
  const values = Array(num).fill(0).map(d => Math.random());
  render(values);
}

d3.select("#random_data")
  .on("click", randomData);

 randomData();

Random data

library(dplyr)
library(visNetwork)

set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))

relations = data.frame(tibble(
  from = sample(data$d),
  to = lead(from, default=from[1]),
))

data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )

graph = graph_from_data_frame(relations, directed=T, vertices = data) 

V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")

toVisNetworkData(graph) %>%
  c(., list(main = "my title", submain = "subtitle")) %>%
  do.call(visNetwork, .) %>%
  visIgraphLayout(layout = "layout_in_circle") %>% 
  visEdges(arrows = 'to') 

let data = [{
  id: 1,
  v: 10,
  c: 'red'
}, {
  id: 2,
  v: 30,
  c: 'blue'
}, {
  id: 3,
  v: 60,
  c: 'green'
}]

let nDrawCall = 0

function redraw() {
  nDrawCall++
  d3.select('#svg2')
    .selectAll('circle')
    .data(data, d => d.id)
    .join(enter => enter
      .append('circle')
      .on('click', function() {
        const circle = d3.select(this).raise();
        data.push(data.splice(data.indexOf(circle.datum()), 1)[0]);
      })
    )
    .attr('cx', d => d.v * nDrawCall)
    .attr('cy', d => d.v)
    .attr('r', d => d.v)
    .attr('fill', d => d.c)
}

function reset() {
  nDrawCall = 0
  redraw()
}

redraw()

svg {
  height: 100px;
  width: 100%;
}

  
  
  
  
    
      Redraw
    
    
      Reset
    
    
      
    
  

library(ggplot2)

df <- data.frame(y = sin(seq(0, pi, length.out = 100)),
                 x = seq(0, pi, length.out = 100))

p <- ggplot(df, aes(x, y)) + 
  geom_line() + 
  coord_equal() +
  theme_bw()

p

label <- "PIRATES VS NINJAS"

label <- strsplit(label, "")[[1]]

next_x_along_sine <- function(x, d)
{
  y <- sin(x)
  uniroot(f = \(b) b^2 + (sin(x + b) - y)^2 - d^2, c(0, 2*pi))$root + x
}
  
x_along_sine <- function(x1, d, n)
{
  while(length(x1) < n) x1 <- c(x1, next_x_along_sine(x1[length(x1)], d))
  x1
}

df2 <- as.data.frame(approx(df$x, df$y,  x_along_sine(1, 1/13, length(label))))
df2$label <- label
df2$angle <- atan(cos(df2$x)) * 180/pi

p + geom_text(aes(y = y + 0.1, label = label, angle = angle), data = df2,
              vjust = 1, size = 4, fontface = "bold")

df$col <- cut(df$x, c(-1, 0.95, 2.24, 5), c("black", "white", "#000000"))

ggplot(df, aes(x, y)) + 
  geom_line(aes(color = col, group = col)) + 
  geom_text(aes(label = label, angle = angle), data = df2,
            size = 4, fontface = "bold") +
  scale_color_identity() +
  coord_equal() +
  theme_bw()

#-----------------------------------------------------------------------
# Converts a (delta y) / (delta x) gradient to the equivalent
# angle a letter sitting on that line needs to be rotated by to
# sit perpendicular to it. Includes a multiplier term so that we
# can take account of the different scale of x and y variables
# when plotting, as well as the device's aspect ratio.

gradient_to_text_angle <- function(grad, mult = 1)
{
  angle <- atan(mult * grad) * 180 / pi
}

#-----------------------------------------------------------------------
# From a given set of x and y co-ordinates, determine the gradient along
# the path, and also the Euclidean distance along the path. It will also
# calculate the multiplier needed to correct for differences in the x and
# y scales as well as the current plotting device's aspect ratio

get_path_data <- function(x, y)
{
  grad <- diff(y)/diff(x)
  multiplier <- diff(range(x))/diff(range(y)) * dev.size()[2] / dev.size()[1]
  
  new_x <- (head(x, -1) + tail(x, -1)) / 2
  new_y <- (head(y, -1) + tail(y, -1)) / 2
  path_length <- cumsum(sqrt(diff(x)^2 + diff(multiplier * y / 1.5)^2))
  data.frame(x = new_x, y = new_y, gradient = grad, 
             angle = gradient_to_text_angle(grad, multiplier), 
             length = path_length)
}

#-----------------------------------------------------------------------
# From a given path data frame as provided by get_path_data, as well
# as the beginning and ending x co-ordinate, produces the appropriate
# x, y values and angles for letters placed along the path.

get_path_points <- function(path, x_start, x_end, letters)
{
  start_dist <- approx(x = path$x, y = path$length, xout = x_start)$y
  end_dist <- approx(x = path$x, y = path$length, xout = x_end)$y
  diff_dist <- end_dist - start_dist
  letterwidths <- cumsum(strwidth(letters))
  letterwidths <- letterwidths/sum(strwidth(letters))
  dist_points <- c(start_dist, letterwidths * diff_dist + start_dist)
  dist_points <- (head(dist_points, -1) + tail(dist_points, -1))/2
  x <- approx(x = path$length, y = path$x, xout = dist_points)$y
  y <- approx(x = path$length, y = path$y, xout = dist_points)$y
  grad <- approx(x = path$length, y = path$gradient, xout = dist_points)$y
  angle <- approx(x = path$length, y = path$angle, xout = dist_points)$y
  data.frame(x = x, y = y, gradient = grad, 
             angle = angle, length = dist_points)
}

#-----------------------------------------------------------------------
# This function combines the other functions to get the appropriate
# x, y positions and angles for a given string on a given path.

label_to_path <- function(label, path, x_start = head(path$x, 1), 
                          x_end = tail(path$x, 1)) 
{
  letters <- unlist(strsplit(label, "")[1])
  df <- get_path_points(path, x_start, x_end, letters)
  df$letter <- letters
  df
}

#-----------------------------------------------------------------------
# This simple helper function gets the necessary density paths from
# a given variable. It can be passed a grouping variable to get multiple
# density paths

get_densities <- function(var, groups)
{
  if(missing(groups)) values <- list(var)
  else values <- split(var, groups)
  lapply(values, function(x) { 
    d <- density(x)
    data.frame(x = d$x, y = d$y)})
}

#-----------------------------------------------------------------------
# This is the end-user function to get a data frame of letters spaced
# out neatly and angled correctly along the density curve of the given
# variable (with optional grouping)

density_labels <- function(var, groups, proportion = 0.25)
{
  d <- get_densities(var, groups)
  d <- lapply(d, function(x) get_path_data(x$x, x$y))
  labels <- unique(groups)
  x_starts <- lapply(d, function(x) x$x[round((length(x$x) * (1 - proportion))/2)])
  x_ends <- lapply(d, function(x) x$x[round((length(x$x) * (1 + proportion))/2)])
  do.call(rbind, lapply(seq_along(d), function(i) {
    df <- label_to_path(labels[i], d[[i]], x_starts[[i]], x_ends[[i]])
    df$group <- labels[i]
    df}))
}

set.seed(100)

df <- data.frame(value = rpois(100, 3),
                 group = rep(paste("This is a very long label",
                                   "that will nicely demonstrate the ability",
                                   "of text to follow a density curve"), 100))

ggplot(df, aes(value)) + 
  geom_density(fill = "forestgreen", color = NA, alpha = 0.2) +
  geom_text(aes(x = x, y = y, label = letter, angle = angle), 
            data = density_labels(df$value, df$group, 0.8)) +
  theme_bw() 

matrices = [np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]]),
            np.array( [[13,  0,  1,  0,  2,  0],[ 0, 50,  2,  0, 10,  0],[ 0, 13, 16,  0,  0,  3],[ 0,  0,  0, 13,  1,  0],[ 0, 40,  0,  1, 15,  0],[ 0,  0,  0,  0,  0, 20]])]
fig = plt.figure(tight_layout=True)
ax = fig.add_gridspec(3,3)
ax_list = [] #list containing axes objects
for i in range(9):
    ax_list.append(fig.add_subplot(ax[i%3,i//3])) 
    df_cm = DataFrame(matrices[i], index=range(1,7), columns=range(1,7))
    pretty_plot_confusion_matrix(df_cm, ax_list[i], annot=True, cmap="Oranges", fmt='.2f', fz=7,
    lw=0.5, cbar=False, show_null_values=0, pred_val_axis='y')
plt.show()

import matplotlib.pyplot as plt
from matplotlib.patches import RegularPolygon
import numpy as np

data = {'group': np.arange(1, 26),
        'color': ["red", "brown", "hotpink", "orange", "indianred", "magenta", "darkgoldenrod", "goldenrod", "gold", "deeppink", "yellow", "darkseagreen", "aquamarine", "plum", "mediumorchid", "olivedrab", "limegreen", "thistle", "violet", "green", "mediumseagreen", "darkviolet", "lightseagreen", "dodgerblue", "deepskyblue"],
        'alpha': np.ones(25)}

fig, ax = plt.subplots()
ax.set_aspect('equal')
ax.axis('off')

ind = 0
N = 5
for x in np.arange(1, 2*N):
    num_y = N - abs(x - N)
    for y in range(N + num_y, N - num_y, -2):
        hexagon = RegularPolygon((x, y/np.sqrt(3)), numVertices=6, radius=2 / 3, orientation=np.pi/2,
                                 alpha=data['alpha'][ind],
                                 facecolor=data['color'][ind], edgecolor='k')
        ax.add_patch(hexagon)
        ax.text(x, y/np.sqrt(3), f"Group{data['group'][ind]}", color='black', ha='center', va='center')
        ind += 1
plt.autoscale(enable=True)
plt.show()