Mercurial > repos > greg > insect_phenology_model
changeset 35:29ec818b1c29 draft
Uploaded
| author | greg |
|---|---|
| date | Tue, 20 Mar 2018 09:45:26 -0400 |
| parents | 7aa848b0e55c |
| children | 5097cfeedc4f |
| files | insect_phenology_model.R test-data/plot.pdf |
| diffstat | 2 files changed, 79 insertions(+), 51 deletions(-) [+] |
line wrap: on
line diff
--- a/insect_phenology_model.R Mon Mar 19 14:49:05 2018 -0400 +++ b/insect_phenology_model.R Tue Mar 20 09:45:26 2018 -0400 @@ -62,37 +62,6 @@ return(data_frame); } -get_x_axis_ticks_and_labels = function(temperature_data_frame, num_rows) { - # Keep track of the years to see if spanning years. - month_labels = list(); - ticks = list(); - current_month_label = NULL; - for (i in 1:num_rows) { - # Get the year and month from the date which - # has the format YYYY-MM-DD. - date = format(temperature_data_frame$DATE[i]); - # Get the month label. - items = strsplit(date, "-")[[1]]; - month = items[2]; - month_label = month.abb[as.integer(month)]; - if (!identical(current_month_label, month_label)) { - # Add an x-axis tick for the month. - ticks[length(ticks)+1] = i; - month_labels[length(month_labels)+1] = month_label; - current_month_label = month_label; - } - # Get the day. - day = weekdays(as.Date(date)); - if (day=="Sunday") { - # Add an x-axis tick if we're on a Sunday. - ticks[length(ticks)+1] = i; - # Add a blank month label so it is not displayed. - month_labels[length(month_labels)+1] = ""; - } - } - return(list(ticks, month_labels)); -} - get_file_path = function(life_stage, base_name, life_stage_nymph=NULL, life_stage_adult=NULL) { if (!is.null(life_stage_nymph)) { lsi = get_life_stage_index(life_stage, life_stage_nymph=life_stage_nymph); @@ -224,6 +193,68 @@ return(c(curr_mean_temp, averages)) } +get_tick_index = function(index, last_tick, ticks, month_labels) { + # The R code tries hard not to draw overlapping tick labels, and so + # will omit labels where they would abut or overlap previously drawn + # labels. This can result in, for example, every other tick being + # labelled. We'll keep track of the last tick to make sure all of + # the month labels are displayed, and missing ticks are restricted + # to Sundays which have no labels anyway. + if (last_tick==0) { + return(length(ticks)+1); + } + last_saved_tick = ticks[[length(ticks)]]; + if (index-last_saved_tick<6) { + last_saved_month = month_labels[[length(month_labels)]]; + if (last_saved_month=="") { + # We're safe overwriting a tick + # with no label (i.e., a Sunday tick). + return(length(ticks)); + } else { + # Don't eliminate a Month label. + return(NULL); + } + } + return(length(ticks)+1); +} + +get_x_axis_ticks_and_labels = function(temperature_data_frame, num_rows) { + # Keep track of the years to see if spanning years. + month_labels = list(); + ticks = list(); + current_month_label = NULL; + last_tick = 0; + for (i in 1:num_rows) { + # Get the year and month from the date which + # has the format YYYY-MM-DD. + date = format(temperature_data_frame$DATE[i]); + # Get the month label. + items = strsplit(date, "-")[[1]]; + month = items[2]; + month_label = month.abb[as.integer(month)]; + tick_index = get_tick_index(i, last_tick, ticks, month_labels) + if (!is.null(tick_index)) { + if (!identical(current_month_label, month_label)) { + # Add an x-axis tick for the month. + ticks[tick_index] = i; + month_labels[tick_index] = month_label; + current_month_label = month_label; + last_tick = i; + } + # Get the day. + day = weekdays(as.Date(date)); + if (day=="Sunday") { + # Add an x-axis tick if we're on a Sunday. + ticks[tick_index] = i; + # Add a blank month label so it is not displayed. + month_labels[tick_index] = ""; + last_tick = i; + } + } + } + return(list(ticks, month_labels)); +} + mortality.adult = function(temperature) { if (temperature < 12.7) { mortality.probability = 0.002; @@ -281,12 +312,12 @@ title = paste(insect, ": Reps", replications, ":", life_stage, "Pop :", location, ": Lat", latitude, ":", start_date, "-", end_date, sep=" "); legend_text = c("Egg", "Nymph", "Adult"); columns = c(4, 2, 1); - plot(days, group, main=title, type="l", ylim=c(0, maxval), axes=F, lwd=2, xlab="", ylab="", cex=3, cex.lab=3, cex.axis=3, cex.main=3); + plot(days, group, main=title, type="l", ylim=c(0, maxval), axes=FALSE, lwd=2, xlab="", ylab="", cex=3, cex.lab=3, cex.axis=3, cex.main=3); legend("topleft", legend_text, lty=c(1, 1, 1), col=columns, cex=3); lines(days, group2, lwd=2, lty=1, col=2); lines(days, group3, lwd=2, lty=1, col=4); - axis(side=1, at=ticks, labels=date_labels); - axis(side=2); + axis(side=1, at=ticks, labels=date_labels, font.axis=3, xpd=TRUE, cex=3, cex.lab=3, cex.axis=3, cex.main=3); + axis(side=2, font.axis=3, xpd=TRUE, cex=3, cex.lab=3, cex.axis=3, cex.main=3); if (plot_std_error=="yes") { # Standard error for group. lines(days, group+group_std_error, lty=2); @@ -314,10 +345,10 @@ legend_text = c(paste(life_stages_adult, life_stage, sep=" ")); columns = c(1); } - plot(days, group, main=title, type="l", ylim=c(0, maxval), axes=F, lwd=2, xlab="", ylab="", cex=3, cex.lab=3, cex.axis=3, cex.main=3); + plot(days, group, main=title, type="l", ylim=c(0, maxval), axes=FALSE, lwd=2, xlab="", ylab="", cex=3, cex.lab=3, cex.axis=3, cex.main=3); legend("topleft", legend_text, lty=c(1), col="black", cex=3); - axis(side=1, at=ticks, labels=date_labels); - axis(side=2); + axis(side=1, at=ticks, labels=date_labels, font.axis=3, xpd=TRUE, cex=3, cex.lab=3, cex.axis=3, cex.main=3); + axis(side=2, font.axis=3, xpd=TRUE, cex=3, cex.lab=3, cex.axis=3, cex.main=3); if (plot_std_error=="yes") { # Standard error for group. lines(days, group+group_std_error, lty=2); @@ -337,12 +368,12 @@ title = paste(insect, ": Reps", replications, title_str, location, ": Lat", latitude, ":", start_date, "-", end_date, sep=" "); legend_text = c("P", "F1", "F2"); columns = c(1, 2, 4); - plot(days, group, main=title, type="l", ylim=c(0, maxval), axes=F, lwd=2, xlab="", ylab="", cex=3, cex.lab=3, cex.axis=3, cex.main=3); + plot(days, group, main=title, type="l", ylim=c(0, maxval), axes=FALSE, lwd=2, xlab="", ylab=""); legend("topleft", legend_text, lty=c(1, 1, 1), col=columns, cex=3); lines(days, group2, lwd=2, lty=1, col=2); lines(days, group3, lwd=2, lty=1, col=4); - axis(side=1, at=ticks, labels=date_labels); - axis(side=2); + axis(side=1, at=ticks, labels=date_labels, font.axis=3, xpd=TRUE, cex=3, cex.lab=3, cex.axis=3, cex.main=3); + axis(side=2, font.axis=3, xpd=TRUE, cex=3, cex.lab=3, cex.axis=3, cex.main=3); if (plot_std_error=="yes") { # Standard error for group. lines(days, group+group_std_error, lty=2);
--- a/test-data/plot.pdf Mon Mar 19 14:49:05 2018 -0400 +++ b/test-data/plot.pdf Tue Mar 20 09:45:26 2018 -0400 @@ -1,11 +1,12 @@ -%PDF +%PDF-1.4 1 0 obj -<< /CreationDate /ModDate /Title (R Graphics Output) /Producer /Creator (R) +endobj +2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj @@ -17,7 +18,7 @@ 4 0 obj << /ProcSet [/PDF /Text] -/Font <</F2 10 0 R /F3 11 0 R >> +/Font <</F2 10 0 R /F3 11 0 R /F4 12 0 R >> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> @@ -25,10 +26,6 @@ 5 0 obj [/ICCBased 6 0 R] endobj -6 0 obj -<< /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> -stream -endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding @@ -45,8 +42,8 @@ << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj -xref -trailer -<< /Size 12 /Info 1 0 R /Root 2 0 R >> -startxref +12 0 obj +<< /Type /Font /Subtype /Type1 /Name /F4 /BaseFont /Helvetica-Oblique +/Encoding 9 0 R >> +endobj %%EOF