R-Cade Games: Simulating the Legendary Game of Pong

The legendary game of PongPong is one of the earliest arcade games on the market, first released in 1972. From the day I first saw this miracle box, I wanted to know more about computers.

I learnt how to write code from the 1983 book Dr. C. Wacko’s Miracle Guide to Designing and Programming your own Atari Computer Arcade Games. This book explains in a very clear and humorous way how to write computer games in Atari basic. I devoured this book and spent many hours developing silly games. This article is an ode to Dr Wacko, a computer geek’s midlife-crisis and an attempt to replicate the software I developed thirty years ago.

I showed in a previous post that R can be used for board games. The question is whether we create arcade games in R. My challenge is to recreate the look and feel of 1980s arcade games, or R-Cade games, using R? The code shown below simulates the legendary game of pong.

Playing Pong in R

The code is based on the Wacko’s Boing Program in the above-mentioned book. The R code is fully commented and speaks for itself. Please note that the animation is very clunky when you run it in RStudio. Only the native R Terminal displays the animation correctly.

Perhaps somebody can help me perfect this little ditty. I love to know how to read real-time USB input to control the game, so we get a step closer to the first R-Cade game.

The Pong Code

# Sound library
library(beepr) 

# Game parameters
skill <- 0.87 # Skill (0-1)
score <- 0
high.score <- 0

# Define playing field
par(mar = rep(1,4), bg = "black")
plot.new()
plot.window(xlim = c(0, 30), ylim = c(0, 30))
lines(c(1, 30, 30, 1), c(0, 0, 30, 30), type = "l", lwd = 5, col = "white")

# Playing field boundaries (depend on cex)
xmin <- 0.5
xmax <- 29.4
ymin <- 0.5
ymax <- 29.4

# initial position
x <- sample(5:25, 1)
y <- sample(5:25, 1)
points(x, y, pch = 15, col = "white", cex = 2)

# Paddle control
psize <- 4
ypaddle <- y

# Set direction
dx <- runif(1, .5, 1)
dy <- runif(1, .5, 1) 

# Game play 
while (x > xmin - 1) {
    sound <- 0 # Silence
    Sys.sleep(.05) # Pause screen. Reduce to increase speed
    points(x, y, pch = 15, col = "black", cex = 2) # Erase ball
    # Move ball
    x <- x + dx
    y <- y + dy 
    # Collision detection 
    if (x > xmax) {
        dx <- -dx * runif(1, .9, 1.1) # Bounce 
        if (x > xmin) x <- xmax # Boundary
        sound <- 10 # Set sound
        }
    if (y < ymin | y > ymax) {
        if (y < ymin) y <- ymin 
        if (y > ymax) y <- ymax
        dy <- -dy * runif(1, .9, 1.1)
        sound <- 10
    }
    # Caught by paddle?
    if (x < xmin & (y > ypaddle - (psize / 2)) & y < ypaddle + (psize / 2)) {
        if (x < xmin) x <- xmin
        dx <- -dx * runif(1, .9, 1.1)
        sound <- 2
        score <- score + 1
        }
    # Draw ball
    points(x, y, pch = 15, col = "white", cex = 2)
    if (sound !=0) beep(sound)
    # Move paddle
    if (runif(1, 0, 1) < skill) ypaddle <- ypaddle + dy # Imperfect follow
    # Draw paddle
    # Erase back line
    lines(c(0, 0), c(0, 30), type = "l", lwd = 8, col = "black")
    # Keep paddle inside window
    if (ypaddle < (psize / 2)) ypaddle <- (psize / 2) 
    if (ypaddle > 30 - (psize / 2)) ypaddle <- 30 - (psize / 2) 
    # Draw paddle 
    lines(c(0, 0), c(ypaddle - (psize / 2), ypaddle + (psize / 2)), type = "l", lwd = 8, col = "white") 
} 
beep(8) 
text(15,15, "GAME OVER", cex=5, col = "white") 
s <- ifelse(score == 1, "", "s")
text(15,5, paste0(score, " Point", s), cex=3, col = "white") 

Tic Tac Toe War Games: The Intelligent Minimax Algorithm

Tic Tac Toe War GamesIn a previous post, I shared how to build a randomised Tic Tac Toe simulation. The computer plays against itself playing at random positions. In this post, I will share how to teach the computer to play the game strategically.

I love the 1983 classic movie War Games. In this film, a computer plays Tic Tac Toe against itself to learn that it cannot win the game to prevent a nuclear war.

Back in those days, I devoured the wonderful book Writing Strategy Games on your Atari by John White which contains an algorithm to play Tic Tac Toe War Games. This is my attempt to relive the eighties using R.

You can find the code on my GitHub page.

Drawing the Board

A previous post describes the function that draws the Tic Tac Toe board. For completeness, the code is replicated below. The game board is a vector of length nine consisting of either -1 (X), 0 (empty field) or 1 (O). The vector indices correspond with locations on the game board:

1 2 3
4 5 6
7 8 9

draw.board <- function(board) { # Draw the board
    xo <- c("X", " ", "O") # Symbols
    par(mar = rep(0,4))
    plot.new()
    plot.window(xlim = c(0,30), ylim = c(0,30))
    abline(h = c(10, 20), col="darkgrey", lwd = 4)
    abline(v = c(10, 20), col="darkgrey", lwd = 4)
    pieces <- xo[board + 2]
    text(rep(c(5, 15, 25), 3), c(rep(25, 3), rep(15,3), rep(5, 3)), pieces, cex = 6)
    # Identify location of any three in a row
    square <- t(matrix(board, nrow = 3))
    hor <- abs(rowSums(square))
    if (any(hor == 3)) 
      hor <- (4 - which(hor == 3)) * 10 - 5 
    else 
      hor <- 0
    ver <- abs(colSums(square))
    if (any(ver == 3)) 
      ver <- which(ver == 3) * 10 - 5 
    else
      ver <- 0
    diag1 <- sum(diag(square))
    diag2 <- sum(diag(t(apply(square, 2, rev)))) # Draw winning lines if (hor > 0) lines(c(0, 30), rep(hor, 2), lwd=10, col="red")
    if (ver > 0) lines(rep(ver, 2), c(0, 30), lwd=10, col="red")
    if (abs(diag1) == 3) lines(c(2, 28), c(28, 2), lwd=10, col="red")
    if (abs(diag2) == 3) lines(c(2, 28), c(2, 28), lwd=10, col="red")
}

Human Players

This second code snippet lets a human player move by clicking anywhere on the graphic display using the locator function. The click location is converted to a number to denote the position on the board. The entered field is only accepted if it has not yet been used (the empty variable contains the available fields).

# Human player enters a move
move.human <- function(game) {
    text(4, 0, "Click on screen to move", col = "grey", cex=.7)
    empty <- which(game == 0)
    move <- 0
    while (!move %in% empty) {
        coords <- locator(n = 1) # add lines
        coords$x <- floor(abs(coords$x) / 10) + 1
        coords$y <- floor(abs(coords$y) / 10) + 1
        move <- coords$x + 3 * (3 - coords$y)
    }
    return (move)
}

Evaluate the Game

This code snippet defines the eval.game function which assesses the current board and assigns a score. Zero means no outcome, -6 means that the X player has won and +6 implies that the O player has won.

# Evaluate board position
eval.game <- function(game, player) {
    # Determine game score
    square <- t(matrix(game, nrow = 3))
    hor <- rowSums(square)
    ver <- colSums(square)
    diag1 <- sum(diag(square))
    diag2 <- sum(diag(t(apply(square, 2, rev))))
    eval <- c(hor, ver, diag1, diag2)
    # Determine best score
    minimax <- ifelse(player == -1, "min", "max")
    best.score <- do.call(minimax, list(eval))
    if (abs(best.score) == 3) best.score <- best.score * 2
    return (best.score)
}

Computer Moves

The computer uses a modified Minimax Algorithm to determine its next move. This article from the Never Stop Building blog and the video below explain this method in great detail.

The next function determines the computer’s move. I have not used a brute-force minimax algorithm to save running time. I struggled building a fully recursive minimax function. Perhaps somebody can help me with this. This code looks only two steps deep and contains a strategic rule to maximise the score.

The first line stores the value of the players move, the second remainder of the matrix holds the evaluations of all the opponents moves. The code adds a randomised variable, based on the strategic value of a field. The centre has the highest value because it is part of four winning lines. Corners have three winning lines and the rest only two winning lines. This means that the computer will, all things being equal, favour the centre over the corners and favour the other fields least. The randomised variables in the code ensure that the computer does not always pick the same field in a similar situation.

# Determine computer move
move.computer <- function(game, player) {
    empty <- which(game == 0)
    eval <- matrix(nrow = 10, ncol = 9, data = 0)
    for (i in empty) {
        game.tmp <- game
        game.tmp[i] <- player
        eval[1, i] <- eval.game(game.tmp, player)
        empty.tmp <- which(game.tmp ==0)
        for (j in empty.tmp) {
            game.tmp1 <- game.tmp
            game.tmp1[j] <- -player
            eval[(j + 1), i] <- eval.game(game.tmp1, -player)
        }
    }
    if (!any(abs(eval[1,]) == 6)) { # When winning, play move
        # Analyse opponent move
        minimax <- ifelse(player == -1, "max", "min") # Minimax
        best.opponent <- apply(eval[-1,], 1, minimax)
        eval[1,] <- eval[1,] * -player * best.opponent
    }
    # Add randomisation and strategic values
    board <- c(3, 2, 3, 2, 4, 2, 3, 2, 3) # Strategic values
    board <- sapply(board, function(x) runif(1, 0.1 * x, (0.1 * x) + 0.1)) # Randomise
    eval[1, empty] <- eval[1, empty] + player * board[empty] # Randomise moves
    # Pick best game
    minimax <- ifelse(player == -1, "which.min", "which.max") # Minimax
    move <- do.call(minimax, list(eval[1,])) # Select best move
    return(move)
}

This last code snippet enables computers and humans play each other or themselves. The players vector contains the identity of the two players so that a human can play a computer or vice versa. The human player moves by clicking on the screen.

The loop keeps running until the board is full or a winner has been identified. A previous Tic Tac Toe post explains the draw.board function.

# Main game engine
tic.tac.toe <- function(player1 = "human", player2 = "computer") {
    game <- rep(0, 9) # Empty board
    winner <- FALSE # Define winner
    player <- 1 # First player
    players <- c(player1, player2)
    draw.board(game)
    while (0 %in% game & !winner) { # Keep playing until win or full board
        if (players[(player + 3) %% 3] == "human") # Human player
            move <- move.human(game)
        else # Computer player
            move <- move.computer(game, player)
        game[move] <- player # Change board
        draw.board(game)
        winner <- max(eval.game(game, 1), abs(eval.game(game, -1))) == 6 # Winner, winner, chicken dinner?
        player <- -player # Change player
    }
}

You can play the computer by running all functions and then entering tic.tac.toe().

I am pretty certain this simplified minimax algorithm is unbeatable—why don’t you try to win and let me know when you do.

Tic Tac Toe War Games

Now that this problem is solved, I can finally recreate the epic scene from the WarGames movie. The Tic Tac Toe War Games code uses the functions explained above and the animation package. Unfortunately, there are not many opportunities to create sound in R.

# WAR GAMES TIC TAC TOE
source("Tic Tac Toe/Tic Tac Toe.R")

# Draw the game board
draw.board.wargames <- function(game) {
    xo <- c("X", " ", "O") # Symbols
    par(mar = rep(1,4), bg = "#050811")
    plot.new()
    plot.window(xlim = c(0,30), ylim = c(0,30))
    abline(h = c(10, 20), col = "#588fca", lwd = 20)
    abline(v = c(10, 20), col = "#588fca", lwd = 20)
    text(rep(c(5, 15, 25), 3), c(rep(25, 3), rep(15,3), rep(5, 3)), xo[game + 2], cex = 20, col = "#588fca")
    text(1,0,"r.prevos.net", col = "#588fca", cex=2)
    # Identify location of any three in a row
    square <- t(matrix(game, nrow = 3))
    hor <- abs(rowSums(square))
    if (any(hor == 3)) 
        hor <- (4 - which(hor == 3)) * 10 - 5 
    else 
        hor <- 0
    ver <- abs(colSums(square))
    if (any(ver == 3)) 
        ver <- which(ver == 3) * 10 - 5 
    else
        ver <- 0
    diag1 <- sum(diag(square))
    diag2 <- sum(diag(t(apply(square, 2, rev)))) # Draw winning lines if (all(hor > 0)) for (i in hor) lines(c(0, 30), rep(i, 2), lwd = 10, col="#588fca")
    if (all(ver > 0)) for (i in ver) lines(rep(i, 2), c(0, 30), lwd = 10, col="#588fca")
    if (abs(diag1) == 3) lines(c(2, 28), c(28, 2), lwd = 10, col = "#588fca")
    if (abs(diag2) == 3) lines(c(2, 28), c(2, 28), lwd = 10, col = "#588fca")
}

library(animation)
player <- -1
games <- 100
saveGIF ({
    for (i in 1:games) {
        game <- rep(0, 9) # Empty board
        winner <- 0 # Define winner
        #draw.board.wargames(game)
        while (0 %in% game & !winner) { # Keep playing until win or full board
            empty <- which(game == 0)
            move <- move.computer(game, player)
            game[move] <- player
            if (i <= 12) draw.board.wargames(game)
            winner <- max(eval.game(game, 1), abs(eval.game(game, -1))) == 6
            player <- -player } if (i > 12) draw.board.wargames(game)
    }
},
interval = c(unlist(lapply(seq(1, 0,-.2), function (x) rep(x, 9))), rep(0,9*94)), 
movie.name = "wargames.gif", ani.width = 1024, ani.height = 1024)

Data Pseudo-Science: Developing a Biorhythm Calculator

biorhythm: data pseudo-scienceData science is a serious occupation. Just like any other science, however, it can also be used for spurious topics, such as calculating your biorhythm.

This post provides an example of data Pseudo-Science though a function that calculates and visualises your biorhythm. Based on the graph, I must be having a great day right now.

The broader and more pertinent message in this post is that data pseudo-science is more common than you would think. Is our belief in machine learning justified or are some of these models also a pseudo-science with not much more reliability than a biorhythm?

Biorhythm Theory

The idea that our physical states follow a predetermined rhythm has been around as long as mathematics. The basic concept of biorhythm is that a regular sinusoid cycle accurately describes our physical, emotional and intellectual states. Each of these three cycles has a different wavelength (w ):

  • physical: w = 23 days
  • emotional: w = 28 days
  • intellectual: w = 33 days

The cycle is calculated with \sin (2 \pi t / w) , where t indicates the number of days since birth. This idea was developed by German surgeon Wilhelm Fliess in the late 19th century and was popularised in the United States in the late 1970s. There is no scientific evidence of the validity of this theory but it is an entertaining way to play with data.

The combination of the 23- and 28-day cycles repeats every 644 days, while the triple combination of 23-, 28-, and 33-day cycles repeats every 21,252 days, 58 years, two months and three weeks. You can, by the way, never reach a point where all cycles are maximised. The best you can achieve is 299.7 our of a maximum 300 which occurs when you are 17,003 days old.

Calculating your Biorhythm

When I was a teenager in the 1980s, several books and magazines described computer code to calculate your biorhythm. I used to play with these functions on my Atari 130XE computer.

Building a biorhythm calculator in R is easy. This function takes two dates as input and plots the biorhythm for the two weeks before and after the date. To calculate your biorhythm, run the function with your date of birth and target date: biorhythm(“yyyy-mm-dd”). The default version uses today as the target.

library(ggplot2)
library(reshape2)
biorhythm <- function(dob, target = Sys.Date()) {
    dob <- as.Date(dob)
    target <- as.Date(target)
    t <- round(as.numeric(difftime(target, dob)))
    days <- (t - 14) : (t + 14)
    period <- data.frame(Date = seq.Date(from = target - 15, by = 1, length.out = 29),
                         Physical = sin (2 * pi * days / 23) * 100, 
                         Emotional = sin (2 * pi * days / 28) * 100, 
                         Intellectual = sin (2 * pi * days / 33) * 100)
    period <- melt(period, id.vars = "Date", variable.name = "Biorhythm", value.name = "Percentage")
    ggplot(period, aes(x = Date, y = Percentage, col = Biorhythm)) + geom_line() +  
        ggtitle(paste("DoB:", format(dob, "%d %B %Y"))) + 
        geom_vline(xintercept = as.numeric(target))
}

biorhythm("1969-09-12", "2017-03-30")

Biorhythms are an early attempt for human beings to predict the future. Although there is no relationship between this algorithm and reality, many people believed in its efficacy. Does the same hold true for the hyped capabilities of machine learning?

Data Pseudo-Science

Data pseudo-science is not only an issue when people use spurious mathematical relationships such as biorhythms or astrology. This post is also written as a warning not to only rely on numerical models to predict qualitative aspects of life.

The recent failures in predicting the results of elections, even days before the event, are a case in point. There are many reasons machine learning methods can go wrong. When machine learning algorithms fail, they are often just as useful as a biorhythm. It would be fun to write a predictive analysis package for R using only pseudoscientific approaches such as I-Ching, astrology or biorhythm.

Tic Tac Toe Simulation — Random Moves

Tic Tac Toe Simulation - Part 1Tic Tac Toe might be a futile children’s game but it can also teach us about artificial intelligence. Tic Tac Toe, or Naughts and Crosses, is a zero-sum game with perfect information. Both players know exactly what the other did and when nobody makes a mistake, the game will always end in a draw.

Tic Tac Toe is a simple game but also the much more complex game of chess is a zero-sum game with perfect information.

In this two-part post, I will build an unbeatable Tic Tac Toe Simulation. This first part deals with the mechanics of the game. The second post will present an algorithm for a perfect game.

Drawing the Board

This first code snippet draws the Tic Tac Toe simulation board. The variable xo holds the identity of the pieces and the vector board holds the current game. Player X is denoted with -1 and player O with +1. The first part of the function draws the board and the naughts and crosses. The second part of the code check for three in a row and draws the corresponding line.

draw.board <- function(board) { # Draw the board
    xo <- c("X", " ", "O") # Symbols
    par(mar = rep(0,4))
    plot.new()
    plot.window(xlim = c(0,30), ylim = c(0,30))
    abline(h = c(10, 20), col="darkgrey", lwd = 4)
    abline(v = c(10, 20), col="darkgrey", lwd = 4)
    pieces <- xo[board + 2]
    text(rep(c(5, 15, 25), 3), c(rep(25, 3), rep(15,3), rep(5, 3)), pieces, cex = 6)
    # Identify location of any three in a row
    square <- t(matrix(board, nrow = 3))
    hor <- abs(rowSums(square))
    if (any(hor == 3)) 
      hor <- (4 - which(hor == 3)) * 10 - 5 
    else 
      hor <- 0
    ver <- abs(colSums(square))
    if (any(ver == 3)) 
      ver <- which(ver == 3) * 10 - 5 
    else
      ver <- 0
    diag1 <- sum(diag(square))
    diag2 <- sum(diag(t(apply(square, 2, rev)))) 
    # Draw winning lines 
    if (hor > 0) lines(c(0, 30), rep(hor, 2), lwd=10, col="red")
    if (ver > 0) lines(rep(ver, 2), c(0, 30), lwd=10, col="red")
    if (abs(diag1) == 3) lines(c(2, 28), c(28, 2), lwd=10, col="red")
    if (abs(diag2) == 3) lines(c(2, 28), c(2, 28), lwd=10, col="red")
}

Random Tic Tac Toe

The second part of the code generates ten random games and creates and animated GIF-file. The code adds random moves until one of the players wins (winner <> 0) or the board is full (no zeroes in the game vector). The eval.winner function checks for three in a row and declares a winner when found.

There are 255,168 possible legal games in Tic Tac Toe, 46,080 of which end in a draw. This implies that these randomised games result in a draw 18% of the time.

eval.winner <- function(board) { # Identify winner
    square <- t(matrix(board, nrow = 3))
    hor <- rowSums(square)
    ver <- colSums(square)
    diag1 <- sum(diag(square))
    diag2 <- sum(diag(t(apply(square, 2, rev))))
    if (3 %in% c(hor, ver, diag1, diag2)) return (1)
    else
        if (-3 %in% c(hor, ver, diag1, diag2)) return (2)
    else
        return(0)
}

# Random game
library(animation)
saveGIF ({
 for (i in 1:10) {
 game <- rep(0, 9) # Empty board
 winner <- 0 # Define winner
 player <- -1 # First player
 draw.board(game)
 while (0 %in% game & winner == 0) { # Keep playing until win or full board
   empty <- which(game == 0) # Define empty squares
   move <- empty[sample(length(empty), 1)] # Random move
   game[move] <- player # Change board
   draw.board(game)
   winner <- eval.winner(game) # Evaulate game
   player <- player * -1 # Change player
 }
 draw.board(game)
 }
 },
 interval = 0.25, movie.name = "ttt.gif", ani.width = 600, ani.height = 600)

Tic Tac Toe Simulation

In a future post, I will outline how to program the computer to play against itself, just like in the 1983 movie War Games.

Create Air Travel Route Maps in ggplot: A Visual Travel Diary

Create Air Travel Route Maps: Emirates Route MapI have been lucky to fly to a few countries around the world. Like any other bored traveller, I thumb through the airline magazines and look at the air travel route maps. These maps are beautifully stylised depictions of the world with gently curved lines between the many destinations. I always wanted such a map for my own travel adventures.

Create Air Travel Route Maps using ggplot2

The first step was to create a list of all the places I have flown between at least once. Paging through my travel photos and diaries, I managed to create a pretty complete list. The structure of this document is simply a list of all routes (From, To) and every flight only gets counted once. The next step finds the spatial coordinates for each airport by searching Google Maps using the geocode function from the ggmap package. In some instances, I had to add the country name to avoid confusion between places.

# Read flight list
flights <- read.csv("flights.csv", stringsAsFactors = FALSE)

# Lookup coordinates
library(ggmap)
airports <- unique(c(flights$From, flights$To))
coords <- geocode(airports)
airports <- data.frame(airport=airports, coords)

We now we have a data frame of airports with their coordinates and can create air travel route maps. The data frames are merged so that we can create air travel route maps using the curve geom. The borders function of ggplot2 creates the map data. The ggrepel package helps to prevent overplotting of text.

# Add coordinates to flight list
flights <- merge(flights, airports, by.x="To", by.y="airport")
flights <- merge(flights, airports, by.x="From", by.y="airport")

# Plot flight routes
library(ggplot2)
library(ggrepel)
worldmap <- borders("world", colour="#efede1", fill="#efede1") # create a layer of borders
ggplot() + worldmap + 
 geom_curve(data=flights, aes(x = lon.x, y = lat.x, xend = lon.y, yend = lat.y), col = "#b29e7d", size = 1, curvature = .2) + 
 geom_point(data=airports, aes(x = lon, y = lat), col = "#970027") + 
 geom_text_repel(data=airports, aes(x = lon, y = lat, label = airport), col = "black", size = 2, segment.color = NA) + 
 theme(panel.background = element_rect(fill="white"), 
 axis.line = element_blank(),
 axis.text.x = element_blank(),
 axis.text.y = element_blank(),
 axis.ticks = element_blank(),
 axis.title.x = element_blank(),
 axis.title.y = element_blank()
 )

I also tried to use ggmap package to display the maps to get a satellite image background. This did not work because the curve geom struggles with the map projection methods used in ggmap. Another problem is that the flight from Auckland to Los Angeles is drawn the wrong way. I hope no flat-earthers will see this map because they might use it as prove that the world is flat.

Alternative Visualisation

Another way of visualising this type of data is using a network diagram provided by the igraph package. This visualisation shows the logic between the locations and not their spatial locations.

# Network visualisation
library(igraph)
edgelist <- as.matrix(flights[c("From", "To")])
g <- graph_from_edgelist(edgelist, directed = TRUE)
g <- simplify(g)
par(mar=rep(0,4))
plot.igraph(g, 
 edge.arrow.size=0,
 edge.color="black",
 edge.curved=TRUE,
 edge.width=2,
 vertex.size=3,
 vertex.color=NA, 
 vertex.frame.color=NA, 
 vertex.label=V(g)$name,
 vertex.label.cex=3,
 layout=layout.fruchterman.reingold
)

Trumpworld Analysis : Ownership Relations in his Business Network

Trumpworld by BuzzfeedYou do not need a machine learning algorithm to predict that the presidency of Donald Trump will be controversial.

One of the most discussed aspects of his reign is the massive potential for conflicts of interest. Trump’s complex business empire is entangled with national and international politics.

Buzzfeed has mapped many of the relationships between businesses and people in what they have dubbed Trumpworld. They provided the data to enable citizens data science into the wheelings and dealings of Donald J. Trump. The raw data set consists of three subsets of connections between:

  • Organisations
  • People
  • People and organisations

Trumpworld Analysis

This post analyses the connections between organisations using the mighty igraph package in the R language. The code snippet below converts the data to a graph that can be analysed using social network analysis techniques. I have downloaded the table of the raw data file as CSV files. This data is subsetted to contain only ownership relationships.

# Read data
trumpworld.org <- read.csv("TrumpWorld DataOrg.csv")
trumpworld.org.ownership <- subset(trumpworld.org, Connection=="Ownership")[,1:2]

# Create graph of ownerships
library(igraph)
org.ownership <- graph.edgelist(as.matrix(trumpworld.org.ownership))

# Analysis
nrow(trumpworld.org.ownership)
length(unique(c(trumpworld.org.ownership[,1], trumpworld.org.ownership[,2])))

# Plot Graph
par(mar=rep(0,4))
plot(org.ownership,
 layout=layout.fruchterman.reingold,
 vertex.label=NA,
 vertex.size=2,
 edge.arrow.size=.1
)

Trumpworld analysis - business ownership networkNetwork Analysis

This network contains 309 ownership relationships between 322 firms.

When we plot the data, we see that most relationships are between two firms. The plot is organised with the Fruchterman-Reingold algorithm to improve its clarity.

We can also see a large cluster in the centre. The names have been removed for clarity.

The Trumpland analysis continues with this conglomerate. The second code section excises this connected subnetwork so we can analyse it in more detail.

# Find most connected firm
which.max(degree(org.ownership))
# Create subnetworks
org.ownership.d <- decompose(org.ownership)
# Find largest subnetwork
largest <- which.max(sapply(org.ownership.d, diameter))
#Plot largest subnetwork
plot(org.ownership.d[[largest]],
 layout=layout.fruchterman.reingold,
 vertex.label.cex=.5,
 vertex.size=5,
 edge.arrow.size=.1
)

Digging Deeper

The node with the highest degree identifies the business with the most holdings. This analysis shows that DJT Holdings LLC owns 33 other organisations. These organisations own other organisations. We can now use the cluster function to investigate this subnetwork.

Trumpworld holdings

This Trumpworld analysis shows that the ownership network is clearly a star network. DJT Holdings LLC centrally controls all organisations. Perhaps this graph visualises the management style of the soon to be president Trump. Trump centrally controls his empire, which is typical for a family business.

Does this chart visualise Trump’s leadership style? Is the star network an expression of his lack of trust and thus desire to oversee everything directly?

Finding antipodes using the globe and ggmap packages

The antipodes of each point on the Earth's surface

The antipode of each point on the Earth’s surface—the points where the blue and yellow overlap, are the land antipodes.

When I was a kid, I was was fascinated by the conundrum of what happens when you drill a hole straight through the centre of the earth. I always believed that I would turn up in Australia. But is this really the case?

The antipodes of any place on earth is the place that is diametrically opposite to it. A pair of antipodes are connected by a straight line running through the centre of the Earth. These points are as far away from each other as is possible on this planet. Two people are antipodes when they live on opposite sides of the globe. Their feet (πούς/pous in Ancient Greek) are directly opposite each other.

How can we use coding in R to solve this conundrum?

Using R to find antipodes

We can roughly recreate the antipodean map on Wikipedia with the globe package. This package, written by Adrian Baddeley, plots 2D and 3D views of the earth. The package contains a data file with major coastlines that can be used to create a flipped map of the world.

The package contains a data file with major coastlines that can be used to create a flipped map of the world. To turn a spatial location into its antipode you subtract 180 degrees from the longitude and reverse the sign of the latitude, shown below.

library(globe)
# Create antipodean map
flip <- earth
flip$coords[,1] <- flip$coords[,1]-180
flip$coords[,2] <- -flip$coords[,2]
par(mar=rep(0,4)) # Remove plotting margins
globeearth(eye=c(90,0), col="blue")
globepoints(loc=flip$coords, eye=c(90,0), col="red", pch=".")

We can also use the ggmap package to visualise antipodes. This package, developed by David Kahle antipodean R-guru Hadley Wickham, has a neat geocoding function to obtain a spatial location. The antipode function takes the description of a location and a zoom level to plot a dot on the antipode location. The gridExtra package is used to created a faceted map, which is not otherwise possible in ggmap.

library(ggmap)
library(gridExtra)

antipode <- function(location, zm=6) {
    # Map location
    lonlat <- geocode(location)
    loc1 <- get_map(lonlat, zoom=zm)
    map1 <- ggmap(loc1) + geom_point(data=lonlat, aes(lon, lat, col="red", size=10)) + 
        theme(legend.position="none")
    # Define antipode
    lonlat$lon <- lonlat$lon-180
    if (lonlat$lon < -180) lonlat$lon <- 360 + lonlat$lon
    lonlat$lat <- -lonlat$lat
    loc2 <- get_map(lonlat, zoom=zm)
    map2 <- ggmap(loc2) + geom_point(data=lonlat, aes(lon, lat, col="red", size=10)) + 
        theme(legend.position="none")
    grid.arrange(map1, map2, nrow=1)
}

antipode("Rector Nelissenstraat 47 Hoensbroek", 4)

This code solves the problem I was thinking about as a child. Running the code shows that the antipodes location of the home I grew up in is not in Australia, but quite a way south of New Zealand. Another childhood fantasy shattered …

Antipodes using ggmap and gridExtra.