Interactive Visualisation of the Profitable Amount of Waste to Dispose Illegally

September 30, 2014
By

(This article was first published on Misanthrope's Thoughts, and kindly contributed to R-bloggers)

“Wow!” – I said to myself after reading R Helps With Employee Churn post – “I can create interactive plots in R?!!! I have to try it out!”

I quickly came up with an idea of creating interactive plot for my simple model for assessment of the profitable ratio between the volume waste that could be illegally disposed and costs of illegal disposal [Ryabov Y. (2013) Rationale of mechanisms for the land protection from illegal dumping (an example from the St.-Petersburg and Leningrad region). Regional Researches. №1 (39), p. 49-56]. The conditions for profitable illegal dumping can be describes as follows:

Here: k – the probability of being fined for illegal disposal of waste;
P – maximum fine for illegal disposal of waste (illegal dumping);
V – volume of waste to be [illegally] disposed by the waste owner;
E – costs of illegal disposal of waste per unit;
T – official tax for waste disposal per unit.

The conditions for the profitable landfilling can be described as follows:

Here: V1 – total volume of waste that is supposed to be disposed at illegal landfill;
Tc – tax for disposal of waste at illegal landfill per unit;
P1 – maximum fine for illegal landfilling;
E1 – expenditures of the illegal landfill owner for disposal of waste per unit.

Lets plot the graphs (with some random numbers (except for fines) for a nice looking representation) to have a clue how it looks like.

Note that there is a footnote (this post provides nice examples on how to do it) with the values used for plotting – it is important to have to have this kind of indication if we want to create a series of plots.

Now I will show you the result and then will provide the code and some tips.

Playing with the plot

Tips and Tricks

Before I will show you code I want to share my hardly earned knowledge about nuances of the manipulate library. There are several ways to get static plot like that using ggplot, but some of them will fail to be interactive with manipulate.

  1. All the data for the plot must be stored in one dataframe.
  2. All data for plots must be derived from the dataframe (avoid passing single variables to ggplot).
  3. Do not use geom_hline() for the horizontal line – generate values for this line and store them inside dataframe and draw as a regular graph.
  4. To create a footnote (to know exactly which parameters were used for the current graph) use arrangeGrob() function from the gridExtra library.
  5. Always use $ inside aes() settings to address columns of your dataframe if you want plots to be interactive

The Code


library(ggplot2)
library(grid)
library(gridExtra)
library(manipulate)
library(scales)
library(reshape2)

## Ta --- official tax for waste utilisation per tonne or cubic metre.
## k --- probability of getting fined for illegal dumping the waste owner (0## P --- maximum fine for the waste owner if he got cought.
## V --- waste wolume (tonns or cubic meters).
## E --- waste owner expenditures for waste utilisation / removal.
## x <=> V, y <=> E

max_waste_volume <- 2000
Illegal_dumping_fine_P <- 300000
Illigal_landfilling_fine_P1 <- 500000
Fine_probability_k <- 0.5
Official_tax_Ta <- 600

# mwv = max_waste_volume
# P = Illegal_dumping_fine_P
# P1 = Illigal_landfilling_fine_P1
# k = Fine_probability_k
# Ta = Official_tax_Ta

updateData <- function(mwv, k, P1, P, Ta){

# creates and(or) updates global data frame to provide data for the plot

new_data <<- NULL
new_data <<- as.data.frame(0:mwv)
names(new_data) <<- 'V'
new_data$IlD <<- k*P1/new_data$V
new_data$IlD_fill <<- new_data$IlD
new_data$IlD_fill[new_data$IlD_fill > Ta] <<- NA # we don't want ribbon to fill area above Official tax
new_data$IlL <<- Ta-k*P/new_data$V

new_data$Ta <<- Ta
new_data$zero <<- 0
dta <<- melt(new_data, id.vars="V", measure.vars=c("IlD", "IlL", "Ta"))
dta.lower <<- melt(new_data, id.vars="V", measure.vars=c("IlD_fill", "zero", "Ta"))
dta.upper <<- melt(new_data, id.vars="V", measure.vars=c("Ta", "IlL", "Ta"))
dta <<- cbind(dta, lower=dta.lower$value, upper=dta.upper$value)
dta$name <<- factor(NA, levels=c("Illegal landfill owner'snprofitable ratio",
"Waste owner'snprofitable ratio",
"Official tax"))
dta$name[dta$variable=="IlD"] <<- "Illegal landfill owner'snprofitable ratio"
dta$name[dta$variable=="IlL"] <<- "Waste owner'snprofitable ratio"
dta$name[dta$variable=="Ta"] <<- "Official tax"
}

updateLabels <- function(k, P1, P, Ta){

### creates footnote caption for the plot

prob <- paste('Fining probability = ', k, sep = '')
landfilling_fine <- paste('Illegal landfilling fine = ', P1, sep = '')
dumping_fine <- paste('Illegal dumping fine = ', P, sep = '')
tax <- paste('Official tax = ', Ta, sep = '')
note <<- paste(prob, landfilling_fine, sep = '; ')
note <<- paste(note, dumping_fine, sep = '; ')
note <<- paste(note, tax, sep = '; ')
note
}


plotDumping <- function(mwv, P, P1, k, Ta){

### this function draws the plot

# initialise plot data
updateData(mwv, k, P1, P, Ta)
updateLabels(k, P1, P, Ta)

# draw the plot
profit <- ggplot(dta, aes(x=dta$V, y=dta$value, ymin=dta$lower, ymax=dta$upper,
color=dta$name, fill=dta$name, linetype=dta$name)) +
geom_line(size=1.2) +
geom_ribbon(alpha=.25, linetype=0) +
theme(axis.text.x = element_text(angle=0, hjust = 0),
axis.title = element_text(face = 'bold', size = 14),
title = element_text(face = 'bold', size = 16),
legend.position = 'right',
legend.title = element_blank(),
legend.text = element_text(size = 12),
legend.key.width = unit(2, 'cm'),
legend.key.height = unit(1.2, 'cm'))+
scale_linetype_manual(values=c(4, 5, 1)) +
scale_fill_manual(values = c("#F8766D","#00BFC4",NA)) +
scale_color_manual(values = c("#F8766D","#00BFC4", '#66CD00')) +
labs(title="Profitable ratio between the volume nof illegally disposed waste nand costs of illegal disposal of waste",
x="Waste volume, cubic meters",
y="Cost per cubic meter, RUB") +
xlim(c(0, max(new_data$V)))+
ylim(c(0, Ta*1.5))


# add a footnote about paramaters used for the current plot
profit <- arrangeGrob(profit,
sub = textGrob(note,
x = 0,
hjust = -0.1,
vjust=0.1,
gp = gpar(fontface = "italic", fontsize = 12)))

# show plot
print(profit)

}


simDumping <- function(max_waste_volume = 2000,
Illegal_dumping_fine_P = 300000,
Illigal_landfilling_fine_P1 = 500000,
Fine_probability_k = 0.5,
Official_tax_Ta = 600) {

### this function creates interactive plot

max_waste_volume <<- max_waste_volume
Illegal_dumping_fine_P <<- Illegal_dumping_fine_P
Illigal_landfilling_fine_P1 <<- Illigal_landfilling_fine_P1
Fine_probability_k <<- Fine_probability_k
Official_tax_Ta <<- Official_tax_Ta

manipulate(suppressWarnings(plotDumping(max_waste_volume,
Illegal_dumping_fine_P,
Illigal_landfilling_fine_P1,
Fining_probability_k,
Official_tax_Ta)
),

# set up sliders
max_waste_volume = slider(0, 50000,
initial = max_waste_volume,
step = 100,
label = 'X axis range'),
Illegal_dumping_fine_P = slider(0, 5000000,
initial = Illegal_dumping_fine_P,
step = 10000,
label = 'Illegal dumping fine (P)'),
Illigal_landfilling_fine_P1 = slider(0, 5000000,
initial = Illigal_landfilling_fine_P1,
step = 10000,
label = 'Illegal landfilling fine (P1)'),
Fining_probability_k = slider(0, 1,
initial = 0.5,
step = 0.01,
label = 'Probability of being fined (k)'),
Official_tax_Ta = slider(0, 3000,
initial = Official_tax_Ta,
step = 50,
label = 'Official waste disposal tax (T)')
)
}

simDumping() # for reasons unknown I have to run this function twice to get proper interactive plot

To leave a comment for the author, please follow the link and comment on their blog: Misanthrope's Thoughts.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)