deep dive into a terrible graphic (laffer curve)

dat.csv

thingo.R

# context: https://twitter.com/realwokieleaks/status/1057798810804645893

# load data
dat <- read.csv("dat.csv")
# data slurped using the digitize R package


# "normal" fit
b <- gam(tax_rev~s(tax_rate), data=dat, method="REML")
# yes ignoring that the response is >0 for now...

# plot that, yeah that seems like it's okay?
par(mfrow=c(1,2))
plot(b, xlim=c(0, 50), ylim=c(0, 10), shift=coef(b)[1], shade=TRUE, main="not silly")

# which points shall we uber weight?
text(dat, labels=1:nrow(dat))
# UAE is 1
# Norway is 12

weights <- rep(1, nrow(dat))
weights[1] <- 1e5
weights[12] <- 1e5

# maxing out basis complexity, using weights
b_w <- gam(tax_rev~s(tax_rate, k=nrow(dat)-1), data=dat, method="REML", weights=weights)
plot(b_w, xlim=c(0, 50), ylim=c(0, 10), shift=coef(b)[1], n=200, shade=TRUE, main="silly")
points(dat)

Produces this graphic:

Sadly, the link at the top of the code doesn't yield the original graphic since some tweets have been deleted. Is it possible to archive that figure with this too, i.e., this link https://twitter.com/rlmcelreath/status/1191649370569166848 or ideally something more permanent.