1pstamp <- if(.R.) function(txt, pwd=FALSE, time.=TRUE) 2{ 3 stamp <- function(string = Sys.time(), print = TRUE, plot = TRUE) 4 { 5 opar <- par(yaxt='s',xaxt='s',xpd=NA) 6 on.exit(par(opar)) 7 plt <- par('plt') 8 usr <- par('usr') 9 10 ## when a logrithmic scale is in use (i.e. par('xlog') is true), 11 ## then the x-limits would be 10^par('usr')[1:2]. Similarly for 12 ## the y axis 13 xcoord <- usr[2] + (usr[2] - usr[1])/(plt[2] - plt[1]) * 14 (1-plt[2]) - .6*strwidth('m') 15 ycoord <- usr[3] - diff(usr[3:4])/diff(plt[3:4])*(plt[3]) + 16 0.6*strheight('m') 17 18 if(par('xlog')) 19 xcoord <- 10^(xcoord) 20 if(par('ylog')) 21 ycoord <- 10^(ycoord) 22 23 ## Print the text on the current plot 24 text(xcoord, ycoord, string, adj=1) 25 invisible(string) 26 } 27 28 date.txt <- if(time.) format(Sys.time()) 29 else format(Sys.time(), '%Y-%m-%d') 30 31 if(pwd) 32 date.txt <- paste(getwd(), date.txt) 33 34 oldpar <- par(mfrow=c(1,1), cex = 0.5) 35 on.exit(par(oldpar)) 36 if(!missing(txt)) 37 date.txt <- paste(txt,' ',date.txt, sep='') 38 39 stamp(string=date.txt,print=FALSE,plot=TRUE) 40 invisible() 41 42} else function(txt, pwd=FALSE, time.=under.unix) 43{ 44 45 date.txt <- if(time.) date() else { 46 if(.SV4.) 47 format(timeDate(date(), in.format='%w %m %d %H:%M:%S %Z %Y', 48 format='%Y-%m-%d')) 49 else if(under.unix) 50 unix('date +%Y-%m-%d') 51 else 52 stop('time.=T not supported') 53 } 54 55 if(pwd) 56 date.txt <- paste(getwd(), date.txt) 57 58 oldpar <- par(mfrow = c(1,1), cex = 0.5) 59 on.exit(par(oldpar)) 60 if(!missing(txt)) 61 date.txt <- paste(txt,' ',date.txt, sep='') 62 63 stamp(string=date.txt,print=FALSE,plot=TRUE) 64 par(old) 65 invisible() 66} 67