Damage vector for life-cycle analysis

[show] This page is a knowledge crystal of subtype variable. The page identifier is Op_en5902
Moderator:Nobody (see all) Click here to sign up.
This page is a stub. You may improve it into a full page.
Upload data {{#opasnet_base_link:Op_en5902}}

Question

What are the damages per unit purchased commodity using a life-cycle assessment?

Rationale

Data

damagefactors(-)

Obs	Unique_categories	Human health	Ecosystem quality	Climate change	Resources	Water consumption
1	Carcinogens	0.0000028	0	0	0	0
2	Non-carcinogens	0.0000028	0	0	0	0
3	Respiratory inorganics	0.0007	0	0	0	0
4	Ionizing radiation	0.00000000021	0	0	0	0
5	Ozone layer depletion	0.00105	0	0	0	0
6	Respiratory organics	0.00000213	0	0	0	0
7	Aquatic ecotoxicity	0	0.0000502	0	0	0
8	Terrestrial ecotoxicity	0	0.00791	0	0	0
9	Terrestrial acidification/nutrification	0	1.04	0	0	0
10	Land occupation	0	1.09	0	0	0
11	Aquatic acidification	0	0	0	0	0
12	Aquatic eutrophication	0	0	0	0	0
13	Global warming	0	0	1	0	0
14	Non-renewable energy	0	0	0	1	0
15	Mineral extraction	0	0	0	1	0
16	Water withdrawal	0	0	0	0	0
17	Water consumption	0	0	0	0	1

Example of coffee cup

Coffee cup inputs(Euro)

Obs	Purchasing_sector	Result
1	31131A - Sugar cane mills and refining	0.1
2	112120 - Dairy cattle and milk production	0.2
3	311820 - Cookie, cracker, and pasta manufacturing	0.5
4	311920 - Coffee and tea manufacturing	0.2
5	221100 - Electric power generation, transmission, and distribution	0.1
6	322299 - All other converted paper product manufacturing	0.04
7	335210 - Small electrical appliance manufacturing	0
8	335221 - Household cooking appliance manufacturing	0.01

Formula

+ Show code- Hide code library(OpasnetUtils) library(xtable) library(ggplot2) library(reshape2) show_bins <- 10 # How many different direct inputs to show? # Take the damage factor table from this page. damagesPerImpact <- opbase.data("Op_en5902.damagefactors") # Download the data from Opasnet Base. damagesPerImpact <- reshape( # Reshape it into the wide format. damagesPerImpact[ , colnames(damagesPerImpact) != "Obs"], # Data to be reshaped times = "Result", # Column(s) to be reshaped timevar = "Unique_categories", # Column identifiers idvar = "Damage_categories", # Row identifiers direction = "wide" # Reshape from long to wide format ) colnames(damagesPerImpact) <- gsub("Result.", "", colnames(damagesPerImpact)) # Remove extra "Result." from colnames. rownames(damagesPerImpact) <- damagesPerImpact[[1]] # Make the first column the rownames. damagesPerImpact[1] <- NULL # Remove the first column. oprint(damagesPerImpact) damagesPerImpact <- t(as.matrix(damagesPerImpact)) # Turn the data.frame into a matrix and transpose it. # Take the impact factor table from the database. Do the same procedures as with damagesPerImpact. impactsPerDollar <- opbase.data("Op_en5902") impactsPerDollar <- reshape( impactsPerDollar, times = "Result", timevar = "Unique_categories", idvar = "Purchasing_sector", direction = "wide" ) colnames(impactsPerDollar) <- gsub("Result.", "", colnames(impactsPerDollar)) rownames(impactsPerDollar) <- impactsPerDollar[[1]] impactsPerDollar[1] <- NULL #oprint(impactsPerDollar) impactsPerDollar <- as.matrix(impactsPerDollar) # Take the coffee cup direct requirements. coffee <- opbase.data("Op_en5902.coffeecupinputs") # Download the data from Opasnet Base. coffee$Obs <- NULL # Remove the redundant Obs column. cat("Primary prosesses related to a cup of coffee (in Euro)\n") oprint(coffee) # Combine the direct requirements of a coffee cup with a full vector of requirements and fill empty cells with 0. coffee <- merge(data.frame(directRequirements = rownames(impactsPerDollar)), coffee, all.x = TRUE) coffee$Result[is.na(coffee$Result)] <- 0 # Get the normalisation data for different damages and make an ovariable out of it. # temp <- tidy(opbase.data("Op_en5904"), objname="normalisation") temp <- opbase.data("Op_en5904") temp$Obs <- NULL normalisation <- EvalOutput(new("ovariable", name = "normalisation", data = temp )) oprint(normalisation@data) impactsPerDollar <- impactsPerDollar * coffee$Result # Multiply data matrix with activities. out <- impactsPerDollar %*% damagesPerImpact # Do a matrix multiplication # After matrix operations, turn out into a data.frame for graphics. out <- as.data.frame(out) out$directRequirements <- rownames(out) out <- melt(out, idvars = "directRequirements", variable_name = "damages") # Reshape into long format sums <- as.data.frame(as.table(tapply(out$value, out["directRequirements"], sum))) limit <- sort(sums$Freq, decreasing = TRUE)[show_bins] keeps <- sums[sums$Freq > limit , "directRequirements"] out$directRequirements <- as.factor(ifelse(out$directRequirements %in% keeps, out$directRequirements, "Other")) #out <- out[out$value >= sum(out$value) * limit , ] # Remove all rows with smaller values than the limit. out <- dropall(out) # Alternative approach: very small values of B are merged to "Other" category in A: temp$A as.factor(ifelse(temp$B <= 6, "Other", temp$A)) # Rename the columns to reflect actual things. colnames(out)[colnames(out) == "value"] <- "Result" damages <- EvalOutput(new("ovariable", name = "damages", data = out)) # Make an ovariable damageFractions <- damages / normalisation * 365 # Normalise and scale to daily values. # Plot results on a bar graph. cat("Effects smaller than", limit*100, "% of the total effect are not shown.\n") #oprint(damageFractions) ggplot(damageFractions@output, aes(x = Damage, weight = Result, fill = directRequirements)) + geom_bar() + theme_grey(base_size = 24) + theme(axis.text.x = element_text(angle = 45)) + labs( title = "Life cycle impacts of a cup of coffee", x = "Damage", y = "Amount" )

Related files

<mfanonymousfilelist></mfanonymousfilelist>