r - Removing for loop -
i trying run function have written have realised going take long. can tell me best way remove loop in following function. function aims read load of site weather data , find weather extreme has been exceeded on particular day average extreme of month.
i trying use ifelse failing.
extremes <- function (siteno){ (j in siteno){ # reads in weather data specipied site butterfly_data <- read.csv(paste("~/project data/site subsets/site", j, ".csv", sep = "")) precip <- read.csv(paste("//ueahome5/ressci5/zuw13bqu/data/ntprofile/desktop/eobs european data/siteweather/rr/weather.site.", j, ".csv", sep = "")) tmin <- read.csv(paste("//ueahome5/ressci5/zuw13bqu/data/ntprofile/desktop/eobs european data/siteweather/tn/weather.site.", j, ".csv", sep = "")) tmax <- read.csv(paste("//ueahome5/ressci5/zuw13bqu/data/ntprofile/desktop/eobs european data/siteweather/tx/weather.site.", j, ".csv", sep = "")) precip[precip[,1] < -900,1] <- na tmax[tmax[,1] < -90, 1] <- na tmin[tmin[,1] < -90, 1] <- na z <- merge(precip, tmax, by.x = "date", by.y = "date") # merges weather data 1 dataframe siteweather <- merge(z, tmin, by.x = "date", by.y = "date" ) siteweather[,1] <- as.date(siteweather[,1], "%d/%m/%y") siteweather[,5] <- as.numeric(format(siteweather[,1], "%m")) # takes out month value date able assess means month , create seasonal means throughout dataset janweather<- subset(siteweather, siteweather[,5] == 1)#split weather months febweather<- subset(siteweather, siteweather[,5] == 2) marweather<- subset(siteweather, siteweather[,5] == 3) aprweather<- subset(siteweather, siteweather[,5] == 4) mayweather<- subset(siteweather, siteweather[,5] == 5) junweather<- subset(siteweather, siteweather[,5] == 6) julweather<- subset(siteweather, siteweather[,5] == 7) augweather<- subset(siteweather, siteweather[,5] == 8) sepweather<- subset(siteweather, siteweather[,5] == 9) octweather<- subset(siteweather, siteweather[,5] == 10) novweather<- subset(siteweather, siteweather[,5] == 11) decweather<- subset(siteweather, siteweather[,5] == 12) janextprecip <- mean(janweather[,2], na.rm = true) + sd(janweather[,2], na.rm = true) janexttmax <- mean(janweather[,3], na.rm = true) + sd(janweather[,3], na.rm = true) janexttmin <- mean(janweather[,4], na.rm = true) - sd(janweather[,4], na.rm = true) febextprecip <- mean(febweather[,2], na.rm = true) + sd(febweather[,2], na.rm = true) febexttmax <- mean(febweather[,3], na.rm = true) + sd(febweather[,3], na.rm = true) febexttmin <- mean(febweather[,4], na.rm = true) - sd(febweather[,4], na.rm = true) marextprecip <- mean(marweather[,2], na.rm = true) + sd(marweather[,2], na.rm = true) marexttmax <- mean(marweather[,3], na.rm = true) + sd(marweather[,3], na.rm = true) marexttmin <- mean(marweather[,4], na.rm = true) - sd(marweather[,4], na.rm = true) aprextprecip <- mean(aprweather[,2], na.rm = true) + sd(aprweather[,2], na.rm = true) aprexttmax <- mean(aprweather[,3], na.rm = true) + sd(aprweather[,3], na.rm = true) aprexttmin <- mean(aprweather[,4], na.rm = true) - sd(aprweather[,4], na.rm = true) mayextprecip <- mean(mayweather[,2], na.rm = true) + sd(mayweather[,2], na.rm = true) mayexttmax <- mean(mayweather[,3], na.rm = true) + sd(mayweather[,3], na.rm = true) mayexttmin <- mean(mayweather[,4], na.rm = true) - sd(mayweather[,4], na.rm = true) junextprecip <- mean(junweather[,2], na.rm = true) + sd(junweather[,2], na.rm = true) junexttmax <- mean(junweather[,3], na.rm = true) + sd(junweather[,3], na.rm = true) junexttmin <- mean(junweather[,4], na.rm = true) - sd(junweather[,4], na.rm = true) julextprecip <- mean(julweather[,2], na.rm = true) + sd(julweather[,2], na.rm = true) julexttmax <- mean(julweather[,3], na.rm = true) + sd(julweather[,3], na.rm = true) julexttmin <- mean(julweather[,4], na.rm = true) - sd(julweather[,4], na.rm = true) augextprecip <- mean(augweather[,2], na.rm = true) + sd(augweather[,2], na.rm = true) augexttmax <- mean(augweather[,3], na.rm = true) + sd(augweather[,3], na.rm = true) augexttmin <- mean(augweather[,4], na.rm = true) - sd(augweather[,4], na.rm = true) sepextprecip <- mean(sepweather[,2], na.rm = true) + sd(sepweather[,2], na.rm = true) sepexttmax <- mean(sepweather[,3], na.rm = true) + sd(sepweather[,3], na.rm = true) sepexttmin <- mean(sepweather[,4], na.rm = true) - sd(sepweather[,4], na.rm = true) octextprecip <- mean(octweather[,2], na.rm = true) + sd(octweather[,2], na.rm = true) octexttmax <- mean(octweather[,3], na.rm = true) + sd(octweather[,3], na.rm = true) octexttmin <- mean(octweather[,4], na.rm = true) - sd(octweather[,4], na.rm = true) novextprecip <- mean(novweather[,2], na.rm = true) + sd(novweather[,2], na.rm = true) novexttmax <- mean(novweather[,3], na.rm = true) + sd(novweather[,3], na.rm = true) novexttmin <- mean(novweather[,4], na.rm = true) - sd(novweather[,4], na.rm = true) decextprecip <- mean(decweather[,2], na.rm = true) + sd(decweather[,2], na.rm = true) decexttmax <- mean(decweather[,3], na.rm = true) + sd(decweather[,3], na.rm = true) decexttmin <- mean(decweather[,4], na.rm = true) - sd(decweather[,4], na.rm = true) for(i in 1:length(siteweather[,1])) { if(siteweather[i,5]== 1 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= janextprecip) #checks whether daily value exceeds daily extreme average extreme of each month siteweather[i,7] <- 1*(siteweather[i,3] >= janexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= janexttmin) } if(siteweather[i,5]== 2 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= febextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= febexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= febexttmin) } if(siteweather[i,5]== 3 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= marextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= marexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= marexttmin) } if(siteweather[i,5]== 4 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= aprextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= aprexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= aprexttmin) } if(siteweather[i,5]== 5 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= mayextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= mayexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= mayexttmin) } if(siteweather[i,5]== 6 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= junextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= junexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= junexttmin) } if(siteweather[i,5]== 7 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= julextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= julexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= julexttmin) } if(siteweather[i,5]== 8 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= augextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= augexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= augexttmin) } if(siteweather[i,5]== 9 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= sepextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= sepexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= sepexttmin) } if(siteweather[i,5]== 10 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= octextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= octexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= octexttmin) } if(siteweather[i,5]== 11 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= novextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= novexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= novexttmin) } if(siteweather[i,5]== 12 ){ siteweather[i,6] <- 1*(siteweather[i,2] >= decextprecip) #checks whether daily value exceeds daily extreme siteweather[i,7] <- 1*(siteweather[i,3] >= decexttmax) siteweather[i,8] <- 1*(siteweather[i,4] <= decexttmin) } print(i) } colnames(siteweather)<- c("date", "precip", "tmax", "tmin","month" ,"extprecip", "exttmax", "exttmin" ) siteweather<- siteweather[order(as.date(siteweather[,1])),] write.table(siteweather, paste("site.", j, ".csv", sep = ",", row.names = false)) print(j) } } here attempt use ifelse:
extremes<- function (siteno){ (j in siteno){ # reads in weather data specipied site butterfly_data <- read.csv(paste("~/project data/site subsets/site", j, ".csv", sep = "")) precip <- read.csv(paste("//ueahome5/ressci5/zuw13bqu/data/ntprofile/desktop/eobs european data/siteweather/rr/weather.site.", j, ".csv", sep = "")) tmin <- read.csv(paste("//ueahome5/ressci5/zuw13bqu/data/ntprofile/desktop/eobs european data/siteweather/tn/weather.site.", j, ".csv", sep = "")) tmax <- read.csv(paste("//ueahome5/ressci5/zuw13bqu/data/ntprofile/desktop/eobs european data/siteweather/tx/weather.site.", j, ".csv", sep = "")) precip[precip[,1] < -900,1]<- na tmax[tmax[,1] < -90, 1]<- na tmin[tmin[,1] < -90, 1]<- na z<- merge(precip, tmax, by.x = "date", by.y = "date") # merges weather data 1 dataframe siteweather <- merge(z, tmin, by.x = "date", by.y = "date" ) siteweather[,1] <- as.date(siteweather[,1], "%d/%m/%y") siteweather[,5] <- as.numeric(format(siteweather[,1], "%m")) # takes out month value date able assess means month , create seasonal means throughout dataset janweather<- subset(siteweather, siteweather[,5] == 1)#split weather months febweather<- subset(siteweather, siteweather[,5] == 2) marweather<- subset(siteweather, siteweather[,5] == 3) aprweather<- subset(siteweather, siteweather[,5] == 4) mayweather<- subset(siteweather, siteweather[,5] == 5) junweather<- subset(siteweather, siteweather[,5] == 6) julweather<- subset(siteweather, siteweather[,5] == 7) augweather<- subset(siteweather, siteweather[,5] == 8) sepweather<- subset(siteweather, siteweather[,5] == 9) octweather<- subset(siteweather, siteweather[,5] == 10) novweather<- subset(siteweather, siteweather[,5] == 11) decweather<- subset(siteweather, siteweather[,5] == 12) janextprecip <- mean(janweather[,2], na.rm = true) + sd(janweather[,2], na.rm = true) janexttmax <- mean(janweather[,3], na.rm = true) + sd(janweather[,3], na.rm = true) janexttmin <- mean(janweather[,4], na.rm = true) - sd(janweather[,4], na.rm = true) febextprecip <- mean(febweather[,2], na.rm = true) + sd(febweather[,2], na.rm = true) febexttmax <- mean(febweather[,3], na.rm = true) + sd(febweather[,3], na.rm = true) febexttmin <- mean(febweather[,4], na.rm = true) - sd(febweather[,4], na.rm = true) marextprecip <- mean(marweather[,2], na.rm = true) + sd(marweather[,2], na.rm = true) marexttmax <- mean(marweather[,3], na.rm = true) + sd(marweather[,3], na.rm = true) marexttmin <- mean(marweather[,4], na.rm = true) - sd(marweather[,4], na.rm = true) aprextprecip <- mean(aprweather[,2], na.rm = true) + sd(aprweather[,2], na.rm = true) aprexttmax <- mean(aprweather[,3], na.rm = true) + sd(aprweather[,3], na.rm = true) aprexttmin <- mean(aprweather[,4], na.rm = true) - sd(aprweather[,4], na.rm = true) mayextprecip <- mean(mayweather[,2], na.rm = true) + sd(mayweather[,2], na.rm = true) mayexttmax <- mean(mayweather[,3], na.rm = true) + sd(mayweather[,3], na.rm = true) mayexttmin <- mean(mayweather[,4], na.rm = true) - sd(mayweather[,4], na.rm = true) junextprecip <- mean(junweather[,2], na.rm = true) + sd(junweather[,2], na.rm = true) junexttmax <- mean(junweather[,3], na.rm = true) + sd(junweather[,3], na.rm = true) junexttmin <- mean(junweather[,4], na.rm = true) - sd(junweather[,4], na.rm = true) julextprecip <- mean(julweather[,2], na.rm = true) + sd(julweather[,2], na.rm = true) julexttmax <- mean(julweather[,3], na.rm = true) + sd(julweather[,3], na.rm = true) julexttmin <- mean(julweather[,4], na.rm = true) - sd(julweather[,4], na.rm = true) augextprecip <- mean(augweather[,2], na.rm = true) + sd(augweather[,2], na.rm = true) augexttmax <- mean(augweather[,3], na.rm = true) + sd(augweather[,3], na.rm = true) augexttmin <- mean(augweather[,4], na.rm = true) - sd(augweather[,4], na.rm = true) sepextprecip <- mean(sepweather[,2], na.rm = true) + sd(sepweather[,2], na.rm = true) sepexttmax <- mean(sepweather[,3], na.rm = true) + sd(sepweather[,3], na.rm = true) sepexttmin <- mean(sepweather[,4], na.rm = true) - sd(sepweather[,4], na.rm = true) octextprecip <- mean(octweather[,2], na.rm = true) + sd(octweather[,2], na.rm = true) octexttmax <- mean(octweather[,3], na.rm = true) + sd(octweather[,3], na.rm = true) octexttmin <- mean(octweather[,4], na.rm = true) - sd(octweather[,4], na.rm = true) novextprecip <- mean(novweather[,2], na.rm = true) + sd(novweather[,2], na.rm = true) novexttmax <- mean(novweather[,3], na.rm = true) + sd(novweather[,3], na.rm = true) novexttmin <- mean(novweather[,4], na.rm = true) - sd(novweather[,4], na.rm = true) decextprecip <- mean(decweather[,2], na.rm = true) + sd(decweather[,2], na.rm = true) decexttmax <- mean(decweather[,3], na.rm = true) + sd(decweather[,3], na.rm = true) decexttmin <- mean(decweather[,4], na.rm = true) - sd(decweather[,4], na.rm = true) #checks whether daily value exceeds daily extreme each month ifelse(siteweather[,5]== 1 & siteweather[,2] >= janextprecip,siteweather[,6] <- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 1 & siteweather[,3] >= janexttmax,siteweather[,7] <- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 1 & siteweather[,4] <= janexttmin,siteweather[,8] <- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 2 & siteweather[,2] >= febextprecip,siteweather[,6] <- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 2 & siteweather[,3] >= febexttmax,siteweather[,7] <- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 2 & siteweather[,4] <= febexttmin,siteweather[,8] <- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 3 & siteweather[,2] >= marextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 3 & siteweather[,3] >= marexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 3 & siteweather[,4] <= marexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 4 & siteweather[,2] >= aprextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 4 & siteweather[,3] >= aprexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 4 & siteweather[,4] <= aprexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 5 & siteweather[,2] >= mayextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 5 & siteweather[,3] >= mayexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 5 & siteweather[,4] <= mayexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 6 & siteweather[,2] >= junextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 6 & siteweather[,3] >= junexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 6 & siteweather[,4] <= junexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 7 & siteweather[,2] >= julextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 7 & siteweather[,3] >= julexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 7 & siteweather[,4] <= julexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 8 & siteweather[,2] >= augextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 8 & siteweather[,3] >= augexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 8 & siteweather[,4] <= augexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 9 & siteweather[,2] >= sepextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 9 & siteweather[,3] >= sepexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 9 & siteweather[,4] <= sepexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 10 & siteweather[,2] >= octextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 10 & siteweather[,3] >= octexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 10 & siteweather[,4] <= octexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 11 & siteweather[,2] >= novextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 11 & siteweather[,3] >= novexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 11 & siteweather[,4] <= novexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) ifelse(siteweather[,5]== 12 & siteweather[,2] >= decextprecip,siteweather[,6]<- 1, siteweather[,6]<- 0) ifelse(siteweather[,5]== 12 & siteweather[,3] >= decexttmax,siteweather[,7]<- 1, siteweather[,7]<- 0) ifelse(siteweather[,5]== 12 & siteweather[,4] <= decexttmin,siteweather[,8]<- 1, siteweather[,8]<- 0) colnames(siteweather)<- c("date", "precip", "tmax", "tmin","month" ,"extprecip", "exttmax", "exttmin" ) siteweather<- siteweather[order(as.date(siteweather[,1])),] write.csv(siteweather, paste("site.", j, ".csv", sep = ""), sep = ",", row.names = false) } print(j) } just trying speed function there lot of site data read.
Comments
Post a Comment