mardi 6 décembre 2016

ifelse with multiple comands - R

if statements allow multiple statements to be executed when only when the test expression is not a vector:

 if (test_expression) {
       statement1
       statement2
       statement3
    }

ifelse statements allow one statement to be executed when the test expression is a vector:

ifelse(test_expression, statement1, statement2)

However, what if you need to run an if statement on a vector, and if that is true, then you conditionally run a whole section of code?

Example Data:

datetime <- c("12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 8:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/201610:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 10:00","12/6/2016 12:00","12/6/2016 12:00","12/6/201612:00","12/6/2016 12:00","12/6/2016 12:00","12/6/2016 12:00","12/6/2016 12:00","12/6/2016 12:00","12/6/2016 12:00","12/6/2016 12:00","12/6/2016 12:00","12/6/201612:00","12/6/2016 12:00","12/6/2016 12:00","12/6/2016 12:00")

radar_based_wat_lev_fasl <- c(268.3698,268.3698,268.3698,268.3698,268.3698,268.3698,268.3698,268.3698,268.3698,268.3698,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3633,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534,268.3534)

a <- c(8.96,8.95,8.95,8.95,8.95,8.96,8.95,8.95,8.95,8.94,8.93,8.93,8.93,8.93,8.94,8.94,8.94,8.94,8.94,8.94,8.94,8.94,8.95,8.95,8.95,8.93,8.93,8.93,8.93,8.93,8.93,8.93,8.94,8.94,8.94,8.94,8.93,8.94,8.94,8.94)

b <- c(10.31,10.32,10.33,10.34,10.36,10.37,10.38,10.4,10.41,10.41,10.28,10.29,10.29,10.31,10.31,10.32,10.32,10.34,10.35,10.36,10.37,10.37,10.39,10.42,10.42,10.27,10.28,10.29,10.3,10.31,10.32,10.32,10.32,10.33,10.34,10.35,10.36,10.37,10.4,10.4)

c <- c(2.41,1.68,2.29,2.09,3.47,2.28,2.56,2.52,2.27,1.74,2.03,2.14,2.77,2.34,1.78,2.53,2.68,2.27,1.83,1.69,1.83,2.3,2.07,1.91,2.16,3.11,2.38,2.63,2.47,2,2.35,2.11,2.03,3.2,2.17,2.58,2.64,2.23,2.12,2.17)

elev <- c(239.5312,242.8121,246.257,249.5378,252.6874,255.7714,259.2819,262.3331,265.8436,266.8278,222.6283,226.3685,229.7806,232.9302,236.211,239.5247,242.8055,245.9223,249.3344,252.7465,256.0601,259.1441,262.5234,265.9026,266.7885,222.6513,226.3915,229.8692,232.9531,236.2012,239.6133,242.8613,246.2406,249.4558,252.7694,256.0175,259.3639,262.6448,265.86,266.8442)

mydf <- data.frame(datetime,radar_based_wat_lev_fasl,a,b,c,elev)

mydf$datetime <- strptime(mydf$datetime, format = "%m/%d/%Y %H:%M")

current.time <- "2016-12-06 12:00:00"

current.time <- paste(format(current.time, format = "%Y-%m-%d %H"), ":00:00", sep = "")

current.date <- "2016-12-06" 

mydf2 <- subset(mydf, datetime == current.time)
mydf2 <- mydf2[order(-mydf2$elev),]

Example if statement:

if(mydf2$c > 2){
filename<- paste("//C:/Alert_Profile_",current.date, ".pdf", sep="")
  pdf(filename, width=7, height=12)

  title.nm <- paste("Reservoir", unique(current.time), sep=" ")
  layout(matrix(c(1,2,3,4), ncol=1, byrow=TRUE), heights=c(4,4,4,1))
  par(mar=c(5,5, 1, 1) + 0.1, 
      oma = c(0,0,2,0) + 0.1)
  plot(0,type="n", ylim = c(216,285), xlim= c(0,16),ylab="Elevation (ft ASL)", xlab=expression('B (mg L'^-1*')'))
  upper.x <- c(0,16,16,0)
  upper.y <- c(271,271,279,279)
  middle.x <- c(0,16,16,0)
  middle.y <- c(242,242,250,250)
  bottom.x <- c(0,16,16,0)
  bottom.y <- c(214,214,222,222)
  polygon(upper.x,upper.y, col=adjustcolor("gray", alpha=0.25))
  polygon(middle.x,middle.y, col=adjustcolor("gray", alpha=0.25))
  polygon(bottom.x,bottom.y, col=adjustcolor("gray", alpha=0.25))
  lines(mydf2$b, mydf2$elev, xaxt='n', yaxt='n', ylim = c(216,285), xlim= c(0,16), col="mediumpurple1")
  points(mydf2$b, mydf2$elev, xaxt='n', yaxt='n', ylim = c(216,285), xlim= c(0,16), pch=21, col="black", bg= "mediumpurple1")
  abline(h=c(218.2),lty=2, lwd = 3, col = "black")
  abline(h=c(mean(mydf2$radar_based_wat_lev_fasl)),lty=1, lwd = 3, col = "blue")
  rect(xleft=0, ybottom=279.5, xright=3, ytop=287, col=adjustcolor("white", alpha=0.75), border="NA")
  text(1.5,283.25,labels="Top Gate")
  rect(xleft=0, ybottom=250.5, xright=4, ytop=258, col=adjustcolor("white", alpha=0.75), border="NA")
  text(2,254.25,labels="Middle Gate") 
  rect(xleft=0, ybottom=222.5, xright=4, ytop=230, col=adjustcolor("white", alpha=0.75), border="NA")
  text(2,226.25,labels="Bottom Gate")  

  plot(0,type="n", ylim = c(216,285), xlim= c(0,35),ylab="Elevation (ft ASL)", xlab=expression('A ('*degree*'C)'))
  upper.x <- c(0,35,35,0)
  upper.y <- c(271,271,279,279)
  middle.x <- c(0,35,35,0)
  middle.y <- c(242,242,250,250)
  bottom.x <- c(0,35,35,0)
  bottom.y <- c(214,214,222,222)
  polygon(upper.x,upper.y, col=adjustcolor("gray", alpha=0.25))
  polygon(middle.x,middle.y, col=adjustcolor("gray", alpha=0.25))
  polygon(bottom.x,bottom.y, col=adjustcolor("gray", alpha=0.25))
  lines(mydf2$a, mydf2$elev, xaxt='n', yaxt='n', ylim = c(216,285), xlim= c(0,35), col="mediumpurple1")
  points(mydf2$a, mydf2$elev, xaxt='n', yaxt='n', ylim = c(216,285), xlim= c(0,35), pch=21, col="black", bg= "mediumpurple1")
  abline(h=c(218.2),lty=2, lwd = 3, col = "black")
  abline(h=c(mean(mydf2$radar_based_wat_lev_fasl)),lty=1, lwd = 3, col = "blue")     
  rect(xleft=0, ybottom=279.5, xright=7, ytop=287, col=adjustcolor("white", alpha=0.75), border="NA")
  text(3.5,283.25,labels="Top Gate")
  rect(xleft=0, ybottom=250.5, xright=9.333334, ytop=258, col=adjustcolor("white", alpha=0.75), border="NA")
  text(4.666665,254.25,labels="Middle Gate") 
  rect(xleft=0, ybottom=222.5, xright=9.333334, ytop=230, col=adjustcolor("white", alpha=0.75), border="NA")
  text(4.666665,226.25,labels="Bottom Gate")    


  plot(0,type="n", ylim = c(216,285), xlim= c(0,15),ylab="Elevation (ft ASL)", xlab=expression('C (ug L)'))
  upper.x <- c(0,15,15,0)
  upper.y <- c(271,271,279,279)
  middle.x <- c(0,15,15,0)
  middle.y <- c(242,242,250,250)
  bottom.x <- c(0,15,15,0)
  bottom.y <- c(214,214,222,222)
  polygon(upper.x,upper.y, col=adjustcolor("gray", alpha=0.25))
  polygon(middle.x,middle.y, col=adjustcolor("gray", alpha=0.25))
  polygon(bottom.x,bottom.y, col=adjustcolor("gray", alpha=0.25))
  lines(mydf2$c, mydf2$elev, xaxt='n', yaxt='n', ylim = c(216,285), xlim= c(0,15), col="mediumpurple1")
  points(mydf2$c, mydf2$elev, xaxt='n', yaxt='n', ylim = c(216,285), xlim= c(0,15), pch=21, col="black", bg= "mediumpurple1")
  abline(h=c(218.2),lty=2, lwd = 3, col = "black")
  abline(h=c(mean(df$radar_based_wat_lev_fasl)),lty=1, lwd = 3, col = "blue")
  rect(xleft=0, ybottom=279.5, xright=3, ytop=287, col=adjustcolor("white", alpha=0.75), border="NA")
  text(1.5,283.25,labels="Top Gate")
  rect(xleft=0, ybottom=250.5, xright=4, ytop=258, col=adjustcolor("white", alpha=0.75), border="NA")
  text(2,254.25,labels="Middle Gate") 
  rect(xleft=0, ybottom=222.5, xright=4, ytop=230, col=adjustcolor("white", alpha=0.75), border="NA")
  text(2,226.25,labels="Bottom Gate")   

 par(mai=c(0,0,0,0))
  plot.new()
  legend(x="center", legend=c("Mean Water Level","Reservoir Bottom"), pch = c(NA,NA), lty = c(1,2), ncol=2,col=c("blue","black"),pt.bg=c(NA,NA),lwd = c(2,2),bg=adjustcolor("white", alpha=0.55))    
  mtext(title.nm, outer = TRUE, cex = 1.5)
  dev.off()

  setwd("//C:Alert_Plots")
  from <- "POTUS@gmail.com"
  to <- c("POTUS@gmail.com")
  subject <- "Reservoir Advisory"
  body <- "Dear Team, C has exceeded 2."                     
  mailControl=list(smtpServer="outlook.companyx.ad.root")

  #needs full path if not in working directory
  attachmentPath <- paste("Reservoir/Alert_Profile_", current.date, ".pdf", sep="")

  #same as attachmentPath if using working directory
  attachmentName <- paste("Alert_Profile_",current.date, ".pdf", sep="")

  filename<- paste("//C:Alert_Plots/Reservoir/Alert_Profile_",current.date, ".pdf", sep="")



  msg <- mime_part('<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0
Strict//EN" "http://ift.tt/mOIMeg">
                 <html xmlns="http://ift.tt/lH0Osb">
                 <head>
                 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
                 <meta name="viewport" content="width=device-width, initial-scale=1.0"/>
                 <title>***This is an automated message***</title>
                 <style type="text/css">
                 </style>
                 </head>
                 <body>
                 <h4>***This is an automated message***</h4>
                 <p style="font-family:calibri;">Dear Team,</p>
                 <p style="font-family:calibri;">C has exceeded 2.</p>  
                 <p style="font-family:calibri;">Thank you,</p> 
                 <p style="font-family:calibri;">Squishy</p> 
                 </body>
                 </html>')

  ## Override content type.
  msg[["headers"]][["Content-Type"]] <- "text/html"


  #key part for attachments, put the body and the mime_part in a list for msg
  attachmentObject <- mime_part(x=attachmentPath,name=attachmentName)
  bodyWithAttachment <- list(msg,attachmentObject)

  sendmail(from=from,to=to,subject=subject,msg=bodyWithAttachment,control=mailControl)

  }

Aucun commentaire:

Enregistrer un commentaire