Plotaggio di calendari di ritaglio

Question

Ho un file csv (crop_calendar.csv) contenente informazioni sulle fasi di sviluppo del raccolto in una particolare regione. Fondamentalmente ogni riga ha la seguente struttura:

crop_name sowing_dat emergence_date flowering_date maturity_date harvest_date 

che dà ad esempio:

Winter_wheat 18.08 28.08 24.06 30.07 3.08 
Winter_rye  18.08 28.08 15.06 23.07 29.07 
Spring_wheat 27.04 10.05 1.07 4.08 7.08 
Spring_barley 27.04 12.05 27.06 1.08 5.08 

Ora, mi piacerebbe mettere le informazioni in un grafico che assomiglia a quello:

Qualche idea su come farlo con un sacco di colture (righe) e in luoghi diversi?

Answer 1

Ecco un esempio ammesso che abbiate la day.of.year() della semina e la durata (in giorni) dei tre periodi per ogni coltura e ogni paese.

#making random numbers reproducible 
set.seed(12345) 
rawdata <- expand.grid(
    Crop = paste("Crop", LETTERS[1:8]), 
    Country = paste("Country", letters[10:13]) 
) 
#day.of.year of sowing 
rawdata$Sowing <- runif(nrow(rawdata), min = 0, max = 365) 
#number of days until mid season 
rawdata$Midseason <- runif(nrow(rawdata), min = 10, max = 30) 
#number of days until harvest 
rawdata$Harvest <- runif(nrow(rawdata), min = 20, max = 150) 
#number of days until end of harvest 
rawdata$Harvest.end <- runif(nrow(rawdata), min = 10, max = 40) 

dataset <- data.frame(Crop = character(0), Country = character(0), Period = character(0), Duration = numeric(0)) 

#sowing around new year 
last.day <- rowSums(rawdata[, c("Sowing", "Midseason")]) 
if(any(last.day >= 365)){ 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Sowing", 
     Duration = last.day[last.day >= 365] - 365 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Mid-season", 
     Duration = rawdata$Harvest[last.day >= 365] 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Harvest", 
     Duration = rawdata$Harvest.end[last.day >= 365] 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = NA, 
     Duration = 365 - rowSums(rawdata[last.day >= 365, c("Midseason", "Harvest", "Harvest.end")]) 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Sowing", 
     Duration = 365 - rawdata$Sowing[last.day >= 365] 
    ) 
) 
    rawdata <- rawdata[last.day < 365, ] 
} 

#mid-season around new year 
last.day <- rowSums(rawdata[, c("Sowing", "Midseason", "Harvest")]) 
if(any(last.day >= 365)){ 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Mid-season", 
     Duration = last.day[last.day >= 365] - 365 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Harvest", 
     Duration = rawdata$Harvest.end[last.day >= 365] 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = NA, 
     Duration = 365 - rowSums(rawdata[last.day >= 365, c("Midseason", "Harvest", "Harvest.end")]) 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Sowing", 
     Duration = rawdata$Midseason[last.day >= 365] 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Mid-season", 
     Duration = 365 - rowSums(rawdata[last.day >= 365, c("Sowing", "Midseason")]) 
    ) 
) 
    rawdata <- rawdata[last.day < 365, ] 
} 


#harvest around new year 
last.day <- rowSums(rawdata[, c("Sowing", "Midseason", "Harvest", "Harvest.end")]) 
if(any(last.day >= 365)){ 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Harvest", 
     Duration = last.day[last.day >= 365] - 365 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = NA, 
     Duration = 365 - rowSums(rawdata[last.day >= 365, c("Midseason", "Harvest", "Harvest.end")]) 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Sowing", 
     Duration = rawdata$Midseason[last.day >= 365] 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Mid-season", 
     Duration = rawdata$Harvest[last.day >= 365] 
    ) 
) 
    dataset <- rbind(
    dataset, 
    cbind(
     rawdata[last.day >= 365, c("Crop", "Country")], 
     Period = "Harvest", 
     Duration = 365 - rowSums(rawdata[last.day >= 365, c("Sowing", "Midseason", "Harvest")]) 
    ) 
) 
    rawdata <- rawdata[last.day < 365, ] 
} 


#no crop around new year 
dataset <- rbind(
    dataset, 
    cbind(
    rawdata[, c("Crop", "Country")], 
    Period = NA, 
    Duration = rawdata$Sowing 
) 
) 
dataset <- rbind(
    dataset, 
    cbind(
    rawdata[, c("Crop", "Country")], 
    Period = "Sowing", 
    Duration = rawdata$Midseason 
) 
) 
dataset <- rbind(
    dataset, 
    cbind(
    rawdata[, c("Crop", "Country")], 
    Period = "Mid-season", 
    Duration = rawdata$Harvest 
) 
) 
dataset <- rbind(
    dataset, 
    cbind(
    rawdata[, c("Crop", "Country")], 
    Period = "Harvest", 
    Duration = rawdata$Harvest.end 
) 
) 
dataset <- rbind(
    dataset, 
    cbind(
    rawdata[, c("Crop", "Country")], 
    Period = NA, 
    Duration = 365 - rowSums(rawdata[, c("Sowing", "Midseason", "Harvest")]) 
) 
) 

Labels <- c("", "Jan.", "Feb.", "Mar.", "Apr.", "May", "Jun.", "Jul.", "Aug.", "Sep.", "Okt.", "Nov.", "Dec.") 
Breaks <- cumsum(c(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)) 
ggplot(dataset, aes(x = Crop, y = Duration, colour = Period, fill = Period)) + geom_bar(stat = "identity") + facet_wrap(~Country) + coord_flip() + scale_fill_manual(values = c("Sowing" = "darkgreen", "Mid-season" = "grey", "Harvest" = "yellow")) + scale_colour_manual(values = c("Sowing" = "black", "Mid-season" = "black", "Harvest" = "black"), guide = "none") + scale_y_continuous("", breaks = Breaks, labels = Labels, limits = c(0, 365)) + theme_bw() + theme(axis.text.x = element_text(hjust = 1)) 

Answer 2

È difficile indovinare cosa si vuole fare. Con solo 3 date non puoi riprodurre il grafico che mostri (richiede 4 date per ciascuna coltura). Inoltre non è chiaro cosa rappresentino i numeri (presumibilmente settimane?). Se è solo una domanda sulla trama, questo ti farà iniziare. Altrimenti, ti preghiamo di chiarire la domanda.

df <- read.table(text="crop_name emergence_date maturity_date harvest_date 
       wheat  13.04   25.05   30.06 
       corn   12.02   21.30   23.11", header=TRUE) 
require(ggplot2) 
ggplot(df, aes(x=crop_name)) + 
    geom_linerange(aes(ymin=emergence_date, ymax=maturity_date), color="green3", size=5) + 
    geom_linerange(aes(ymin=maturity_date, ymax=harvest_date), color="yellow", size=5) + 
    coord_flip() + ylim(0, 52) 

Answer 3

Ok risposte così compilazione e con ulteriori ricerche, ecco la soluzione ho finito con:

inDf <- read.table(text="crop  sowing emergence flowering maturity harvesting 
         Spring barley 27/04/2013 12/05/2013 27/06/2013 1/08/2013 5/08/2013 
         Oats 27/04/2013 10/05/2013 29/06/2013 6/08/2013 8/08/2013 
         Maize 25/05/2013 6/06/2013 18/08/2013 10/09/2013 12/09/2013", header=TRUE) 

inDf[, "sowing"]  <- as.Date(inDf[, "sowing"], format = '%d/%m/%Y') 
inDf[, "emergence"] <- as.Date(inDf[, "emergence"], format = '%d/%m/%Y') 
inDf[, "flowering"] <- as.Date(inDf[, "flowering"], format = '%d/%m/%Y') 
inDf[, "maturity"] <- as.Date(inDf[, "maturity"], format = '%d/%m/%Y') 
inDf[, "harvesting"] <- as.Date(inDf[, "harvesting"], format = '%d/%m/%Y') 

ggplot(inDf, aes(x=crop)) + 
geom_linerange(aes(ymin=sowing, ymax=emergence), color="green", size=5) + 
geom_linerange(aes(ymin=emergence, ymax=flowering), color="green3", size=5) + 
geom_linerange(aes(ymin=flowering, ymax=maturity), color="yellow", size=5) + 
geom_linerange(aes(ymin=maturity, ymax=harvesting), color="red", size=5) + 
coord_flip() + scale_y_date(lim = c(as.Date("2012-08-15"), as.Date("2013-09-01")),breaks=date_breaks(width = "1 month"), labels = date_format("%b"))+ 
ggtitle('Crop Calendar')+ xlab("")+ylab("") 

che dà:

MA

mi piacerebbe ora per aggiungere la legenda e rimuovere tutte le linee bianche tra ogni mese. Qualche idea? Grazie

Answer 4

Per aggiungere leggenda posto "color=.." all'interno della chiamata aes() in ogni geom_linerange() e quindi aggiungere scale_color_identity() con argomento guide="legend" - questo utilizzerà i nomi dei colori come i colori reali. Con labels= puoi cambiare le etichette nella legenda. Per rimuovere le linee tra i mesi aggiungere minor_breaks=NULL all'interno dello scale_y_date().

ggplot(inDf, aes(x=crop)) + 
    geom_linerange(aes(ymin=sowing, ymax=emergence, color="green"), size=5) + 
    geom_linerange(aes(ymin=emergence, ymax=flowering, color="green3"), size=5) + 
    geom_linerange(aes(ymin=flowering, ymax=maturity, color="yellow"), size=5) + 
    geom_linerange(aes(ymin=maturity, ymax=harvesting, color="red"), size=5) + 
    coord_flip() + 
    scale_y_date(lim = c(as.Date("2012-08-15"), as.Date("2013-09-01")), 
       breaks=date_breaks(width = "1 month"), labels = date_format("%b"), 
       minor_breaks=NULL)+ 
    ggtitle('Crop Calendar')+ xlab("")+ylab("")+ 
    scale_color_identity("",guide="legend", 
         labels=c("emergence","flowering","maturity","harvesting"))