Little useless-useful R functions – Useless analog and digital clocks

[This article was first published on R – TomazTsql, 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.

It is all about measuring time using useless clocks. Script takes a system time and displays any given clock in a rather “static” way. You can choose between analog, small digital and big digital clock. And when playing with the time, you can also learn something new.

Analog Clock

Using the following code, you can create a nice analog clock, with three hands (for hour, minute and second) with optional colour background. If you want to use some sounds with the clock, install package beepr and uncomment the beepr() function in analogClock() function. You will be annoyed ?

require(grid)
#install.packages("beepr")


DrawClock <- function(hour, minute, second) {
  
  t <- seq(0, 2*pi, length=13)[-13]
  x <- cos(t)
  y <- sin(t)

  
  grid.newpage()
  pushViewport(dataViewport(x, y, gp=gpar(lwd=3)))
  
  # Clock background
  grid.circle(x=0, y=0, default="native", r=unit(1, "native"))

  # Hour hand
  hourAngle <- pi/2 - (hour + minute/60)/12*2*pi
  grid.segments(0, 0, 0.6*cos(hourAngle), .6*sin(hourAngle), default="native", gp=gpar(lex=4, col="red"))
  
  # Minute hand
  minuteAngle <- pi/2 - (minute)/60*2*pi
  grid.segments(0, 0, 0.8*cos(minuteAngle), .8*sin(minuteAngle),default="native", gp=gpar(lex=2))    

  # Second hand
  secondAngle <- pi/2 - (second)/60*2*pi
  grid.segments(0, 0, 
          0.8*cos(secondAngle), .7*sin(secondAngle), default="native", gp=gpar(lex=1, col = "blue"), draw=TRUE)    
  grid.circle(0,0, default="native", r=unit(1, "mm"), gp=gpar(fill="white"))
}


AnalogClock <- function() {
    while(TRUE){
    hh <- as.integer(format(Sys.time(), format="%H"))
    mm <- as.integer(format(Sys.time(), format="%M"))
    ss <- as.integer(format(Sys.time(), format="%S"))
    Sys.sleep(1)
    DrawClock(hh,mm,ss)
    beepr::beep(sound = 1, expr = NULL)
    }
}

#Run Function / clock
AnalogClock()

Resulting in the following clock:

Small Digital Clock

Well this one is pretty boring:

SmallDigitalClock <- function() {
  cat("\014")
  while(TRUE){
    Sys.sleep(0.1)
   cat("\r", strftime(Sys.time(), format="%H:%M:%S"))
  }
}

SmallDigitalClock()

Giving you a tiny clock in console, you ought to put your glasses on to read this:

Big digital clock

Now, this one is a major upgrade – in font size, to be precisely. ? Now I can finally see clearly ?

And of course, the code for this rather big digital clock:


# Create Numbers
n0 <-
  c("██████"
    ,"██  ██"
    ,"██  ██"
    ,"██  ██"
    ,"██████")

n1 <-
  c("    ██"
    ,"    ██"
    ,"    ██"
    ,"    ██"
    ,"    ██")

n2 <-
  c("██████"
    ,"    ██"
    ,"██████"
    ,"██    "
    ,"██████")

n3 <-
  c("██████"
    ,"    ██"
    ,"██████"
    ,"    ██"
    ,"██████")

n4 <-
  c("██  ██"
    ,"██  ██"
    ,"██████"
    ,"    ██"
    ,"    ██")

n5 <-
  c("██████"
    ,"██    "
    ,"██████"
    ,"    ██"
    ,"██████")

n6 <-
  c("██████"
    ,"██    "
    ,"██████"
    ,"██  ██"
    ,"██████")

n7 <-
  c("██████"
    ,"    ██"
    ,"    ██"
    ,"    ██"
    ,"    ██")

n8 <-
  c("██████"
    ,"██  ██"
    ,"██████"
    ,"██  ██"
    ,"██████")

n9 <-
  c("██████"
    ,"██  ██"
    ,"██████"
    ,"    ██"
    ,"██████")

colon <-
  c("      "
    ,"  ██  "
    ,"      "
    ,"  ██  "
    ,"      ")

df0 <- as.data.frame(n0)
df1 <- as.data.frame(n1)
df2 <- as.data.frame(n2)
df3 <- as.data.frame(n3)
df4 <- as.data.frame(n4)
df5 <- as.data.frame(n5)
df6 <- as.data.frame(n6)
df7 <- as.data.frame(n7)
df8 <- as.data.frame(n8)
df9 <- as.data.frame(n9)
dfc <- as.data.frame(colon)

numbers <- cbind(df0, df1,df2,df3,df4,df5,df6,df7,df8,df9, dfc)
rm(df0, df1,df2,df3,df4,df5,df6,df7,df8,df9, dfc,n0,n1,n2,n3,n4,n5,n6,n7,n8,n9, colon)

# Get number / variable from data frame
getVariable <- function(x) {
  stopifnot(is.numeric(x))
  if (x == 0) {return (numbers$n0)}
  if (x == 1) {return (numbers$n1)}
  if (x == 2) {return (numbers$n2)}
  if (x == 3) {return (numbers$n3)}
  if (x == 4) {return (numbers$n4)}
  if (x == 5) {return (numbers$n5)}
  if (x == 6) {return (numbers$n6)}
  if (x == 7) {return (numbers$n7)}
  if (x == 8) {return (numbers$n8)}
  if (x == 9) {return (numbers$n9)}
}


BigDitigalClock <- function() {
  
  while(TRUE){
    Sys.sleep(1)
    cat("\014")
    
    #hour
    h1 <- substr(strftime(Sys.time(), format="%H"),1,1)
    h2 <- substr(strftime(Sys.time(), format="%H"),2,2)
    
    #minute
    m1 <- substr(strftime(Sys.time(), format="%M"),1,1)
    m2 <- substr(strftime(Sys.time(), format="%M"),2,2)
    
    #second
    s1 <- substr(strftime(Sys.time(), format="%S"),1,1)
    s2 <- substr(strftime(Sys.time(), format="%S"),2,2)
    
    dfh1 <- as.data.frame(getVariable(as.integer(h1)))
    dfh2 <- as.data.frame(getVariable(as.integer(h2)))
    dfm1 <- as.data.frame(getVariable(as.integer(m1)))
    dfm2 <- as.data.frame(getVariable(as.integer(m2)))
    dfs1 <- as.data.frame(getVariable(as.integer(s1)))
    dfs2 <- as.data.frame(getVariable(as.integer(s2)))
    
    current_time <- cbind(dfh1, dfh2, numbers$colon, 
                          dfm1, dfm2 , numbers$colon,
                          dfs1, dfs2)
    
    #Remove column namens and row names
    colnames(current_time) <- c(" "," "," "," "," "," "," "," ")
    print.data.frame(current_time,  row.names = F)
  }
}

# Run the clock
BigDitigalClock()

For better formatting, please use the Github repository and get all the code samples there. Go to Useless R function repository on URL: https://github.com/tomaztk/Useless_R_functions and all three functions (for all the clocks) are available in separate files.

Enjoy your time and most importantly, stay on time ?

As always, code is available in at the Github in same Useless_R_function repository.

Happy R-coding!

To leave a comment for the author, please follow the link and comment on their blog: R – TomazTsql.

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)