require("Rook") library("lubridate") setwd("C:/Blag/R_Scripts")
Blag_Fitness = read.csv(file="Blag_Fitness.csv",header=TRUE) Blag_Fitness$Date<-strptime(Blag_Fitness$Date,"%d/%m/%Y") Rows<-nrow(Blag_Fitness) Rows Default_Day<-day(Blag_Fitness$Date[1]) Default_Month<-month(Blag_Fitness$Date[1]) Default_Last_Day<-day(Blag_Fitness$Date[Rows]) Default_Last_Day Default_Last_Month<-month(Blag_Fitness$Date[Rows])
fill_zeros<-function(param,mode=0){ count<-nchar(param) zeros<-rep(0,1) if(mode==0){ if(count==1){ r_param<-c(zeros,param) }else{ r_param<-c(param) } }else{ if(count==7){ r_param<-c(zeros,param) }else{ r_param<-c(param) } } r_param<-paste(r_param,collapse="") return(r_param) }
newapp<-function(env){ req<-Rook::Request$new(env) res<-Rook::Response$new() res$write('<form method="POST">\n') res$write('<div align="center"><table><tr>') res$write('<td><select name=DAYFROM>') for(i in 1:31) { if(i==Default_Day){ res$write(sprintf('<OPTION VALUE=%s SELECTED=%s>%s</OPTION>', i,Default_Day,i)) }else{ res$write(sprintf('<OPTION VALUE=%s>%s</OPTION>',i,i)) } } res$write('</select></td><td>') res$write('<select name=MONTHFROM>') for(i in 1:12) { if(i==Default_Month){ res$write(sprintf('<OPTION VALUE=%s SELECTED=%s>%s</OPTION>', i,Default_Month,i)) }else{ res$write(sprintf('<OPTION VALUE=%s>%s</OPTION>',i,i)) } } res$write('</select></td>') res$write('</select></td><td>') res$write('<select name=YEARFROM>') for(i in 2012:2020) { res$write(sprintf('<OPTION VALUE=%s>%s</OPTION>',i,i)) } res$write('</select></td>') res$write('<td>To</td>')
res$write('<td><select name=DAYTO>') for(i in 1:31) { if(i==Default_Last_Day){ res$write(sprintf('<OPTION VALUE=%s SELECTED=%s>%s</OPTION>', i,Default_Last_Day,i)) }else{ res$write(sprintf('<OPTION VALUE=%s>%s</OPTION>',i,i)) } } res$write('</select></td><td>') res$write('<select name=MONTHTO>') for(i in 1:12) { if(i==Default_Last_Month){ res$write(sprintf('<OPTION VALUE=%s SELECTED=%s>%s</OPTION>', i,Default_Last_Month,i)) }else{ res$write(sprintf('<OPTION VALUE=%s>%s</OPTION>',i,i)) } } res$write('</select></td>') res$write('</select></td><td>') res$write('<select name=YEARTO>') for(i in 2012:2020) { res$write(sprintf('<OPTION VALUE=%s>%s</OPTION>',i,i)) } res$write('</select></td>') res$write('<td><input type="submit" value="Get Stats"></td>') res$write('</tr></table></div>') res$write('</form>') if (!is.null(req$POST())) { p_dayfrom = req$POST()[["DAYFROM"]] p_monthfrom = req$POST()[["MONTHFROM"]] p_yearfrom = req$POST()[["YEARFROM"]] p_dayto = req$POST()[["DAYTO"]] p_monthto = req$POST()[["MONTHTO"]] p_yearto = req$POST()[["YEARTO"]] p_dayfrom<-fill_zeros(p_dayfrom) p_monthfrom<-fill_zeros(p_monthfrom) date_from<-c(p_dayfrom,'/',p_monthfrom,'/',p_yearfrom) date_from<-paste(date_from,collapse="") date_from_n<-strptime(date_from,"%d/%m/%Y") date_from_n<-as.numeric(format(date_from_n,"%d%m%Y")) p_dayto<-fill_zeros(p_dayto) p_monthto<-fill_zeros(p_monthto) date_to<-c(p_dayto,'/',p_monthto,'/',p_yearto) date_to<-paste(date_to,collapse="") date_to_n<-strptime(date_to,"%d/%m/%Y") date_to_n<-as.numeric(format(date_to_n,"%d%m%Y")) Blag_Fitness$Date<-as.numeric(format(Blag_Fitness$Date,"%d%m%Y")) Selected_Data<-subset(Blag_Fitness, Date >= date_from_n & Date <= date_to_n) Selected_Data$Date<-as.character(Selected_Data$Date) fixer<-fill_zeros Selected_Data$Date<-sapply(Selected_Data$Date,fixer,mode=1) Selected_Data$Date<-strptime(Selected_Data$Date,"%d%m%Y")
res$write(sprintf('<div align="center"><h3>From %s to %s</h3></div>', date_from,date_to)) png("Blag_Fitness.png",width=800,height=500) plot(Selected_Data,type="n") lines(Selected_Data,col="blue",ann=FALSE) points(Selected_Data, pch=21, bg="lightcyan", cex=1.25) dev.off() res$write("<div align='center'>") res$write(paste("<img src='", server$full_url("pic"), "/", "Blag_Fitness.png'", "/>", sep = "")) res$write("</div>") }else{ res$write("<p>No data to select...</p>") } res$finish() }
server = Rhttpd$new() server$add(app = newapp, name = "Blag_Fitness") server$add(app = File$new("C:/Blag/R_Scripts"), name = "pic") server$start() server$browse("Blag_Fitness")
|