Nothing
#
# Copyright (C) 2011-2015 Christina Yassouridis
#
#
plotOverview <- function(object, showLegend){
temp <- object@trends$temp
k <- max(object@cluster)
time <- object@time
ctrs1 <- temp[,-1, drop=FALSE]
ctrs2 <- object@centers
dist <- matrix(NA,k,k)
for(i in 1:k)
for(j in 1:k)
dist[i,j] <- sum((ctrs1[,i]-ctrs2[,j])^2)
labels <- resort(dist)
reset <- function() {
par(mfrow=c(1, 1), oma=rep(0, 4), mar=rep(0, 4), new=TRUE)
plot(0:1, 0:1, type="n", xlab="", ylab="", axes=FALSE)
}
.pardefault <- par()
par(xpd=T, mfrow=c(2,2) , mar=c(3,2,3,1))
plotClusterLocs(object, showLegend=FALSE)
matplot(time, ctrs1, type='l', lty=1, col=labels[2,], ylab="",ylim=c(min(temp[,1],ctrs1),max(temp[,1],ctrs1)))
title("Temporal cluster trends",line=1)
lines(time, temp[,1],type='l', lty=1, col=k+1, lwd=2)
matplot(time, object@centers, type='l', lty=1, col=labels[1,])
title("Temp + Overall", line=1)
plotSpatials(object, showLegend=showLegend)
if(showLegend){
reset()
legend("top", c("overall trend", paste("cluster",1:k)), col =
c(k+1,labels[1,]),pch="o", bty = "n")
}
}
plotClusterLocs <- function(object, showLegend){
k <- max(object@cluster)
location <- object@location
cl <- as.factor(object@cluster)
levels(cl) <- col <- 1:k
cl <- as.character(cl)
plot(location[,1], location[,2], col=cl, type="p", pch=16, ylab="")
title("Cluster location", line=1)
if(showLegend)
legend("topright", inset=c(-0.5,0), paste("cluster", 1:k), col =
col, pch="o", bty = "n")
}
plotSpatials <- function(object, showLegend){
location <- object@location
spatial <- object@trends$spatial
if(!is.null(dim(spatial)))
spatial <- spatial[1,]
N <- dim(location)[1]
a <- (spatial+max(abs(spatial)))
spatial2col <- as.numeric((a-min(a))/(max(a)-min(a)))
rbPal <- colorRampPalette(c('yellow','blue'))
Col <- rbPal(N)[as.numeric(cut(spatial2col,breaks = N))]
legend_image <- as.raster(matrix(rbPal(20), ncol=1))
##layout(matrix(1:2,ncol=2), width = c(2,1),height = c(1,1))
plot(location[,1],location[,2],col=Col,cex=1.5,pch=20, xlab="x", ylab="y")
title(main="Spatial dependency", line=1)
mtext(paste("Method", object@methodName), outer=TRUE)
if(showLegend){
x <- location[,1]
y <- location[,2]
relx <- ceiling(diff(range(location[,1]))/20)
rely <- ceiling(diff(range(location[,2]))/5)
rasterImage(legend_image, max(x)-relx, max(y)-rely,max(x),max(y))
text(x=rep(max(x)-0.5*relx,5), y=seq(max(y)-rely,max(y),l=5), labels =
seq(1,0,l=5), cex=0.7, lwd=2)
}
}
plotDeviations <- function(object, showLegend){
location <- object@location
N <- dim(location)[1]
devScaled <- object@prms$sigma
rbPal <- colorRampPalette(c('lightblue','darkblue'))
Col <- rbPal(N)[as.numeric(cut(devScaled, breaks = N))]
eqscplot(location[,1],location[,2],pch = 20, cex=1.5, col = Col,main="Deviations")
}
plotLoc <- function(object, showLegend){
location <- object@location
nc <- dim(location)[1]
cex <- ifelse(nc>100, 100/nc, 0.7)
par(mfrow=c(1,2))
eqscplot(location[,1],location[,2], xlab="location 1",
ylab="location 2", cex=cex)
textxy(location[,1],location[,2],1:length(location[,1]), cex=max(cex,0.5))
B=stationary.cov(location, location, Covariance="Matern")
B <- as.dist(B)
check <- cmdscale(1-B,k=2)
sunflowerplot(check[,1],check[,2],
main="Matern covariance distance plot",
ylab="md-scaled variable 2", xlab="md-scaled variable 1",
cex=cex)
textxy(check[,1], check[,2], 1:length(check[,1]), cex=max(cex,0.5))
par(mfrow=c(1,1))
##Get the order of the closest points and verify with plot
B <- as.matrix(B)
a <- matrix(0,nc,nc)
for(j in 1:nc)
for(i in 1:nc) a[i,j]=which(B[,j]==sort(B[,j],
decreasing=T)[i])[1]
return(a)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.