Keeping track of my calories the R way

[This article was first published on Blag's bag of rants, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

So…I’m back with Your Shape: Fitness Evolved 2012 for XBox Kinect. Why? Because I want to loose some weight and get back in shape of course -;)

The reason I stop playing the game is simple…I’m lazy…but this time, I have come back with a goal…burn calories!

While I’m using the Your Shape IPhone Application which is really good…I wanted to do something with R and more precisely with Rook

What I wanted, was a way to keep track of the days and calories burned and generate a nice graphic, but allowing me to choose a range of dates…

This is the code I came up with yesterday night…

Blag_Fitness.R
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")

When we executed, the application is going to read the first and the last line of our .CSV file and set the default values for the comboboxes…making it easy to select the date range…

Here comes the screenshot -;)


So…you can see that I’m making big progress…I started 3 days ago and burning more calories each day…

Greetings,

Blag.

To leave a comment for the author, please follow the link and comment on their blog: Blag's bag of rants.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)