Set-Up: Load all necessary packages & libraries, set file path, import csv, and clean data.
install.packages("mapplots")
install.packages("treemapify")
library(ggplot2)
library(tidyverse)
library(utils)
library(dplyr)
library(ggmap)
library(tidyr)
library(treemapify)
HW3 <- file.path ("/Users/krgr.df/Desktop/GEOG208/Assignment 3/pizzacountry.csv")
list3 <- read.csv(HW3)
#Clean data, separate fave toppings column, add count column
colnames(list3) <- c("id", "time", "age_range", "gender", "state", "county", "city_town", "children", "activity_level", "pizza_enjoyment", "fav_toppings", "unfav_toppings", "crust_type","frequency","type","other_cuisines", "gluten_tol","best_za_state","sides","country")
list3_separate <- separate(list3, fav_toppings, into = c("ftop1", "ftop2","ftop3"), sep = ";")
final_list <- separate(list3_separate, unfav_toppings, into = c("utop1", "utop2","utop3"), sep = ";")
final_list <- final_list %>% mutate(pos_count = 1) %>% mutate(neg_count = -1)
Viz1 and 2: I created two simple bar plots to get an initial overview of the data that I’ll be dealing with. I only chose to map the first topping that they responded with since I’m making a call and assuming (Hans might have problems this) that the first topping they put is their most favorite topping. I did the same for least favorite toppings.
##################Viz1: Toppings Overview##################
Viz1_df <- within(list3_separate,
ftop1 <- factor(ftop1,
levels=names(sort(table(ftop1),
decreasing=FALSE))))
Viz1 <- ggplot(Viz1_df, aes(x = ftop1)) +
geom_bar(fill="white", color = "steelblue2") +
coord_flip() +
labs(title= "Favorite Toppings Overview",
subtitle = "First answer as top answer",
y = "Count",
x = "#1 Topping Choice") +
theme(legend.position="none")
Viz1

Viz2_df <- within(final_list,
utop1 <- factor(utop1,
levels=names(sort(table(utop1),
decreasing=FALSE))))
Viz2 <- ggplot(Viz2_df, aes(x = utop1)) +
geom_bar(fill="white", color = "tomato2") +
coord_flip() +
labs(title= "Least Favorite Toppings Overview",
subtitle = "First answer as top answer",
y = "Count",
x = "#1 Least Favorite Topping Choice") +
theme(legend.position="none")
Viz2

Viz3: Creating a diverging lollipop plot shows the most and least liked toppings.
##################Viz3: Diverging Lollipop Chart ##################
Viz3_1 <- final_list %>% group_by(ftop1) %>% summarise(total = sum(pos_count))
colnames(Viz3_1) <- c("merge", "pos_count")
Viz3_2 <- final_list %>% group_by(utop1) %>% summarise(total = sum(neg_count))
colnames(Viz3_2) <- c("merge", "neg_count")
Viz3_3 <- merge(x = Viz3_1, y = Viz3_2, by = "merge", all = TRUE)
Viz3_3[is.na(Viz3_3)] <- 0
Viz3_3 <- mutate(Viz3_3, total = pos_count + neg_count)
Viz3_3 <- Viz3_3[order(Viz3_3$total), ]
Viz3_3$merge <- factor(Viz3_3$merge, levels = Viz3_3$merge[order(Viz3_3$total)])
Viz3 <- ggplot(Viz3_3, aes(x= merge, y= total, label=total, color = merge)) +
geom_point(stat='identity', fill="black", size=6) +
geom_segment(aes(y = 0,
x = merge,
yend = total,
xend = merge)) +
geom_text(color="white", size=2) +
labs(title="Diverging Lollipop Chart",
subtitle="# of first choice picks for each topping",
y = "Pizza Toppings",
x = "Total") +
ylim(-75, 125) +
theme(legend.position="none") +
coord_flip()
Viz3

Viz4: Provides greater insight on topping preference and shows that things aren’t what they seem. A good amount of people hte mushrooms and black olives might be hated but they’re still loved by many…more people just hate them.
##################Viz4: Diverging Bar Plot##################
Viz4_1 <- Viz3_3
colnames(Viz4_1) <- c("merge", "Faves", "Unfaves", "Total")
Viz4 <- gather(Viz4_1, "type", "counts", 2:3)
#Viz4 <- Viz4[order(Viz4$counts), ]
#Viz4$merge <- factor(Viz4$merge, levels = Viz4$merge[order(Viz4$counts)])
Viz4_2 <- ggplot(Viz4, aes(x = merge, y = counts, fill = type)) + # Fill column
geom_bar(stat = "identity", width = .6) + # draw the bars
scale_fill_manual(values = c("steelblue2", "tomato2")) +
coord_flip() + # Flip axes
labs(title="Topping Divergence",
fill = "Preference",
y = "Toppings",
x = "Votes")
Viz4_2

Viz5: This viz does a great job of providing an overview of favorite toppings by country. The problem that is inherent with treemaps however is that categories with less variables are pushed to the corner and not really seen.
##################Viz5: Treemap Pizza Edition##################
ftop_total <- final_list %>%
group_by(ftop1) %>%
mutate(fave_total_count = sum(pos_count))
Viz5 <- ggplot(ftop_total, aes(area = fave_total_count, fill = ftop1, subgroup = country)) +
geom_treemap() +
geom_treemap_subgroup_border(color = "white", size = 2) +
geom_treemap_subgroup_text(place = "centre", grow = T, alpha = .7, colour = "#FAFAFA", min.size = 1) +
labs(title="Treemap Pizza Edition",
subtitle="Favorite Topping Distribution by Country",
fill = "Topping Type")
Viz5

LS0tCnRpdGxlOiAiUGl6emEgVG9wcGluZyBDb25zZW5zdXMiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KClNldC1VcDogTG9hZCBhbGwgbmVjZXNzYXJ5IHBhY2thZ2VzICYgbGlicmFyaWVzLCBzZXQgZmlsZSBwYXRoLCBpbXBvcnQgY3N2LCBhbmQgY2xlYW4gZGF0YS4KYGBge3J9Cmluc3RhbGwucGFja2FnZXMoIm1hcHBsb3RzIikKaW5zdGFsbC5wYWNrYWdlcygidHJlZW1hcGlmeSIpCmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkodXRpbHMpCmxpYnJhcnkoZHBseXIpCmxpYnJhcnkoZ2dtYXApCmxpYnJhcnkodGlkeXIpCmxpYnJhcnkodHJlZW1hcGlmeSkKCgpIVzMgPC0gZmlsZS5wYXRoICgiL1VzZXJzL2tyZ3IuZGYvRGVza3RvcC9HRU9HMjA4L0Fzc2lnbm1lbnQgMy9waXp6YWNvdW50cnkuY3N2IikKCmxpc3QzIDwtIHJlYWQuY3N2KEhXMykKCiNDbGVhbiBkYXRhLCBzZXBhcmF0ZSBmYXZlIHRvcHBpbmdzIGNvbHVtbiwgYWRkIGNvdW50IGNvbHVtbgpjb2xuYW1lcyhsaXN0MykgPC0gYygiaWQiLCAidGltZSIsICJhZ2VfcmFuZ2UiLCAiZ2VuZGVyIiwgInN0YXRlIiwgImNvdW50eSIsICJjaXR5X3Rvd24iLCAiY2hpbGRyZW4iLCAiYWN0aXZpdHlfbGV2ZWwiLCAicGl6emFfZW5qb3ltZW50IiwgImZhdl90b3BwaW5ncyIsICJ1bmZhdl90b3BwaW5ncyIsICJjcnVzdF90eXBlIiwiZnJlcXVlbmN5IiwidHlwZSIsIm90aGVyX2N1aXNpbmVzIiwgImdsdXRlbl90b2wiLCJiZXN0X3phX3N0YXRlIiwic2lkZXMiLCJjb3VudHJ5IikKbGlzdDNfc2VwYXJhdGUgPC0gc2VwYXJhdGUobGlzdDMsIGZhdl90b3BwaW5ncywgaW50byA9IGMoImZ0b3AxIiwgImZ0b3AyIiwiZnRvcDMiKSwgc2VwID0gIjsiKQpmaW5hbF9saXN0IDwtIHNlcGFyYXRlKGxpc3QzX3NlcGFyYXRlLCB1bmZhdl90b3BwaW5ncywgaW50byA9IGMoInV0b3AxIiwgInV0b3AyIiwidXRvcDMiKSwgc2VwID0gIjsiKQpmaW5hbF9saXN0IDwtIGZpbmFsX2xpc3QgJT4lIG11dGF0ZShwb3NfY291bnQgPSAxKSAlPiUgbXV0YXRlKG5lZ19jb3VudCA9IC0xKQoKYGBgCgpWaXoxIGFuZCAyOiBJIGNyZWF0ZWQgdHdvIHNpbXBsZSBiYXIgcGxvdHMgdG8gZ2V0IGFuIGluaXRpYWwgb3ZlcnZpZXcgb2YgdGhlIGRhdGEgdGhhdCBJJ2xsIGJlIGRlYWxpbmcgd2l0aC4gSSBvbmx5IGNob3NlIHRvIG1hcCB0aGUgZmlyc3QgdG9wcGluZyB0aGF0IHRoZXkgcmVzcG9uZGVkIHdpdGggc2luY2UgSSdtIG1ha2luZyBhIGNhbGwgYW5kIGFzc3VtaW5nIChIYW5zIG1pZ2h0IGhhdmUgcHJvYmxlbXMgdGhpcykgdGhhdCB0aGUgZmlyc3QgdG9wcGluZyB0aGV5IHB1dCBpcyB0aGVpciBtb3N0IGZhdm9yaXRlIHRvcHBpbmcuIEkgZGlkIHRoZSBzYW1lIGZvciBsZWFzdCBmYXZvcml0ZSB0b3BwaW5ncy4gCmBgYHtyfQojIyMjIyMjIyMjIyMjIyMjIyNWaXoxOiBUb3BwaW5ncyBPdmVydmlldyMjIyMjIyMjIyMjIyMjIyMjIwpWaXoxX2RmIDwtIHdpdGhpbihsaXN0M19zZXBhcmF0ZSwgCiAgICAgICAgICAgICAgICAgICAgICAgICBmdG9wMSA8LSBmYWN0b3IoZnRvcDEsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGxldmVscz1uYW1lcyhzb3J0KHRhYmxlKGZ0b3AxKSwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgZGVjcmVhc2luZz1GQUxTRSkpKSkKVml6MSA8LSBnZ3Bsb3QoVml6MV9kZiwgYWVzKHggPSBmdG9wMSkpICsgCiAgZ2VvbV9iYXIoZmlsbD0id2hpdGUiLCBjb2xvciA9ICJzdGVlbGJsdWUyIikgKwogIGNvb3JkX2ZsaXAoKSArCiAgbGFicyh0aXRsZT0gIkZhdm9yaXRlIFRvcHBpbmdzIE92ZXJ2aWV3IiwgCiAgICAgICBzdWJ0aXRsZSA9ICJGaXJzdCBhbnN3ZXIgYXMgdG9wIGFuc3dlciIsIAogICAgICAgeSA9ICJDb3VudCIsCiAgICAgICB4ID0gIiMxIFRvcHBpbmcgQ2hvaWNlIikgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIpCgpWaXoxCgpWaXoyX2RmIDwtIHdpdGhpbihmaW5hbF9saXN0LCAKICAgICAgICAgICAgICAgICAgICAgICAgIHV0b3AxIDwtIGZhY3Rvcih1dG9wMSwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGV2ZWxzPW5hbWVzKHNvcnQodGFibGUodXRvcDEpLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBkZWNyZWFzaW5nPUZBTFNFKSkpKQpWaXoyIDwtIGdncGxvdChWaXoyX2RmLCBhZXMoeCA9IHV0b3AxKSkgKyAKICBnZW9tX2JhcihmaWxsPSJ3aGl0ZSIsIGNvbG9yID0gInRvbWF0bzIiKSArCiAgY29vcmRfZmxpcCgpICsKICBsYWJzKHRpdGxlPSAiTGVhc3QgRmF2b3JpdGUgVG9wcGluZ3MgT3ZlcnZpZXciLCAKICAgICAgIHN1YnRpdGxlID0gIkZpcnN0IGFuc3dlciBhcyB0b3AgYW5zd2VyIiwgCiAgICAgICB5ID0gIkNvdW50IiwKICAgICAgIHggPSAiIzEgTGVhc3QgRmF2b3JpdGUgVG9wcGluZyBDaG9pY2UiKSArCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uPSJub25lIikKClZpejIKCmBgYAoKVml6MzogQ3JlYXRpbmcgYSBkaXZlcmdpbmcgbG9sbGlwb3AgcGxvdCBzaG93cyB0aGUgbW9zdCBhbmQgbGVhc3QgbGlrZWQgdG9wcGluZ3MuIApgYGB7cn0KIyMjIyMjIyMjIyMjIyMjIyMjVml6MzogRGl2ZXJnaW5nIExvbGxpcG9wIENoYXJ0ICMjIyMjIyMjIyMjIyMjIyMjIwpWaXozXzEgPC0gZmluYWxfbGlzdCAlPiUgZ3JvdXBfYnkoZnRvcDEpICU+JSBzdW1tYXJpc2UodG90YWwgPSBzdW0ocG9zX2NvdW50KSkKY29sbmFtZXMoVml6M18xKSA8LSBjKCJtZXJnZSIsICJwb3NfY291bnQiKQpWaXozXzIgPC0gZmluYWxfbGlzdCAlPiUgZ3JvdXBfYnkodXRvcDEpICU+JSBzdW1tYXJpc2UodG90YWwgPSBzdW0obmVnX2NvdW50KSkKY29sbmFtZXMoVml6M18yKSA8LSBjKCJtZXJnZSIsICJuZWdfY291bnQiKQpWaXozXzMgPC0gbWVyZ2UoeCA9IFZpejNfMSwgeSA9IFZpejNfMiwgYnkgPSAibWVyZ2UiLCBhbGwgPSBUUlVFKQpWaXozXzNbaXMubmEoVml6M18zKV0gPC0gMApWaXozXzMgPC0gbXV0YXRlKFZpejNfMywgdG90YWwgPSBwb3NfY291bnQgKyBuZWdfY291bnQpClZpejNfMyA8LSBWaXozXzNbb3JkZXIoVml6M18zJHRvdGFsKSwgXQpWaXozXzMkbWVyZ2UgPC0gZmFjdG9yKFZpejNfMyRtZXJnZSwgbGV2ZWxzID0gVml6M18zJG1lcmdlW29yZGVyKFZpejNfMyR0b3RhbCldKQoKClZpejMgPC0gZ2dwbG90KFZpejNfMywgYWVzKHg9IG1lcmdlLCB5PSB0b3RhbCwgbGFiZWw9dG90YWwsIGNvbG9yID0gbWVyZ2UpKSArIAogIGdlb21fcG9pbnQoc3RhdD0naWRlbnRpdHknLCBmaWxsPSJibGFjayIsIHNpemU9NikgICsKICBnZW9tX3NlZ21lbnQoYWVzKHkgPSAwLCAKICAgICAgICAgICAgICAgICAgIHggPSBtZXJnZSwgCiAgICAgICAgICAgICAgICAgICB5ZW5kID0gdG90YWwsIAogICAgICAgICAgICAgICAgICAgeGVuZCA9IG1lcmdlKSkgKwogIGdlb21fdGV4dChjb2xvcj0id2hpdGUiLCBzaXplPTIpICsKICBsYWJzKHRpdGxlPSJEaXZlcmdpbmcgTG9sbGlwb3AgQ2hhcnQiLCAKICAgICAgIHN1YnRpdGxlPSIjIG9mIGZpcnN0IGNob2ljZSBwaWNrcyBmb3IgZWFjaCB0b3BwaW5nIiwKICAgICAgIHkgPSAiUGl6emEgVG9wcGluZ3MiLAogICAgICAgeCA9ICJUb3RhbCIpICsgCiAgeWxpbSgtNzUsIDEyNSkgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIpICsgCiAgY29vcmRfZmxpcCgpCgpWaXozCmBgYAoKVml6NDogUHJvdmlkZXMgZ3JlYXRlciBpbnNpZ2h0IG9uIHRvcHBpbmcgcHJlZmVyZW5jZSBhbmQgc2hvd3MgdGhhdCB0aGluZ3MgYXJlbid0IHdoYXQgdGhleSBzZWVtLiBBIGdvb2QgYW1vdW50IG9mIHBlb3BsZSBodGUgbXVzaHJvb21zIGFuZCBibGFjayBvbGl2ZXMgbWlnaHQgYmUgaGF0ZWQgYnV0IHRoZXkncmUgc3RpbGwgbG92ZWQgYnkgbWFueS4uLm1vcmUgcGVvcGxlIGp1c3QgaGF0ZSB0aGVtLiAKYGBge3J9CiMjIyMjIyMjIyMjIyMjIyMjI1ZpejQ6IERpdmVyZ2luZyBCYXIgUGxvdCMjIyMjIyMjIyMjIyMjIyMjIwpWaXo0XzEgPC0gVml6M18zCmNvbG5hbWVzKFZpejRfMSkgPC0gYygibWVyZ2UiLCAiRmF2ZXMiLCAiVW5mYXZlcyIsICJUb3RhbCIpClZpejQgPC0gZ2F0aGVyKFZpejRfMSwgInR5cGUiLCAiY291bnRzIiwgMjozKQoKVml6NF8yIDwtIGdncGxvdChWaXo0LCBhZXMoeCA9IG1lcmdlLCB5ID0gY291bnRzLCBmaWxsID0gdHlwZSkpICsgICAjIEZpbGwgY29sdW1uCiAgZ2VvbV9iYXIoc3RhdCA9ICJpZGVudGl0eSIsIHdpZHRoID0gLjYpICsgICAjIGRyYXcgdGhlIGJhcnMKICBzY2FsZV9maWxsX21hbnVhbCh2YWx1ZXMgPSBjKCJzdGVlbGJsdWUyIiwgInRvbWF0bzIiKSkgKwogIGNvb3JkX2ZsaXAoKSArICAjIEZsaXAgYXhlcwogIGxhYnModGl0bGU9IlRvcHBpbmcgRGl2ZXJnZW5jZSIsCiAgICAgICBmaWxsID0gIlByZWZlcmVuY2UiLAogICAgICAgeSA9ICJUb3BwaW5ncyIsCiAgICAgICB4ID0gIlZvdGVzIikKClZpejRfMgoKYGBgCgpWaXo1OiBUaGlzIHZpeiBkb2VzIGEgZ3JlYXQgam9iIG9mIHByb3ZpZGluZyBhbiBvdmVydmlldyBvZiBmYXZvcml0ZSB0b3BwaW5ncyBieSBjb3VudHJ5LiBUaGUgcHJvYmxlbSB0aGF0IGlzIGluaGVyZW50IHdpdGggdHJlZW1hcHMgaG93ZXZlciBpcyB0aGF0IGNhdGVnb3JpZXMgd2l0aCBsZXNzIHZhcmlhYmxlcyBhcmUgcHVzaGVkIHRvIHRoZSBjb3JuZXIgYW5kIG5vdCByZWFsbHkgc2Vlbi4KYGBge3J9CiMjIyMjIyMjIyMjIyMjIyMjI1ZpejU6IFRyZWVtYXAgUGl6emEgRWRpdGlvbiMjIyMjIyMjIyMjIyMjIyMjIwpmdG9wX3RvdGFsIDwtIGZpbmFsX2xpc3QgJT4lIAogIGdyb3VwX2J5KGZ0b3AxKSAlPiUgCiAgbXV0YXRlKGZhdmVfdG90YWxfY291bnQgPSBzdW0ocG9zX2NvdW50KSkKClZpejUgPC0gZ2dwbG90KGZ0b3BfdG90YWwsIGFlcyhhcmVhID0gZmF2ZV90b3RhbF9jb3VudCwgZmlsbCA9IGZ0b3AxLCBzdWJncm91cCA9IGNvdW50cnkpKSArCiAgZ2VvbV90cmVlbWFwKCkgKwogIGdlb21fdHJlZW1hcF9zdWJncm91cF9ib3JkZXIoY29sb3IgPSAid2hpdGUiLCBzaXplID0gMikgKwogIGdlb21fdHJlZW1hcF9zdWJncm91cF90ZXh0KHBsYWNlID0gImNlbnRyZSIsIGdyb3cgPSBULCBhbHBoYSA9IC43LCBjb2xvdXIgPSAiI0ZBRkFGQSIsIG1pbi5zaXplID0gMSkgKwogIGxhYnModGl0bGU9IlRyZWVtYXAgUGl6emEgRWRpdGlvbiIsIAogICAgICAgc3VidGl0bGU9IkZhdm9yaXRlIFRvcHBpbmcgRGlzdHJpYnV0aW9uIGJ5IENvdW50cnkiLCAKICAgICAgIGZpbGwgPSAiVG9wcGluZyBUeXBlIikKClZpejUKYGBgCg==