Permalink
Cannot retrieve contributors at this time
library(compare) | |
rm(list = ls()) #--clears all lists------# | |
cat("\14") | |
#---legend function | |
legend.col <- function(col, lev){ | |
opar <- par | |
n <- length(col) | |
bx <- par("usr") | |
box.cx <- c(bx[2] + (bx[2] - bx[1]) / 1000, | |
bx[2] + (bx[2] - bx[1]) / 1000 + (bx[2] - bx[1]) / 50) | |
box.cy <- c(bx[3], bx[3]) | |
box.sy <- (bx[4] - bx[3]) / n | |
xx <- rep(box.cx, each = 2) | |
par(xpd = TRUE) | |
for(i in 1:n){ | |
yy <- c(box.cy[1] + (box.sy * (i - 1)), | |
box.cy[1] + (box.sy * (i)), | |
box.cy[1] + (box.sy * (i)), | |
box.cy[1] + (box.sy * (i - 1))) | |
polygon(xx, yy, col = col[i], border = col[i]) | |
} | |
par(new = TRUE) | |
plot(0, 0, type = "n", | |
ylim = c(min(lev), max(lev)), | |
yaxt = "n", ylab = "", | |
xaxt = "n", xlab = "", | |
frame.plot = FALSE) | |
axis(side = 4, las = 2, tick = FALSE, line = .25) | |
par <- opar | |
} | |
#------ | |
options(scipen=5) | |
#dmineplots <- function(scen_state, startyear, endyear, dcause, Kommodity) { | |
scen_state = "Idaho" | |
startyear = "2001" | |
endyear = "2015" | |
dcause = "Drought" | |
#Kommodity = "Wheat" | |
setwd("/dmine/data/counties/") | |
counties <- readShapePoly('UScounties.shp', | |
proj4string=CRS | |
("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")) | |
projection = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0") | |
#counties <- counties[grep("Idaho|Washington|Oregon|Montana", counties@data$STATE_NAME),] | |
#counties <- counties[grep(scen_state, counties@data$STATE_NAME),] | |
counties <- subset(counties, STATE_NAME %in% scen_state) | |
monthdir <- paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, sep="") | |
yeardir <- paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/summaries/", sep="") | |
#uniquez <- list.files(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/month", sep="")) | |
maskraster <- raster(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/netcdf/pdsi_apr_", startyear, ".nc", sep="")) | |
#setwd(monthdir) | |
#system("find month -type f -size +75c -exec cp -nv {} month_positive/ \\;") | |
#setwd(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/month_positive/", sep="")) | |
#system("mv *AdjustedGrossRevenue.csv ../commodity_csv_agr_month/") | |
#uniquez <<- list.files(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/month_positive/", sep="")) | |
#--set tt outside of loop below | |
tt1 <- colorRampPalette(c("white", "blue", "red")) | |
setwd(yeardir) | |
it <- paste("2001_2015_usda_gridmet_", scen_state, sep="") | |
zaa <- as.data.frame(read.csv(it, strip.white = TRUE)) | |
DTz1 <- data.table(zaa) | |
DTz1 <- subset(DTz1, damagecause == dcause) | |
#DTz <- subset(DTz, commodity == kkk) | |
DTza1 <- as.data.frame(subset(DTz1, loss > 0)) | |
DTzmax1 <- max(DTza1$loss) | |
DTzmin1 <- min(DTza1$loss) | |
DTzlen1 <- (nrow(DTza1)/10) | |
len4a_out <- tt1((DTzmax1 - DTzmin1)/DTzlen1) | |
#--------------- | |
years <- c(startyear:endyear) | |
for (j in years) { | |
setwd(yeardir) | |
i <- paste("2001_2015_usda_gridmet_", scen_state, sep="") | |
#i <- paste(j, "_monthly_usda_gridmet_post2001_", scen_state, sep="") | |
#i <- paste(input$year, ".", input$month, ".", input$commodity, ".csv", sep="") | |
#setwd("/dmine/data/counties/") | |
#counties <- readShapePoly('UScounties.shp', | |
# proj4string=CRS | |
# ("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")) | |
#projection = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0") | |
#counties <- subset(counties, STATE_NAME %in% scen_state) | |
#counties <- counties[grep(scen_state, counties@data$STATE_NAME),] | |
setwd(yeardir) | |
x <- as.data.frame(read.csv(i, strip.white = TRUE)) | |
x <- subset(x, monthcode != "NA") | |
x <- subset(x, commoditycode != 88) | |
x <- subset(x, year == j) | |
uniquecomm <- unique(x$commodity) | |
months <- unique(x$month) | |
#------------- | |
for (kkk in uniquecomm) { | |
tt1 <- colorRampPalette(c("white", "blue", "red")) | |
setwd(yeardir) | |
it <- paste("2001_2015_usda_gridmet_", scen_state, sep="") | |
zaa <- as.data.frame(read.csv(it, strip.white = TRUE)) | |
DTz1 <- data.table(zaa) | |
DTz1 <- subset(DTz1, damagecause == dcause) | |
DTz1 <- subset(DTz1, commodity == kkk) | |
if (nrow(DTz1) == 0) { | |
DTzmax1 <<- 1 | |
DTzmin1 <<- 0 | |
} else { | |
DTzsumz <- as.data.frame(aggregate(DTz1$loss~DTz1$month+DTz1$year+DTz1$county, DTz1, sum)) | |
colnames(DTzsumz) <- c("month", "year", "county", "loss") | |
DTzsum_maxz <<- max(DTzsumz$loss) | |
#DTza1 <- as.data.frame(subset(DTz1, loss > 0)) | |
#DTzmax1 <<- max(DTza1$loss) | |
#DTzmin1 <<- min(DTza1$loss) | |
#DTzlen1 <<- (nrow(DTza1)/10) | |
#len4a_out1 <<- tt1((DTzmax1 - DTzmin1)/DTzlen1) | |
} | |
for (jj in months) { | |
DT <- data.table(x) | |
#DTnew <- tolower(DT$commodity) | |
#simpleCap <- function(x) { | |
# s <- strsplit(x, " ")[[1]] | |
# paste(toupper(substring(s, 1,1)), substring(s, 2), | |
# sep="", collapse=" ") | |
#} | |
#DTnew1a <- data.frame(sapply(DTnew,simpleCap)) | |
#colnames(DTnew1a) <- c("commodity_new") | |
#DTnew3 <- cbind(DT, DTnew1a) | |
# DTnew3 <- DT | |
# DTnew3$commodity <- DTnew3$commodity_new | |
#--change to lowercase DT2!! | |
#DT2 <- DT | |
DT2 <- subset(DT, damagecause == dcause) #---set for drought!!! | |
DT2 <- subset(DT2, month == jj) | |
DT2 <- subset(DT2, commodity == kkk) | |
if (nrow(DT2) != 0 ) { | |
#DT2 <- subset(DTnew3, commodity == input$commodity) | |
#DT3 <- data.frame(DT2$acres, DT2$loss) | |
#DT4 <- cbind(x, DT3) | |
DT2loss <- DT2[,list(loss=sum(loss)), by = county] | |
#DT2 <- DT2[, lapply(.SD, sum), by=list(county)] | |
DT2acres <- DT2[,list(acres=sum(acres)), by = county] | |
DTdamage_loss <- DT2[,list(loss=sum(loss)), by = damagecause] | |
DTdamage_acres <- DT2[,list(acres=sum(acres)), by = damagecause] | |
#lengthDT2 <- length(DT2) | |
#DT5 <- matrix(input@commodity, nrow = lengthDT2, ncol = 1) | |
DT6 <- cbind(DT2loss, DT2acres$acres) | |
#--DT7 is for barplot of summarized damage causes for the state, annually, with loss and acres per damage type | |
DT7 <- cbind(DTdamage_loss, DTdamage_acres$acres) | |
setnames(DT7, c("DAMAGECAUSE", "LOSS", "ACRES")) | |
#m <- subset(x, county = "ID") | |
names(counties)[1] <- "county" | |
#colnames(x) <- c("UNIQUEID", "YEAR", "COUNTY", "COMMODITYCODE", "MONTHCODE", "ACRES", "LOSS", "COMMODITY") | |
#colnames(u) <- c("NAME") | |
#z <- cbind(u,DT) | |
m <- merge(counties, DT2loss, by='county') | |
#names(m)[7] <- "acres" | |
m$loss[is.na(m$loss)] <- 0 | |
#m$COMMODITYCODE[is.na(m$COMMODITYCODE)] <- 0 | |
#m$acres[is.na(m$acres)] <- 0 | |
#------------ | |
#shapefile(m) | |
#--begin polygon work | |
#length(na.omit(m$LOSS)) | |
tt_county <- colorRampPalette(c("white", "blue", "red"))( 44) | |
tt <- colorRampPalette(c("light blue", "blue", "red")) | |
#mz <- subset(m, LOSS != 0) | |
#mzacres <- subset(m, acres > 0) | |
#lengacres <- length(m$acres) | |
leng <- length(m$loss) | |
#len2 <- tt(len <- length(mz$loss)) | |
#len2acres <- tt(len <- length(mzacres$acres)) | |
#len2a <- length(mz$loss) | |
#len2a <- length(mzacres$acres) | |
len3 <- tt(len <- length(m$loss)) | |
#len4 <- tt(len <- length(m$acres)) | |
#len4 <- tt(nrow(as.data.frame(subset(m, loss > 0)))) | |
#--create a color vector for ALL commodity drought values for all years. used for the gradient legend and coloring | |
za <- as.data.frame(read.csv(i, strip.white = TRUE)) | |
DTz <- data.table(za) | |
DTz <- subset(DTz, damagecause == dcause) | |
DTz <- subset(DTz, commodity == kkk) | |
DTzsum <- as.data.frame(aggregate(DTz$loss~DTz$month+DTz$year+DTz$county, DTz, sum)) | |
colnames(DTzsum) <- c("month", "year", "county", "loss") | |
DTzsum_max <<- max(DTzsum$loss) | |
DTza <- as.data.frame(subset(DTz, loss > 0)) | |
DTzmax <- max(DTza$loss) | |
DTzmin <- min(DTza$loss) | |
DTzlen <- (nrow(DTza)/10) | |
DTzlen_county <- length(counties) | |
DTza_sorted <- sort(DTza$loss) | |
DTza_len <- length(DTza_sorted) | |
len4a <- tt((DTzmax - DTzmin)) | |
len44a <- tt(DTzsum_max) | |
#len4a_out <- tt((DTzmax - DTzmin)/DTzlen) | |
#---------- | |
tt_DTza <- colorRampPalette(c("light blue", "blue", "red"))( DTza_len) | |
DTza_s1 <- cbind (tt_DTza, DTza_sorted) | |
len4ab <- tt(DTzlen_county) | |
len4abc <- tt(DTza_sorted) | |
#---- | |
orderedcolors2 <- tt(length(m$loss))[order(order(m$loss))] | |
#orderedcolors3 <- tt(length(m$acres))[order(order(m$acres))] | |
#newframe <- data.frame(m$LOSS) | |
m[["loss"]][is.na(m[["loss"]])] <- 0 | |
#m[["acres"]][is.na(m[["acres"]])] <- 0 | |
xx <- unique(counties$county) | |
newmatrix <- matrix(data = NA, nrow = leng, ncol = 1) | |
vect <- as.vector(DT2loss$county) | |
for (ll in vect) { | |
for (kk in xx){ | |
comp <- compare(kk,ll) | |
if (isTRUE(comp)) { | |
rownumber <- which(xx == kk) | |
#print("yes this worked, added 0") | |
verm <- subset(DTzsum, year == j) | |
verm <- subset(DTzsum, month == jj) | |
verm <- subset(DTzsum, county == kk) | |
DT2zsum_loss <- sum(verm$loss) | |
which(DT2loss ==DT2zsum_loss) | |
tutu <- DT2loss$county == kk | |
tutu2 <- DT2loss[tutu] | |
if (tutu2$loss > 0) { | |
newmatrix[rownumber,] <- len44a[tutu2$loss] | |
#newmatrix[yy,] <- orderedcolors2[yy] | |
} else { | |
newmatrix[rownumber,] <- len44a[1] | |
} | |
}}} | |
newmatrix[is.na(newmatrix)] <- 0 | |
#xx <- 1 | |
#newmatrix_acres <- matrix(data = NA, nrow = leng, ncol = 1) | |
#for (jj in 1:leng){ | |
#if (DT7$ACRES[jj] == 0) { | |
#print("yes this worked, added 0") | |
# newmatrix_acres[jj,] <- 0 | |
#} else { | |
#print("yes, this worked, added color") | |
#newmatrix[jj,] <- len4[jj] | |
#newmatrix_acres[jj,] <- orderedcolors3[xx] | |
#xx <- xx + 1 | |
#} | |
#newmatrix[newmatrix==0] <- NA | |
#newmatrix2 <- newmatrix[complete.cases(newmatrix[,1])] | |
#newmatrix2 <- subset(newmatrix = TRUE) | |
#newmatrix[newmatrix == NA] <- 0 | |
#newmatrix <- c(newmatrix) | |
#newmatrix_acres[newmatrix_acres==0] <- NA | |
#newmatrix2acres <- newmatrix_acres[complete.cases(newmatrix_acres[,1])] | |
#newmatrix2acres <- subset(newmatrix = TRUE) | |
#newmatrix_acres[newmatrix_acres == NA] <- 0 | |
#newmatrix_acres <- c(newmatrix_acres) | |
plotmonth <- month.abb[jj] | |
plotyear <- j | |
#plotcommodity <- x$commodity[1] | |
monthlist <- c("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC") | |
#monthlist2 <-match(monthlist,month.abb) | |
n <- match(jj, monthlist) | |
nn <- str_pad(n, 2, pad = "0") | |
#orderedcolors2 <- colorRampPalette(c(44)) | |
#m <- cbind(m$LOSS, newmatrix) | |
#midpoints <- barplot(mz$LOSS) | |
kkk <- gsub("\\s+","\\",kkk) | |
png(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/month_png/drought/", j, "_", nn, "_", kkk, "_plot.png", sep="")) | |
par(mar=c(3,3,3,2)+1) | |
#par(mfrow=c(1,1)) | |
#layout(matrix(c(1,2,3,3),2, 2, byrow=TRUE)) | |
layout(matrix(c(1,2,3,3), 2, 2, byrow = TRUE), | |
widths=c(2,1), heights=c(2,1)) | |
#par(mar=c(6,3,3,2)+1) | |
#par(mfrow=c(2,2)) | |
#layout(matrix(c(1,2,3,4),2, 2, byrow=TRUE)) | |
#--turn image horizontal | |
#------------------------begin barplot for animation | |
yeardir2 <- paste("/dmine/data/USDA/agmesh-scenarios/", "Idaho", "/summaries/", sep="") | |
ix <- paste("2001_2015_usda_gridmet_", "Idaho", sep="") | |
setwd(yeardir2) | |
DT2x <- as.data.frame(read.csv(ix, strip.white = TRUE)) | |
#---creating vector for every year and month for full barchart with 0 months. | |
N1 = 2001 | |
N2 = 2015 | |
N3 = 15 | |
newmatrixcomm <- matrix(NA, nrow=N3 * 12, ncol=1) | |
nmc <- c(1:(N3*12)) | |
mon <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12") | |
yr <- c(2001:2015) | |
tt <- 1 | |
for (iii in yr) { | |
for (jjj in mon) { | |
newmatrixcomm[tt,] <- paste(iii, ".", jjj, sep="") | |
tt <- tt + 1 | |
} | |
} | |
#---------------- | |
listzz <- newmatrixcomm | |
#---fix kkk spaces | |
kkkk <- gsub(" ", "", kkk, fixed = TRUE) | |
#--below - you need to include those months that have no data in the barplot. unizz only has populated values. How to get a column of all | |
#listzz <- list.files(paste("/dmine/data/USDA/agmesh-scenarios/", "Idaho", "/month_png/", "drought/", kkkk, sep="")) | |
#lisss <- length(listzz) | |
#newframez <- t(data.frame(strsplit(listzz, "\\.")[1:lisss])) | |
#newframez2 <- t(data.frame(strsplit(newframez[,1], "\\_")[1:lisss])) | |
#allunizz <- data.frame(sort(unique(paste(newframez2[,1], ".", newframez2[,2], sep="")))) | |
colnames(listzz) <- c("yearmonth") | |
#need to use allunizz with unizz to create a vector of loss with 0 values as needed | |
#monthpad <- str_pad(newframez2[,2], 2, pad = "0") | |
#newframez4 <- cbind(newframez2, monthpad) | |
#newframez5 <- data.frame(sort(paste(newframez4[,1], ".", newframez4[,5], sep=""))) | |
#colnames(newframez5) <- c("yearmonth") | |
DT2x$commodity <- gsub(" ", "", DT2x$commodity, fixed = TRUE) | |
#unizz <- sort(unique(paste(DT2x$year, ".", DT2x$monthcode, sep=""))) | |
DT2x <- subset(DT2x, damagecause == dcause ) | |
DT2x <- subset(DT2x, commodity == kkk) | |
DT2x <- data.table(DT2x) | |
##--merge | |
#DT3x <- merge(newframez5, DT2x, by='yearmonth') | |
DT2x$yearmonth <- paste(DT2x$year, ".", str_pad(DT2x$monthcode, 2, pad = "0"), sep="") | |
DT2lossx <- DT2x[,list(loss=sum(loss)), by = yearmonth] | |
nxx <- merge(DT2lossx, listzz, by='yearmonth', all=TRUE) | |
nxx[["loss"]][is.na(nxx[["loss"]])] <- 0 | |
#---- | |
monthlist <- c("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC") | |
#monthlist2 <-match(monthlist,month.abb) | |
n <- match(jj, monthlist) | |
yearmonth2 <- paste(j, ".", str_pad(n, 2, pad = "0"), sep="") | |
thenum <- which(nxx ==yearmonth2, arr.ind=TRUE) | |
par(mar=c(3,3,3,2)+1) | |
layout(matrix(c(1,2,3,3,3,3), 3, 2, byrow = TRUE), | |
widths=c(2,1), heights=c(2,1)) | |
#-------end data construction for bar plot for animation | |
midpoint_loss <- (max(m$loss) + min(m$loss)/2) | |
#midpoint_acres <- (max(m$acres) + min(m$acres)/2) | |
#b <- barplot(DT7$LOSS, names.arg = DT7$DAMAGECAUSE, las=2, col = newmatrix) | |
#text(bb, midpoint_loss, labels=mz$loss, srt=90) | |
#plot(m, col = newmatrix, main = paste(scen_state, " crop loss $ \n", " ", plotyear, "\n", plotcommodity, sep="")) | |
plot(m, col = newmatrix, main = paste(scen_state, " ", jj, " ", j, " ", kkk, "\n", "monthly total loss: $", DT7$LOSS, "\n", " monthly drought claims:", nrow(x), sep="")) | |
legend_image <- as.raster(matrix(rev(len4a_out), ncol=1)) | |
plot(c(0,3),c(0,DTzsum_max),type = 'n', axes = F,xlab = '', ylab = '', main = 'Loss $ Range: 2001-2015') | |
#text(x=1.5, y = c(0,5), labels = c(0,5)) | |
text(x=1.5, y = seq(0,DTzsum_max,l=5), labels = seq(0,DTzsum_max,l=5)) | |
rasterImage(legend_image, 0, 0, .35, DTzsum_max) | |
par(mar=c(6,8,5,5)) | |
par(lty = 1) | |
#--fix barplot xaxis names | |
baryears <- c("2001", "", "", "", "", "", "", "", "", "", "", "", | |
"2002", "", "", "", "", "", "", "", "", "", "", "", | |
"2003", "", "", "", "", "", "", "", "", "", "", "", | |
"2004", "", "", "", "", "", "", "", "", "", "", "", | |
"2005", "", "", "", "", "", "", "", "", "", "", "", | |
"2006", "", "", "", "", "", "", "", "", "", "", "", | |
"2007", "", "", "", "", "", "", "", "", "", "", "", | |
"2008", "", "", "", "", "", "", "", "", "", "", "", | |
"2009", "", "", "", "", "", "", "", "", "", "", "", | |
"2010", "", "", "", "", "", "", "", "", "", "", "", | |
"2011", "", "", "", "", "", "", "", "", "", "", "", | |
"2012", "", "", "", "", "", "", "", "", "", "", "", | |
"2013", "", "", "", "", "", "", "", "", "", "", "", | |
"2014", "", "", "", "", "", "", "", "", "", "", "", | |
"2015", "", "", "", "", "", "", "", "", "", "", "") | |
nxxsd <- sd(nxx$loss) | |
cols <- ifelse(nxx$loss > nxxsd, "red","blue") | |
#legend.col(col = len4a, lev = m$loss) | |
bar <- barplot(nxx$loss, space = 0, col=cols, xlab="", ylab="", main = paste(scen_state, " ", kkk, "\n", "Total loss by month, 2001 - 2015", sep="") | |
, names.arg = baryears, las = 2) | |
title(ylab="Commodity loss in dollars ($)", line=6, cex.lab=1.2) | |
title(xlab="Commodity loss totals ($) 2001- 2015", line=4, cex.lab=1.2) | |
#axis(1, xaxp=c(1, 15, 19), las=2) | |
#-plot the bar plot for the animation beside the map | |
abline(v=(bar[thenum[1]]), col="red", lty=2) | |
dev.off() | |
#bb <- barplot(DT7$ACRES, names.arg = DT7$DAMAGECAUSE, las=2, col = newmatrix_acres) | |
#text(b, midpoint_acres, labels=mzacres$acres, xpd=NA, col = "White") | |
#plot(m, col = newmatrix_acres, main = paste(scen_state, " crop loss acres \n", " ", plotyear, "\n", plotcommodity, sep="")) | |
} else { | |
m <- counties | |
m@data$loss <- runif(nrow(m@data)) | |
m$loss <- 0 | |
#------------ | |
#shapefile(m) | |
#--begin polygon work | |
#length(na.omit(m$LOSS)) | |
#tt <- colorRampPalette(brewer.pal(11, "Spectral") | |
tt <- colorRampPalette(c("blue", "orange", "red")) | |
#mz <- subset(m, LOSS != 0) | |
#mzacres <- subset(m, acres > 0) | |
#lengacres <- length(m$acres) | |
leng <- length(m$loss) | |
#len2 <- tt(len <- length(mz$loss)) | |
#len2acres <- tt(len <- length(mzacres$acres)) | |
#len2a <- length(mz$loss) | |
#len2a <- length(mzacres$acres) | |
len3 <- tt(len <- length(m$loss)) | |
#len4 <- tt(len <- length(m$acres)) | |
orderedcolors2a <- tt(length(m$loss)) | |
za <- as.data.frame(read.csv(i, strip.white = TRUE)) | |
DTz <- data.table(za) | |
DTz <- subset(DTz, damagecause == dcause) | |
DTz <- subset(DTz, commodity == kkk) | |
DTza <- as.data.frame(subset(DTz, loss > 0)) | |
DTzmax <- max(1) | |
DTzmin <- min(0) | |
DTzlen <- (nrow(DTza)/5) | |
#len4a_out <- tt((DTzmax - DTzmin)/DTzlen) | |
#if (is.data.frame(DTz) && nrow(DTz)==0) { | |
# DTzsum_max <<- 0 | |
#} else { | |
#DTzsum <- as.data.frame(aggregate(DTz$loss~DTz$month+DTz$year+DTz$county, DTz, sum)) | |
#colnames(DTzsum) <- c("month", "year", "county", "loss") | |
#DTzsum_max <<- max(DTzsum$loss) | |
#} | |
orderedcolors2 <- tt(length(m$loss))[order(order(m$loss))] | |
#orderedcolors3 <- tt(length(m$acres))[order(order(m$acres))] | |
#newframe <- data.frame(m$LOSS) | |
m[["loss"]][is.na(m[["loss"]])] <- 0 | |
#m[["acres"]][is.na(m[["acres"]])] <- 0 | |
xx <- 1 | |
newmatrix <- matrix(data = NA, nrow = leng, ncol = 1) | |
for (k in 1:leng){ | |
#if (DT7$LOSS[k] == 0) { | |
#print("yes this worked, added 0") | |
# newmatrix[k,] <- 0 | |
#} else { | |
#print("yes, this worked, added color") | |
#newmatrix[k,] <- len3[k] | |
newmatrix[k,] <- "#ffffff" | |
xx <- xx + 1 | |
} | |
#xx <- 1 | |
#newmatrix_acres <- matrix(data = NA, nrow = leng, ncol = 1) | |
#for (jj in 1:leng){ | |
#if (DT7$ACRES[jj] == 0) { | |
#print("yes this worked, added 0") | |
# newmatrix_acres[jj,] <- 0 | |
#} else { | |
#print("yes, this worked, added color") | |
#newmatrix[jj,] <- len4[jj] | |
#newmatrix_acres[jj,] <- orderedcolors3[xx] | |
#xx <- xx + 1 | |
#} | |
#newmatrix[newmatrix==0] <- NA | |
#newmatrix2 <- newmatrix[complete.cases(newmatrix[,1])] | |
#newmatrix2 <- subset(newmatrix = TRUE) | |
#newmatrix[newmatrix == NA] <- 0 | |
#newmatrix <- c(newmatrix) | |
#newmatrix_acres[newmatrix_acres==0] <- NA | |
#newmatrix2acres <- newmatrix_acres[complete.cases(newmatrix_acres[,1])] | |
#newmatrix2acres <- subset(newmatrix = TRUE) | |
#newmatrix_acres[newmatrix_acres == NA] <- 0 | |
#newmatrix_acres <- c(newmatrix_acres) | |
#------------------------begin barplot for animation | |
yeardir2 <- paste("/dmine/data/USDA/agmesh-scenarios/", "Idaho", "/summaries/", sep="") | |
ix <- paste("2001_2015_usda_gridmet_", "Idaho", sep="") | |
setwd(yeardir2) | |
DT2x <- as.data.frame(read.csv(ix, strip.white = TRUE)) | |
DT2x <- subset(DT2x, month = "JAN" & "FEB") | |
kkkk <- gsub(" ", "", kkk, fixed = TRUE) | |
#---creating vector for every year and month for full barchart with 0 months. | |
N1 = 2001 | |
N2 = 2015 | |
N3 = 15 | |
newmatrixcomm <- matrix(NA, nrow=N3 * 12, ncol=1) | |
nmc <- c(1:(N3*12)) | |
mon <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12") | |
yr <- c(2001:2015) | |
tt <- 1 | |
for (iii in yr) { | |
for (jjj in mon) { | |
newmatrixcomm[tt,] <- paste(iii, ".", jjj, sep="") | |
tt <- tt + 1 | |
} | |
} | |
#---------------- | |
listzz <- newmatrixcomm | |
#--below - you need to include those months that have no data in the barplot. unizz only has populated values. How to get a column of all | |
#listzztest <- list.files(paste("/dmine/data/USDA/agmesh-scenarios/", "Idaho", "/month_png/", "drought/", kkkk, sep="")) | |
#lisss <- length(listzz) | |
#newframez <- t(data.frame(strsplit(listzz, "\\.")[1:lisss])) | |
#newframez2 <- t(data.frame(strsplit(newframez[,1], "\\_")[1:lisss])) | |
#allunizz <- data.frame(sort(unique(paste(newframez2[,1], ".", newframez2[,2], sep="")))) | |
#colnames(allunizz) <- c("yearmonth") | |
#need to use allunizz with unizz to create a vector of loss with 0 values as needed | |
#monthpad <- str_pad(newframez2[,2], 2, pad = "0") | |
#newframez4 <- cbind(newframez2, monthpad) | |
#newframez5 <- data.frame(sort(paste(newframez4[,1], ".", newframez4[,5], sep=""))) | |
colnames(listzz) <- c("yearmonth") | |
DT2x$commodity <- gsub(" ", "", DT2x$commodity, fixed = TRUE) | |
#unizz <- sort(unique(paste(DT2x$year, ".", DT2x$monthcode, sep=""))) | |
DT2x <- subset(DT2x, damagecause == dcause ) | |
DT2x <- subset(DT2x, commodity == kkk) | |
DT2x <- data.table(DT2x) | |
##--merge | |
#DT3x <- merge(newframez5, DT2x, by='yearmonth') | |
DT2x$yearmonth <- paste(DT2x$year, ".", str_pad(DT2x$monthcode, 2, pad = "0"), sep="") | |
DT2lossx <- DT2x[,list(loss=sum(loss)), by = yearmonth] | |
nxx <- merge(DT2lossx, listzz, by='yearmonth', all=TRUE) | |
nxx[["loss"]][is.na(nxx[["loss"]])] <- 0 | |
#---- | |
monthlist <- c("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC") | |
#monthlist2 <-match(monthlist,month.abb) | |
n <- match(jj, monthlist) | |
yearmonth2 <- paste(j, ".", str_pad(n, 2, pad = "0"), sep="") | |
thenum <- which(nxx ==yearmonth2, arr.ind=TRUE) | |
#-------end data construction for bar plot for animation | |
plotmonth <- month.abb[jj] | |
plotyear <- j | |
#plotcommodity <- x$commodity[1] | |
monthlist <- c("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC") | |
#monthlist2 <-match(monthlist,month.abb) | |
n <- match(jj, monthlist) | |
nn <- str_pad(n, 2, pad = "0") | |
#orderedcolors2 <- colorRampPalette(c(44)) | |
#m <- cbind(m$LOSS, newmatrix) | |
#midpoints <- barplot(mz$LOSS) | |
kkk <- gsub("\\s+","\\",kkk) | |
png(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/month_png/drought/", j, "_", nn, "_", kkk, "_plot.png", sep="")) | |
#par(mar=c(1,1,1,1)) | |
#par(mar=c(3,3,3,2)+1) | |
#par(mfrow=c(1,1)) | |
#layout(matrix(c(1,2,3,4),2, 2, byrow=TRUE)) #--changes from 1, 2, to 2, 1 for additional plot | |
#par(mfrow=c(1,1)) | |
#layout(matrix(c(1,2,3,3),2, 2, byrow=TRUE)) | |
#par(mar=c(3,3,3,2)+1) | |
#layout(matrix(c(1,2,3,3), 2, 2, byrow = TRUE), | |
# widths=c(2,1), heights=c(2,1)) | |
par(mar=c(3,3,3,2)+1) | |
layout(matrix(c(1,2,3,3,3,3), 3, 2, byrow = TRUE), | |
widths=c(2,1), heights=c(2,1)) | |
#layout(matrix(c(1,2,3,4),2, 2, byrow=TRUE)) | |
#--turn image horizontal | |
#plotmonth <- month.abb[x$monthcode[1]] | |
#plotyear <- x$year[1] | |
#plotcommodity <- x$commodity[1] | |
midpoint_loss <- (max(m$loss) + min(m$loss)/2) | |
#midpoint_acres <- (max(m$acres) + min(m$acres)/2) | |
#b <- barplot(m$loss, names.arg = m$loss, las=2, col = newmatrix) | |
#text(bb, midpoint_loss, labels=mz$loss, srt=90) | |
plot(m, col = newmatrix, main = paste(scen_state, " ", jj, " ", j, " ", kkk, "\n", "monthly total loss: $", "0", "\n", " monthly drought claims:", "0", sep="")) | |
#legend_image <- as.raster(matrix(rev(len4a_out), ncol=1)) | |
#plot(c(0,2),c(0,DTzmax),type = 'n', axes = F,xlab = '', ylab = '', main = 'legend title') | |
##text(x=1.5, y = c(0,5), labels = c(0,5)) | |
#text(x=1.5, y = seq(0,DTzmax,l=5), labels = seq(0,DTzmax,l=5)) | |
#rasterImage(legend_image, 0, 0, 1, 1 ) | |
if (DTzsum_maxz == 0) { | |
legend_image <- as.raster(matrix(rev(len4a_out), ncol=1)) | |
plot(c(0,3),c(0,DTzmax1),type = 'n', axes = F,xlab = '', ylab = '', main = 'Loss $ Range: 2001-2015') | |
#text(x=1.5, y = c(0,5), labels = c(0,5)) | |
text(x=1.5, y = seq(0,DTzmax1,l=5), labels = seq(0,DTzmax1,l=5)) | |
rasterImage(legend_image, 0, 0, .35, DTzmax1) | |
} else { | |
legend_image <- as.raster(matrix(rev(len4a_out), ncol=1)) | |
plot(c(0,3),c(0,DTzsum_maxz),type = 'n', axes = F,xlab = '', ylab = '', main = 'Commodity Loss $ Range: 2001-2015') | |
text(x=1.5, y = c(0,5), labels = c(0,5)) | |
text(x=1.5, y = seq(0,DTzsum_maxz,l=5), labels = seq(0,DTzsum_maxz,l=5)) | |
rasterImage(legend_image, 0, 0, .35, DTzsum_maxz) | |
} | |
#plot(m, col = newmatrix, main = paste(scen_state, " crop loss $ \n", " ", jj, " ", j, "\n", kkk, sep="")) | |
#legend.col(col = orderedcolors2a, lev = m$loss) | |
par(mar=c(6,8,5,5)) | |
par(lty = 1) | |
#--fix barplot xaxis names | |
baryears <- c("2001", "", "", "", "", "", "", "", "", "", "", "", | |
"2002", "", "", "", "", "", "", "", "", "", "", "", | |
"2003", "", "", "", "", "", "", "", "", "", "", "", | |
"2004", "", "", "", "", "", "", "", "", "", "", "", | |
"2005", "", "", "", "", "", "", "", "", "", "", "", | |
"2006", "", "", "", "", "", "", "", "", "", "", "", | |
"2007", "", "", "", "", "", "", "", "", "", "", "", | |
"2008", "", "", "", "", "", "", "", "", "", "", "", | |
"2009", "", "", "", "", "", "", "", "", "", "", "", | |
"2010", "", "", "", "", "", "", "", "", "", "", "", | |
"2011", "", "", "", "", "", "", "", "", "", "", "", | |
"2012", "", "", "", "", "", "", "", "", "", "", "", | |
"2013", "", "", "", "", "", "", "", "", "", "", "", | |
"2014", "", "", "", "", "", "", "", "", "", "", "", | |
"2015", "", "", "", "", "", "", "", "", "", "", "") | |
nxxsd <- sd(nxx$loss) | |
cols <- ifelse(nxx$loss > nxxsd, "red","blue") | |
#legend.col(col = len4a, lev = m$loss) | |
bar <- barplot(nxx$loss, space = 0, col=cols, xlab="", ylab="", main = paste(scen_state, " ", kkk, "\n", "Total loss by month, 2001 - 2015", sep="") | |
, names.arg = baryears, las = 2) | |
title(ylab="Commodity loss in dollars ($)", line=6, cex.lab=1.2) | |
title(xlab="Commodity loss totals ($) 2001- 2015", line=4, cex.lab=1.2) | |
#bar <- barplot(nxx$loss) #-plot the bar plot for the animation beside the map | |
abline(v=(bar[thenum[1]]), col="red", lty=2) | |
dev.off() | |
#bb <- barplot(DT7$ACRES, names.arg = DT7$DAMAGECAUSE, las=2, col = newmatrix_acres) | |
#text(b, midpoint_acres, labels=mzacres$acres, xpd=NA, col = "White") | |
#plot(m, col = newmatrix_acres, main = paste(scen_state, " crop loss acres \n", " ", plotyear, "\n", plotcommodity, sep="")) | |
} }}} | |
listz <- list.files(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/month_png/", dcause, sep="")) | |
subset(listz, grepl("*.png",listz)) | |
liss <- length(listz) | |
newframe <- t(data.frame(strsplit(listz, "\\_")[1:liss])) | |
uniz <- unique(newframe[,3]) | |
for (i in uniz) { | |
setwd(paste("/dmine/data/USDA/agmesh-scenarios/", scen_state, "/month_png/", dcause, sep="")) | |
system(paste("mkdir ", i, sep="")) | |
system(paste("mv *_", i, "_*", " /dmine/data/USDA/agmesh-scenarios/", scen_state, "/month_png/", dcause, "/", i, sep="")) | |
} |