personal/nunosempere.com
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tweak: Order by cummulative area amount.

Browse Source
This commit is contained in:
NunoSempere 2022-11-21 22:25:48 +00:00
parent eebca66403
commit 62168b7cb8
1 changed files with 29 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
blog/2022/11/20/brief-update-ea-funding/.source/analysis.R
View File

@ -4,7 +4,7 @@
### Install
# install.packages("ggplot2")
#install.packages("readr")
# install.packages("readr")
### Load
library("ggplot2")
@ -14,7 +14,6 @@ library("magrittr")
library("RColorBrewer")
library("ggsci")
## Data import
setwd("/home/loki/Documents/core/ea/fresh/misc/openphil-funding")
data <- read.csv("grants.csv", header=TRUE, stringsAsFactors = FALSE)
@ -32,13 +31,12 @@ df$year <- as.vector(sapply(data$Date, getYear))
df$amount <- as.vector(sapply(data$Amount, parse_number))
df$amount <- ifelse(is.na(df$amount), 0, df$amount)
df$area <- as.vector(data$Focus.Area)
df <- as.data.frame(df)
## View(df)
df$area <- as.vector(data$Focus.Area)
df$area <- as.vector(data$Focus.Area) # not sure why this line is needed, but things break otherwise
# View(df)
## Classify according to areas
areas <- unique(df$area)
ea_growth <- c("Effective Altruism Community Growth", "Effective Altruism Community Growth (Global Health and Wellbeing)")
global_health <- c("South Asian Air Quality", "Human Health and Wellbeing", "GiveWell-Recommended Charities", "Global Aid Policy", "Global Health & Wellbeing", "Global Health & Development","Science for Global Health")
longtermism <- c("Biosecurity & Pandemic Preparedness", "Potential Risks from Advanced AI", "Science Supporting Biosecurity and Pandemic Preparedness", "Longtermism")
@ -56,7 +54,6 @@ df$area <- ifelse(df$area %in% scientific_research, "Scientific Research", df$ar
df$area <- ifelse(df$area %in% politicy_advocacy, "Policy Advocacy", df$area)
df$area <- ifelse(df$area %in% other, "Other", df$area)
df$area
# df <- df[order(df$area),]
## Aggregate by year and area
years <- c(2014: 2022)# as.vector(unique(df$year))
@ -68,32 +65,41 @@ df2 <- list()
df2$area <- sort(rep(area_names, num_years))
df2$year <- rep(years, num_areas)
df2 <- as.data.frame(df2)
# View(df2)
getAmountForYearAreaPair <- function(target_year, target_area){
getAmountForYearAreaPair <- function(a_df, target_year, target_area){
filter = dplyr::filter
# target_year = 2022
# target_area = "Longtermism"
rows = df %>% filter(year == target_year) %>% filter(area == target_area)
rows = a_df %>% filter(year == target_year) %>% filter(area == target_area)
return(sum(rows$amount))
}
getAmountForYearAreaPair(2022, "Longtermism")
getAmountForYearAreaPair(df, 2022, "Longtermism & GCRs")
getAmountForArea <- function(a_df, target_area){
filter = dplyr::filter
rows = a_df %>% filter(area == target_area)
return(sum(rows$amount))
}
getAmountForArea(df, "Longtermism & GCRs")
amounts <- c()
for(i in c(1:dim(df2)[1])){
amount <- getAmountForYearAreaPair(df2$year[i], df2$area[i])
amount <- getAmountForYearAreaPair(df2, df2$year[i], df2$area[i])
amounts <- c(amounts, amount)
}
df2$amount <- amounts
# View(df2)
## Order by cummulative amount
df2$cummulative_amount_for_its_area = sapply(df2$area, function(area) {
return(getAmountForArea(df, area))
})
## Plotting
title_text="Open Philanthropy allocation by year and cause area"
subtitle_text="with my own aggregation of categories"
palette = "Classic Red-Blue"
direction = -1
open_philanthropy_plot <- ggplot(data=df2, aes(x=year, y=amount, fill=area))+
open_philanthropy_plot <- ggplot(data=df2, aes(x=year, y=amount, fill=area, group = cummulative_amount_for_its_area))+
geom_bar(stat="identity")+
labs(
title=title_text,
@ -123,6 +129,7 @@ open_philanthropy_plot <- ggplot(data=df2, aes(x=year, y=amount, fill=area))+
legend.text=element_text(size=7, hjust = 0.5)
) +
guides(fill=guide_legend(nrow=3,byrow=TRUE))
open_philanthropy_plot
getwd() ## Working directory on which the file will be saved. Can be changed with setwd("/your/directory")
height = 5
width = 5
@ -134,7 +141,7 @@ wealth <- c(6, 8, 12, 15, 18, 12, 14, 19, 14)
df2$wealth <- rep(wealth * coeff, num_areas)
make_fortune_plot <- function(show_fortune_legend = FALSE) {
open_philanthropy_plot_with_fortune <- ggplot(data=df2, aes(x=year, y=amount, fill=area))+
open_philanthropy_plot_with_fortune <- ggplot(data=df2, aes(x=year, y=amount, fill=area, group = cummulative_amount_for_its_area))+
geom_bar(stat="identity")+
geom_point(
aes(x=year, y=wealth), size=2, color="darkblue", shape=4,
@ -209,7 +216,6 @@ df3 <- as.data.frame(df3)
df3$area <- as.vector(data$Focus.Area)
df3 <- df3 %>% dplyr::filter(area %in% longtermism)
# View(df3)
df3
years <- c(2014: 2022) # as.vector(unique(df$year))
num_years <- length(years)
@ -229,13 +235,15 @@ for(i in c(1:dim(df4)[1])){
amounts <- c(amounts, amount)
}
df4$amount <- amounts
df4$cummulative_amount_for_its_area = sapply(df4$area, function(area) {
return(getAmountForArea(df3, area))
})
## Plotting longtermist funding
title_text="Open Philanthropy allocation by year and cause area"
subtitle_text="restricted to longtermism & GCRs"
palette = "Classic Red-Blue"
direction = -1
open_philanthropy_plot_lt <- ggplot(data=df4, aes(x=year, y=amount, fill=area, group=amount))+
open_philanthropy_plot_lt <- ggplot(data=df4, aes(x=year, y=amount, fill=area, group=cummulative_amount_for_its_area))+
geom_bar(stat="identity")+
labs(
title=title_text,
@ -268,5 +276,5 @@ open_philanthropy_plot_lt <- ggplot(data=df4, aes(x=year, y=amount, fill=area, g
getwd() ## Working directory on which the file will be saved. Can be changed with setwd("/your/directory")
height = 5
width = 6
open_philanthropy_plot_lt
ggsave(plot=open_philanthropy_plot_lt, "open_philanthropy_grants_lt.png", width=width, height=height, bg = "white")
## open_philanthropy_plot_lt
ggsave(plot=open_philanthropy_plot_lt, "open_philanthropy_grants_lt.png", width=width, height=height, bg = "white")