GDRs logo

Greenhouse Development Rights Online Calculator

document.getElementById("throbtext").innerHTML = " Loading data... "

if (length(ls(pattern="gdrs.par.repyear")) == 0) {
    # Version information
    source(RpadBaseURL("VERSION.R"))
    # Defaults and constants
    gdrs.par.repyear.txt = "2020"
    gdrs.par.repyear = as.numeric(gdrs.par.repyear.txt)
    gdrs.par.emergstart.txt = "2012"
    gdrs.par.emergstart = as.numeric(gdrs.par.emergstart.txt)
    gdrs.par.numdec.txt = "1"
    gdrs.par.prog = 1
    gdrs.par.method = "sum"
    gdrs.const.start = 1990
    gdrs.const.repstart = 1990
    gdrs.const.end = 2030
    gdrs.par.emissElast = 1
    gdrs.par.Cbill = 1
    # Data files
    gdrs.iso3 = read.csv(RpadBaseURL('gdrs.iso3.csv'))
    gdrs.noregrets = read.csv(RpadBaseURL('gdrs.noregrets.csv'))
    gdrs.emergpath = read.csv(RpadBaseURL('gdrs.emergpath.csv'))
    gdrs.gdp = read.csv(RpadBaseURL('gdrs.gdp.csv'))
    gdrs.pop = read.csv(RpadBaseURL('gdrs.pop.csv'))
    gdrs.base = read.csv(RpadBaseURL('gdrs.base.csv'))
    gdrs.bau = read.csv(RpadBaseURL('gdrs.bau.csv'))
    # Lists
    regionlist = c(
        "( 1) High Income",
        "( 2) Upper Middle Income",
        "( 3) Lower Middle Income",
        "( 4) Low Income",
        "( 5) Annex I",
        "( 6) Non-Annex I",
        "( 7) EITs",
        "( 8) LDCs",
        "( 9) EU 15",
        "(10) EU +12",
        "(11) EU 27",
        "(12) World"
    )
    ctrylist = c("--All--", regionlist, levels(gdrs.iso3[,2]))
    ctrydefault = c(2:13, 48, 89, 199)
    disp.ctry = ctrylist[1]
    v.dlnorm <- Vectorize(dlnorm, c("meanlog", "sdlog"))
    v.plnorm <- Vectorize(plnorm, c("meanlog", "sdlog"))
    quickfmt <- function(fmt, val) {
       as.numeric(sprintf(fmt, val))
    }
    v.quickfmt <- Vectorize(quickfmt, c("fmt", "val"))
    source(RpadBaseURL("altelems.R"))
}

HTMLon()
Emergency program start: 2012
Report year:
Report tax for income:
  
            disp.ctry = ctrylist[ctrydefault]
            HTMLon()
            gdrsHTMLselect("disp.ctry", ctrylist, default=ctrydefault, size=7, multiple="true",
            onchange="javascript:showAlert('Table is out of date - click Calculate')")
Development threshold
Bill as % GWP 1.0
Responsibility weight 
HTMLon()
H("table",
    H("tr",
        H("td",
            H("ul",
               H("li", HTMLlink(url="gdrs.core.xls", text="Data used to calculate the table")),
               H("li", HTMLlink(url=RpadURL("gdrs.out.csv"), text="Table as a CSV file")),
               H("li", HTMLlink(url=RpadURL("gdrs.rci.csv"), text="RCI over time as a CSV file")),
               H("li", HTMLlink(url=RpadURL("gdrs.alloc.csv"), text="GDRs allocations over time as a CSV file"))
            )
        )
    )
)
Calculate
Help
 
document.getElementById("throbtext").innerHTML = " Calculating RCI... "

gdrs.par.repyear = as.numeric(gdrs.par.repyear.txt)
gdrs.par.emergstart = as.numeric(gdrs.par.emergstart.txt)
gdrs.par.repincome = as.numeric(gdrs.par.repincome.txt)
gdrs.par.yl = as.numeric(gdrs.par.yl.txt)
gdrs.par.Rexp = as.numeric(gdrs.par.Rexp.txt)
source(RpadBaseURL("gdrsfuncs.R"))

tmp.i = 1
repeat {
    tmp.fname = sprintf("cache/gdc%010d.csv", tmp.i)
    if (!file.exists(RpadBaseURL(tmp.fname))) {break}
    tmp.i = tmp.i + 1
}
if (!file.exists(RpadBaseURL('cache/files.csv'))) {
    files.dat <- data.frame(gdrs.par.repyear, gdrs.par.repincome, gdrs.par.yl,
        gdrs.par.Cbill, gdrs.par.Rexp, gdrs.par.emissElast,
        gdrs.par.fname=tmp.fname, stringsAsFactors=FALSE)
    write.csv(files.dat, RpadBaseURL('cache/files.csv'), row.names=FALSE)
} else {
    files.dat <- read.csv(RpadBaseURL('cache/files.csv'), stringsAsFactors=FALSE)
}

gdrs.par.fname <- files.dat[files.dat$gdrs.par.repyear==gdrs.par.repyear &
    files.dat$gdrs.par.repincome==gdrs.par.repincome &
    files.dat$gdrs.par.yl==gdrs.par.yl &
    files.dat$gdrs.par.Cbill==gdrs.par.Cbill &
    files.dat$gdrs.par.Rexp==gdrs.par.Rexp &
    files.dat$gdrs.par.emissElast==gdrs.par.emissElast,]$gdrs.par.fname

if (is.null(gdrs.par.fname) || length(gdrs.par.fname)==0) {
    files.dat <- rbind(files.dat, data.frame(gdrs.par.repyear, gdrs.par.repincome, gdrs.par.yl,
        gdrs.par.Cbill, gdrs.par.Rexp, gdrs.par.emissElast,
        gdrs.par.fname=tmp.fname, stringsAsFactors=FALSE))
    write.csv(files.dat, RpadBaseURL('cache/files.csv'), row.names=FALSE)
    gdrs.par.fname <- tmp.fname
}
gdrs.par.rootname = substr(gdrs.par.fname, 1, nchar(gdrs.par.fname)-4)
lUseCache = file.exists(RpadBaseURL(gdrs.par.fname))

if (lUseCache) {
    gdrs.dat <- read.csv(RpadBaseURL(gdrs.par.fname))
} else {
    source(RpadBaseURL("bldgdrsdat.R"))
    write.csv(gdrs.dat, RpadBaseURL(gdrs.par.fname), row.names=FALSE)
}

document.getElementById("throbtext").innerHTML = " Building tables... "

tmp.out.fname = RpadBaseURL(sprintf("%s.out.csv", gdrs.par.rootname))
tmp.ts.rci.fname = RpadBaseURL(sprintf("%s.ts.rci.csv", gdrs.par.rootname))
tmp.ts.alloc.fname = RpadBaseURL(sprintf("%s.ts.alloc.csv", gdrs.par.rootname))

if (lUseCache) {
    gdrs.out.csv <- read.csv(tmp.out.fname)
    tmp.ts.rci <- read.csv(tmp.ts.rci.fname)
    tmp.ts.alloc <- read.csv(tmp.ts.alloc.fname)
} else {
    source(RpadBaseURL("bldtables.R"))
    write.csv(gdrs.out.csv, tmp.out.fname, row.names=FALSE)
    write.csv(tmp.ts.rci, tmp.ts.rci.fname, row.names=FALSE)
    write.csv(tmp.ts.alloc, tmp.ts.alloc.fname, row.names=FALSE)
}
# Version string
tmp.ver.string <- sprintf("Greenhouse Development Rights Online Calculator\nLast updated %s\nCalculator version %s\nData version %s", ver["update"], ver["calc"], ver["data"])
# Settings string
tmp.settings.string <- sprintf("Development threshold: $%.2f\nBill as %%GWP: %.2f\nResponsibility weight: %.2f", gdrs.par.yl, gdrs.par.Cbill, gdrs.par.Rexp);
# Main output file
write(tmp.ver.string, file="gdrs.out.csv")
write(tmp.settings.string, file="gdrs.out.csv", append=TRUE)
write(sprintf("Report year: %s\nReport tax at income: %.2f", gdrs.par.repyear.txt, gdrs.par.repincome), file="gdrs.out.csv", append=TRUE)
write.csv(gdrs.out.csv, "gdrs.out.csv", row.names=FALSE, append=TRUE)

# Additional tables to report
write(tmp.ver.string, file="gdrs.rci.csv")
write(tmp.settings.string, file="gdrs.rci.csv", append=TRUE)
write.csv(tmp.ts.rci, "gdrs.rci.csv", row.names=FALSE, append=TRUE)

write(tmp.ver.string, file="gdrs.alloc.csv")
write(tmp.settings.string, file="gdrs.alloc.csv", append=TRUE)
write.csv(tmp.ts.alloc, "gdrs.alloc.csv", row.names=FALSE, append=TRUE)


tmp.names.short = c("Country or Region")
gdrs.out <- data.frame(gdrs.out.csv[,1])

tmp.fmt = paste("%.", gdrs.par.numdec.txt, "f", sep="")
tmp.fmt.list = rep(tmp.fmt,length(gdrs.out.csv[,1]))

tmp.i = 1

tmp.i = tmp.i + 1
tmp.name = "Share of Global Population (%)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, pop.share = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "GDP per capita ($PPP/cap)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, natl.inc.pc = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "Population above the development threshold (% nat'l pop)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, hi.popshare = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "Share of Global RCI (%)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, rci.share = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "Obligation to pay (% GDP)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, tax.perc = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "Obligation per person above the development threshold ($PPP/cap)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, tax.per.taxpayer = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "Tax at specified income (% income)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, tax.at.income = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "Emissions allocation (MtC)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, alloc = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "Emissions alloc (% 1990)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, allocperc = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "BAU emissions (% 1990)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, bauperc = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

tmp.i = tmp.i + 1
tmp.name = "No-regrets emissions (% 1990)"
tmp.names.short = c(tmp.names.short, tmp.name)
gdrs.out <- transform(gdrs.out, nrperc = v.quickfmt(tmp.fmt.list, gdrs.out.csv[,tmp.i]))

names(gdrs.out) <- tmp.names.short

if (disp.ctry == ctrylist[1]) {
    tmp.disp.table = gdrs.out
} else {
    tmp.disp.list <- gdrs.out.csv[,1] %in% disp.ctry
    tmp.disp.table = gdrs.out[tmp.disp.list,]
}
HTMLon()

Rpad:::asFilteringTable(format(tmp.disp.table, scientific=F, big.mark=","))
rm(list=ls(pattern="tmp.*"))

document.getElementById("throbtext").innerHTML = ""

HTMLon();
H("div", class="footer1", "Copyright &copy; 2008-2009 EcoEquity and Stockholm Environment Institute - For information contact ",
    H("a", href="mailto:calculator@gdrights.org", "calculator@gdrights.org"))
H("div", class="footer2", sprintf("Last updated %s - Calculator version %s - Data version %s", ver["update"], ver["calc"], ver["data"]))