plot an item map (based on difficulties) - r

I have a data set of item difficulties that correspond to items on a questionnaire that looks like this:
## item difficulty
## 1 ITEM_01_A 2.31179818
## 2 ITEM_02_B 1.95215238
## 3 ITEM_03_C 1.93479536
## 4 ITEM_04_D 1.62610855
## 5 ITEM_05_E 1.62188759
## 6 ITEM_06_F 1.45137544
## 7 ITEM_07_G 0.94255210
## 8 ITEM_08_H 0.89941812
## 9 ITEM_09_I 0.72752197
## 10 ITEM_10_J 0.61792597
## 11 ITEM_11_K 0.61288399
## 12 ITEM_12_L 0.39947791
## 13 ITEM_13_M 0.32209970
## 14 ITEM_14_N 0.31707701
## 15 ITEM_15_O 0.20902108
## 16 ITEM_16_P 0.19923607
## 17 ITEM_17_Q 0.06023317
## 18 ITEM_18_R -0.31155481
## 19 ITEM_19_S -0.67777282
## 20 ITEM_20_T -1.15013758
I want to make an item map of these items that looks similar (not exactly) to this (I created this in word but it lacks true scaling as I just eyeballed the scale). It's not really a traditional statistical graphic and so I don't really know how to approach this. I don't care what graphics system this is done in but I am more familiar with ggplot2 and base.
I would greatly appreciate a method of plotting this sort of unusual plot.
Here's the data set (I'm including it as I was having difficulty using read.table on the dataframe above):
DF <- structure(list(item = c("ITEM_01_A", "ITEM_02_B", "ITEM_03_C",
"ITEM_04_D", "ITEM_05_E", "ITEM_06_F", "ITEM_07_G", "ITEM_08_H",
"ITEM_09_I", "ITEM_10_J", "ITEM_11_K", "ITEM_12_L", "ITEM_13_M",
"ITEM_14_N", "ITEM_15_O", "ITEM_16_P", "ITEM_17_Q", "ITEM_18_R",
"ITEM_19_S", "ITEM_20_T"), difficulty = c(2.31179818110545, 1.95215237740899,
1.93479536058926, 1.62610855327073, 1.62188759115818, 1.45137543733965,
0.942552101641177, 0.899418119889782, 0.7275219669431, 0.617925967008653,
0.612883990709181, 0.399477905189577, 0.322099696946661, 0.31707700560997,
0.209021078266059, 0.199236065264793, 0.0602331732900628, -0.311554806052955,
-0.677772822413495, -1.15013757942119)), .Names = c("item", "difficulty"
), row.names = c(NA, -20L), class = "data.frame")
Thank you in advance.

Here is a quick example:
ggplot(DF, aes(x=1, y=difficulty, label = item)) +
geom_text(size = 3) +
scale_y_continuous(breaks = DF$difficulty, minor_breaks = NULL, labels = sprintf("%.02f", DF$difficulty)) +
scale_x_continuous(breaks = NULL) +
opts(panel.grid.major = theme_blank())
but sometimes two items are too narrow so overlapped. You may do like this:
m <- 0.1
nd <- diff(rev(DF$difficulty))
nd <- c(0, cumsum(ifelse(nd < m, m, nd)))
DF$nd <- rev(rev(DF$difficulty)[1] + nd)
ggplot(DF, aes(x=1, y=nd, label = item)) +
geom_text(size = 3) +
scale_y_continuous(breaks = DF$nd, labels = sprintf("%.02f", DF$difficulty), DF$difficulty, minor_breaks = NULL) +
scale_x_continuous(breaks = NULL) +
opts(panel.grid.major = theme_blank())

Here is a solution with base graphics.
# Compute the position of the labels to limit overlaps:
# move them as little as possible, but keep them
# at least .1 units apart.
library(quadprog)
spread <- function(b, eps=.1) {
stopifnot(b == sort(b))
n <- length(b)
Dmat <- diag(n)
dvec <- b
Amat <- matrix(0,nr=n,nc=n-1)
Amat[cbind(1:(n-1), 1:(n-1))] <- -1
Amat[cbind(2:n, 1:(n-1))] <- 1
bvec <- rep(eps,n-1)
r <- solve.QP(Dmat, dvec, Amat, bvec)
r$solution
}
DF <- DF[ order(DF$difficulty), ]
DF$position <- spread(DF$difficulty, .1)
ylim <- range(DF$difficulty)
plot( NA,
xlim = c(.5,2),
ylim = ylim + .1*c(-1,1)*diff(ylim),
axes=FALSE, xlab="", ylab=""
)
text(.9, DF$position, labels=round(DF$difficulty,3), adj=c(1,0))
text(1.1, DF$position, labels=DF$item, adj=c(0,0))
arrows(1,min(DF$position),1,max(DF$position),code=3)
text(1,min(DF$position),labels="Easier",adj=c(.5,2))
text(1,max(DF$position),labels="More difficult",adj=c(.5,-1))
text(.9, max(DF$position),labels="Difficulty",adj=c(1,-2))
text(1.1,max(DF$position),labels="Item", adj=c(0,-2))

My own attempt but I think I'm going to like Vincent's solution much better as it looks like my original specification.
DF <- DF[order(DF$difficulty), ]
par(mar=c(1, 1, 3, 0)+.4)
plot(rep(1:2, each=10), DF$difficulty, main = "Item Map ",
ylim = c(max(DF$difficulty)+1, min(DF$difficulty)-.2),
type = "n", xlab="", ylab="", axes=F, xaxs="i")
text(rep(1.55, 20), rev(DF$difficulty[c(T, F)]),
DF$item[c(F, T)], cex=.5, pos = 4)
text(rep(1, 20), rev(DF$difficulty[c(F, T)]),
DF$item[c(T, F)], cex=.5, pos = 4)
par(mar=c(0, 0, 0,0))
arrows(1.45, 2.45, 1.45, -1.29, .1, code=3)
text(rep(1.52, 20), DF$difficulty[c(T, F)],
rev(round(DF$difficulty, 2))[c(T, F)], cex=.5, pos = 2)
text(rep(1.44, 20), DF$difficulty[c(F, T)],
rev(round(DF$difficulty, 2))[c(F, T)], cex=.5, pos = 2)
text(1.455, .5, "DIFFICULTY", cex=1, srt = -90)
text(1.45, -1.375, "More Difficult", cex=.6)
text(1.45, 2.5, "Easier", cex=.6)
par(mar=c(0, 0, 0,0))

Related

R: How to plot multiple ARIMA forecasts on the same time-series

I would like to plot several forecasts on the same plot in different colours, however, the scale is off.
I'm open to any other methods.
reproducible example:
require(forecast)
# MAKING DATA
data <- c(3.86000, 19.55810, 19.51091, 20.74048, 20.71333, 29.04191, 30.28864, 25.64300, 23.33368, 23.70870 , 26.16600 ,27.61286 , 27.88409 , 28.41400 , 24.81957 , 24.60952, 27.49857, 32.08000 , 29.98000, 27.49000 , 237.26150, 266.35478, 338.30000, 377.69476, 528.65905, 780.00000 )
a.ts <- ts(data,start=c(2005,1),frequency=12)
# FORECASTS
arima011_css =stats::arima(x = a.ts, order = c(0, 1, 1), method = "CSS") # css estimate
arima011_forecast = forecast(arima011_css, h=10, level=c(99.5))
arima321_css =stats::arima(x = a.ts, order = c(3, 2, 1), method = "CSS") # css estimate
arima321_forecast = forecast(arima321_css, h=10, level=c(99.5))
# MY ATTEMPT AT PLOTS
plot(arima321_forecast)
par(new=T)
plot(arima011_forecast)
Here is something similar to #jay.sf but using ggplot2.
library(ggplot2)
autoplot(a.ts) +
autolayer(arima011_forecast, series = "ARIMA(0,1,1)", alpha = 0.5) +
autolayer(arima321_forecast, series = "ARIMA(3,2,1)", alpha = 0.5) +
guides(colour = guide_legend("Model"))
Created on 2020-05-19 by the reprex package (v0.3.0)
You could do a manual plot using a sequence of dates.
rn <- format(seq.Date(as.Date("2005-01-01"), by="months", length.out=12*3), "%Y.%m")
Your ARIMAs you'll need as.matrix form.
arima321_mat <- as.matrix(as.data.frame(arima321_forecast))
arima011_mat <- as.matrix(as.data.frame(arima011_forecast))
Some colors with different alpha=.
col.1 <- rainbow(2, ,.7)
col.2 <- rainbow(2, ,.7, alpha=.2)
For the CIs use polygon.
plot(data, type="l", xlim=c(1, length(rn)), ylim=c(0, 3500), xaxt="n", main="Forecasts")
axis(1, axTicks(1), labels=F)
mtext(rn[(seq(rn)-1) %% 5 == 0], 1, 1, at=axTicks(1))
lines((length(data)+1):length(rn), arima321_mat[,1], col=col.1[1], lwd=2)
polygon(c(27:36, 36:27), c(arima321_mat[,2], rev(arima321_mat[,3])), col=col.2[1],
border=NA)
lines((length(data)+1):length(rn), arima011_mat[,1], col=col.1[2], lwd=3)
polygon(c(27:36, 36:27), c(arima011_mat[,2], rev(arima011_mat[,3])), col=col.2[2],
border=NA)
legend("topleft", legend=c("ARIMA(3,2,1)", "ARIMA(0,1,1)"), col=col.1, lwd=2, cex=.9)
Edit: To avoid the repetition of lines and polygon calls, you may unite them using Map.
mats <- list(arima321_mat, arima011_mat) ## put matrices into list
plot(.)
axis(.)
mtext(.)
Map(function(i) {
lines((length(data)+1):length(rn), mats[[i]][,1], col=col.1[i], lwd=2)
polygon(c(27:36, 36:27), c(mats[[i]][,2], rev(mats[[i]][,3])), col=col.2[i], border=NA)
}, 1:2)
legend(.)
require(forecast)
data <- c(3.86000, 19.55810, 19.51091, 20.74048, 20.71333, 29.04191, 30.28864, 25.64300, 23.33368, 23.70870 , 26.16600 ,27.61286 , 27.88409 , 28.41400 , 24.81957 , 24.60952, 27.49857, 32.08000 , 29.98000, 27.49000 , 237.26150, 266.35478, 338.30000, 377.69476, 528.65905, 780.00000 )
a.ts <- ts(data,start=c(2005,1),frequency=12)
arima011_css =stats::arima(x = a.ts, order = c(0, 1, 1), method = "CSS") # css estimate
arima011_forecast = predict(arima011_css, n.ahead = 2)$pred
arima321_css =stats::arima(x = a.ts, order = c(3, 2, 1), method = "CSS") # css estimate
arima321_forecast = predict(arima321_css, n.ahead = 2)$pred
plot(a.ts, type = "o", xlim = c(2005, 2007.5) , ylim = c(-1, 1200) , ylab = "price" ,main = "2 month Forecast")
range = c(2007+(3/12), 2007+(4/12)) # adding the dates for the prediction
lines(y = arima011_forecast , x = range , type = "o", col = "red")
lines(y = arima321_forecast, x = range , type = "o", col = "blue")

How do I create venn-diagram with item labels inside

I have these three clusters below. I want to create venn diagram with three clusters and showing their labels inside the diagram with proper size and spread so it looks beautiful. Below is the code I tried, but doesn't give what I wanted.
Clusters:
ClusterI<- c("HanXRQChr10g0293411T", "HanXRQChr09g0239551T", "HanXRQChr15g0489401R", "HanXRQChr02g0052061T", "HanXRQChr14g0430311N", "HanXRQChr15g0482661N", "HanXRQChr02g0046611R", "HanXRQChr02g0048181R", "HanXRQChr09g0260361N", "HanXRQChr08g0224171C", "HanXRQChr15g0489421R", "HanXRQChr03g0065841N", "HanXRQChr05g0129181R")
ClusterII<- c("HanXRQChr03g0082411N", "HanXRQChr13g0421521N", "HanXRQChr09g0240011N", "HanXRQChr11g0348661N", "HanXRQChr16g0505221N", "HanXRQChr15g0468571C", "HanXRQChr16g0522521T", "HanXRQChr10g0317141T", "HanXRQChr16g0520121T", "HanXRQChr13g0421611N", "HanXRQChr03g0077151T", "HanXRQChr15g0477941C", "HanXRQChr04g0103931T", "HanXRQChr04g0098561T", "HanXRQChr06g0183851T", "HanXRQChr09g0267021N", "HanXRQChr10g0279361N", "HanXRQChr06g0184181T", "HanXRQChr09g0240261N", "HanXRQChr03g0077061T", "HanXRQChr10g0279351N", "HanXRQChr02g0050681T", "HanXRQChr01g0016951T", "HanXRQChr13g0423781N", "HanXRQChr15g0478941C", "HanXRQChr09g0239991T", "HanXRQChr11g0320701N", "HanXRQChr04g0098511T", "HanXRQChr02g0037011N", "HanXRQChr13g0426201C", "HanXRQChr04g0117551T", "HanXRQChr09g0243851N", "HanXRQChr03g0079391N", "HanXRQChr09g0239281T", "HanXRQChr09g0241811T", "HanXRQChr04g0101181T", "HanXRQChr01g0029301C", "HanXRQChr08g0209681T", "HanXRQChr14g0453551N", "HanXRQChr05g0149501T", "HanXRQChr13g0397101N", "HanXRQChr13g0417981C", "HanXRQChr10g0316961N")
ClusterIII <- c("HanXRQChr03g0065091T", "HanXRQChr01g0016931T", "HanXRQChr17g0550881C", "HanXRQChr03g0064011T", "HanXRQChr09g0239211T", "HanXRQChr06g0183841T", "HanXRQChr04g0095771T", "HanXRQChr09g0240621T", "HanXRQChr12g0374601C", "HanXRQChr14g0430731R", "HanXRQChr10g0298171T", "HanXRQChr08g0211081T", "HanXRQChr02g0050711T", "HanXRQChr12g0361091T", "HanXRQChr06g0175651N")
code:
v2 <- venn.diagram(list(ClusterI=ClusterI, ClusterII=ClusterII,ClusterIII=ClusterIII),
fill = c("red", "blue","green"),
alpha = c(0.5, 0.5, 0.5), cat.cex = 1.5, cex=0.25,
filename=NULL)
# have a look at the default plot
grid.newpage()
grid.draw(v2)
v2[[7]]$label <- paste(setdiff(ClusterI, ClusterII), collapse="\n")
# in ClusterII only
v2[[8]]$label <- paste(setdiff(ClusterII, ClusterI) , collapse="\n")
# intesection ClusterI and ClusterII
v2[[9]]$label <- paste(intersect(ClusterI, ClusterII), collapse="\n")
# fora: out
v2[[10]]$label <- paste(ClusterIII, collapse="\n")
grid.newpage()
grid.draw(v2)
Try this. It appears there is no overlap among three clusters.
library(VennDiagram)
ClusterI<- c("HanXRQChr10g0293411T", "HanXRQChr09g0239551T", "HanXRQChr15g0489401R", "HanXRQChr02g0052061T", "HanXRQChr14g0430311N", "HanXRQChr15g0482661N", "HanXRQChr02g0046611R", "HanXRQChr02g0048181R", "HanXRQChr09g0260361N", "HanXRQChr08g0224171C", "HanXRQChr15g0489421R", "HanXRQChr03g0065841N", "HanXRQChr05g0129181R")
ClusterII<- c("HanXRQChr03g0082411N", "HanXRQChr13g0421521N", "HanXRQChr09g0240011N", "HanXRQChr11g0348661N", "HanXRQChr16g0505221N", "HanXRQChr15g0468571C", "HanXRQChr16g0522521T", "HanXRQChr10g0317141T", "HanXRQChr16g0520121T", "HanXRQChr13g0421611N", "HanXRQChr03g0077151T", "HanXRQChr15g0477941C", "HanXRQChr04g0103931T", "HanXRQChr04g0098561T", "HanXRQChr06g0183851T", "HanXRQChr09g0267021N", "HanXRQChr10g0279361N", "HanXRQChr06g0184181T", "HanXRQChr09g0240261N", "HanXRQChr03g0077061T", "HanXRQChr10g0279351N", "HanXRQChr02g0050681T", "HanXRQChr01g0016951T", "HanXRQChr13g0423781N", "HanXRQChr15g0478941C", "HanXRQChr09g0239991T", "HanXRQChr11g0320701N", "HanXRQChr04g0098511T", "HanXRQChr02g0037011N", "HanXRQChr13g0426201C", "HanXRQChr04g0117551T", "HanXRQChr09g0243851N", "HanXRQChr03g0079391N", "HanXRQChr09g0239281T", "HanXRQChr09g0241811T", "HanXRQChr04g0101181T", "HanXRQChr01g0029301C", "HanXRQChr08g0209681T", "HanXRQChr14g0453551N", "HanXRQChr05g0149501T", "HanXRQChr13g0397101N", "HanXRQChr13g0417981C", "HanXRQChr10g0316961N")
ClusterIII <- c("HanXRQChr03g0065091T", "HanXRQChr01g0016931T", "HanXRQChr17g0550881C", "HanXRQChr03g0064011T", "HanXRQChr09g0239211T", "HanXRQChr06g0183841T", "HanXRQChr04g0095771T", "HanXRQChr09g0240621T", "HanXRQChr12g0374601C", "HanXRQChr14g0430731R", "HanXRQChr10g0298171T", "HanXRQChr08g0211081T", "HanXRQChr02g0050711T", "HanXRQChr12g0361091T", "HanXRQChr06g0175651N")
v2 <- draw.triple.venn(
area1 = 60,
area2 = 60,
area3 = 60,
n12 = 20,
n23 = 10,
n13 = 15,
n123 = 5,
cex = 0.25,
cat.cex = 1.5,
alpha = c(0.5, 0.5, 0.5),
category = c("ClusterI", "ClusterII", "ClusterIII"),
fill = c("red", "blue","green")
)
overlaps <- calculate.overlap(list("ClusterI"=ClusterI, "ClusterII"=ClusterII, "ClusterIII"=ClusterIII))
overlaps
indx <- as.numeric(substr(names(overlaps),2,2))
for (i in 1:length(overlaps)){
v2[[6+indx[i] ]]$label <- paste(overlaps[[i]], collapse = "\n")
}
grid.newpage()
grid.draw(v2)
Good luck!

Subtitle separated from the image

I have the following code constructing a confusion matrix image:
truth <- c(0,1,0,0,0,1,0,1,0,1)
pred <- c(0,0,0,0,0,1,0,1,0,0)
FWConf <- mlearning::confusion(factor(pred,labels=c("Loyal","Churn")), factor(truth,labels=c("Loyal","Churn")),vars=c("a","b"), labels = c("Actual","Predicted"))
opar <- par(mar=c(14, 4, 7, 2))
x <- x.orig <- unclass(FWConf)
x <- log(x + 0.5) * 2.33
x[x < 0] <- NA
x[x > 10] <- 10
diag(x) <- -diag(x)
graphics::image(1:ncol(x), 1:ncol(x), -(x[, nrow(x):1]), xlab='', ylab='',col=colorRampPalette(c("red","yellow","green"))(41), xaxt='n', yaxt='n', zlim=c(-10, 10))
axis(1, at=1:ncol(x), labels=colnames(x), cex.axis=0.8)
axis(2, at=ncol(x):1, labels=colnames(x), las=1, cex.axis=0.8)
title(ylab='Predicted', line=0.5, xlab = 'Actual')
abline(h = 0:ncol(x) + 0.5, col = 'gray')
abline(v = 0:ncol(x) + 0.5, col = 'gray')
text(1:6, rep(6:1, each=6),
labels = sub('^0$', '', round(c(x.orig), 0)))
box(lwd=2)
title(sub = paste("\n\n\n +-------------------------------------------------------+",
"\n\t[\tCosto Mancato Allarme:\t", 90 ,"\t euro\t]",
"\n\t[\tCosto Falso Allarme :\t", 10 ,"\t euro\t]",
"\n\t[\tIndice di Salvataggio:\t", 0.4*100 ,"\t % \t]",
"\n+-------------------------------------------------------+"),
main = paste(" +-------------------------+","\n | Costo = " ,10, " euro |", "\n+-------------------------+"))
par(opar)
The resulting image is:
In order to have the subtitle separated from the image I have changed the title part in the following way.
title(main = paste(" +-------------------------+","\n | Costo = " ,costo, " euro |", "\n+-------------------------+"))
title(sub = paste("\n\n\n +-------------------------------------------------------+",
"\n[\tCosto Mancato Allarme:\t", z2 ,"\t euro\t]",
"\n[\tCosto Falso Allarme :\t", z1 ,"\t euro\t]",
"\n[\tIndice di Salvataggio:\t", savingRate*100,"\t % \t]",
"\n+-------------------------------------------------------+"),
line = 7
)
Is there a better way to show the information contained in the title and subtitle and the image? Something like boxes, rectangles, and so on?

How to set the y range in boxplot graph?

I'm using boxplot() in R. My code is:
#rm(list=ls())
#B2
fps_error <- c(0.058404273, 0.028957446, 0.026276044, 0.07084294, 0.078438563, 0.024000178, 0.120678965, 0.081774358, 0.025644741, 0.02931614)
fps_error = fps_error *100
fps_qp_error <-c(1.833333333, 1.69047619, 1.666666667, 3.095238095, 2.738095238, 1.714285714, 3.634146341, 5.142857143, 1.238095238, 2.30952381)
bit_error <- c(0.141691737, 0.136173785, 0.073808209, 0.025057931, 0.165722097, 0.004276999, 0.365353752, 0.164757488, 0.003362543, 0.022423845)
bit_error = bit_error *100
bit_qp_error <-c(0.666666667, 0.785714286, 0.428571429, 0.142857143, 0.785714286, 0.023809524, 1.523809524, 0.976190476, 0.023809524, 0.142857143)
ssim_error <-c(0.01193773, 0.015151569, 0.003144532, 0.003182908, 0.008125274, 0.013796366, 0.00359078, 0.019002591, 0.005031524, 0.004370175)
ssim_error = ssim_error * 100
ssim_qp_error <-c(3.833333333, 1.80952381, 0.69047619, 0.571428571, 2, 1.904761905, 0.761904762, 2.119047619, 0.857142857, 0.976190476)
all_errors = cbind(fps_error, bit_error, ssim_error)
all_qp_errors = cbind(fps_qp_error, bit_qp_error, ssim_qp_error)
modes = cbind(rep("FPS error",10), rep("Bitrate error",10), rep("SSIM error",10))
journal_linear_data <-data.frame(fps_error, fps_qp_error,bit_error,bit_qp_error,ssim_error,ssim_qp_error )
yvars <- c("fps_error","bit_error","ssim_error")
yvars_qp <-c("fps_qp_error","bit_qp_error","ssim_qp_error")
xvars <- c("FPS", "Bitrate", "SSIM")
graphics.off()
bmp(filename="boxplot_B2_error.bmp")
op <- par(mfrow = c(1, 3), #matrix of plots
oma = c(0,0,2,0),mar=c(5.1, 7.1, 2.1, 2.1),mgp=c(4,1,0)) #outer margins
par(cex.lab=3)
par(cex.axis=3)
for (i in 1:3) {boxplot(journal_linear_data[,yvars[i]], xlab=xvars[i], ylab="Percentage error", outcex = 2)}
par(op)
mtext(text="Percentage error per mode for B2",side=3, line=1.5, font=2, cex=2,adj=0.95, col='black')
dev.off()
The image output is shown below. As you can see the y-axis does not have the same range for all graphs. How can I fix this? For example starting in 0.5 or 0.
You can simply put an ylim = c(0, 5) in all your boxplot() call. This sets y-axis range (roughly) between 0 and 5.
Perhaps you did not see ylim argument in ?boxplot; the "Arguments" section also does not mention it. But ylim is just a trivial graphical parameter passed via "...". You can also find such example in the "Examples" session of ?boxplot:
boxplot(len ~ dose, data = ToothGrowth,
boxwex = 0.25, at = 1:3 - 0.2,
subset = supp == "VC", col = "yellow",
main = "Guinea Pigs' Tooth Growth",
xlab = "Vitamin C dose mg",
ylab = "tooth length",
xlim = c(0.5, 3.5), ylim = c(0, 35), yaxs = "i")

R - explore the graphs stocked in a variable

I there a way to see in R how a graph was built into a variable: the code behind the graph. I have tried the str(), deparse(), and replayPlot() functions but these don't give the answer I am searching for.
Precisely I am looking at the result returned by the MackChainLadder() function from the "ChainLadder" package. When I plot the the variable, say plot(MCL), it returns me 6 different graphs. Is it a way to find out how these graphs were built and saved into the variable?
library("ChainLadder")
MCL <- MackChainLadder(ABC)
plot(MCL)
One way to do this is to look at the package source code directly (download it from this page):
http://cran.r-project.org/web/packages/ChainLadder/index.html
The trick is finding the right method that plot() calls. I think it might be this one in MackChainLadderFunctions.R
################################################################################
## plot
##
plot.MackChainLadder <- function(x, mfrow=c(3,2), title=NULL,lattice=FALSE,...){
.myResult <- summary(x)$ByOrigin
.FullTriangle <- x[["FullTriangle"]]
.Triangle <- x[["Triangle"]]
if(!lattice){
if(is.null(title)) myoma <- c(0,0,0,0) else myoma <- c(0,0,2,0)
op=par(mfrow=mfrow, oma=myoma, mar=c(4.5,4.5,2,2))
plotdata <- t(as.matrix(.myResult[,c("Latest","IBNR")]))
n <- ncol(plotdata)
if(getRversion() < "2.9.0") { ## work around missing feature
bp <- barplot(plotdata,
legend.text=c("Latest","Forecast"),
## args.legend=list(x="topleft"), only avilable from R version >= 2.9.0
names.arg=rownames(.myResult),
main="Mack Chain Ladder Results",
xlab="Origin period",
ylab="Amount",#paste(Currency,myUnit),
ylim=c(0, max(apply(.myResult[c("Ultimate", "Mack.S.E")],1,sum),na.rm=TRUE)))
}else{
bp <- barplot(plotdata,
legend.text=c("Latest","Forecast"),
args.legend=list(x="topleft"),
names.arg=rownames(.myResult),
main="Mack Chain Ladder Results",
xlab="Origin period",
ylab="Amount",#paste(Currency,myUnit),
ylim=c(0, max(apply(.myResult[c("Ultimate", "Mack.S.E")],1,sum),na.rm=TRUE)))
}
## add error ticks
## require("Hmisc")
errbar(x=bp, y=.myResult$Ultimate,
yplus=(.myResult$Ultimate + .myResult$Mack.S.E),
yminus=(.myResult$Ultimate - .myResult$Mack.S.E),
cap=0.05,
add=TRUE)
matplot(t(.FullTriangle), type="l",
main="Chain ladder developments by origin period",
xlab="Development period", ylab="Amount", #paste(Currency, myUnit)
)
matplot(t(.Triangle), add=TRUE)
Residuals=residuals(x)
plot(standard.residuals ~ fitted.value, data=Residuals,
ylab="Standardised residuals", xlab="Fitted")
lines(lowess(Residuals$fitted.value, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
plot(standard.residuals ~ origin.period, data=Residuals,
ylab="Standardised residuals", xlab="Origin period")
lines(lowess(Residuals$origin.period, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
plot(standard.residuals ~ cal.period, data=Residuals,
ylab="Standardised residuals", xlab="Calendar period")
lines(lowess(Residuals$cal.period, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
plot(standard.residuals ~ dev.period, data=Residuals,
ylab="Standardised residuals", xlab="Development period")
lines(lowess(Residuals$dev.period, Residuals$standard.residuals), col="red")
abline(h=0, col="grey")
title( title , outer=TRUE)
par(op)
}else{
## require(grid)
## Set legend
fl <-
grid.layout(nrow = 2, ncol = 4,
heights = unit(rep(1, 2), "lines"),
widths =
unit(c(2, 1, 2, 1),
c("cm", "strwidth", "cm",
"strwidth"),
data = list(NULL, "Chain ladder dev.", NULL,
"Mack's S.E.")))
foo <- frameGrob(layout = fl)
foo <- placeGrob(foo,
linesGrob(c(0.2, 0.8), c(.5, .5),
gp = gpar(col=1, lty=1)),
row = 1, col = 1)
foo <- placeGrob(foo,
linesGrob(c(0.2, 0.8), c(.5, .5),
gp = gpar(col=1, lty=3)),
row = 1, col = 3)
foo <- placeGrob(foo,
textGrob(label = "Chain ladder dev."),
row = 1, col = 2)
foo <- placeGrob(foo,
textGrob(label = "Mack's S.E."),
row = 1, col = 4)
long <- expand.grid(origin=as.numeric(dimnames(.FullTriangle)$origin),
dev=as.numeric(dimnames(.FullTriangle)$dev))
long$value <- as.vector(.FullTriangle)
long$valuePlusMack.S.E <- long$value + as.vector(x$Mack.S.E)
long$valueMinusMack.S.E <- long$value - as.vector(x$Mack.S.E)
sublong <- long[!is.na(long$value),]
xyplot(valuePlusMack.S.E + valueMinusMack.S.E + value ~ dev |
factor(origin), data=sublong, t="l", lty=c(3,3,1), as.table=TRUE,
main="Chain ladder developments by origin period",
xlab="Development period",
ylab="Amount",col=1,
legend = list(top = list(fun = foo)),...)
}
}

Resources