Creates a vector of random dates. On these dates, you should buy someone flowers.

RandomFlowerDay.R

# ==============================================================================
# RandomFlowerDay.R
# Calculates 12 "random" days/year, to buy flowers for your special someone.
# Output is in mm/dd/yy
#
# Dependencies - Uses awk to pre-process system information. Should work on
# andy POSIX compatible system. Requires r-base only.
#
# Includes a set of tests. I'm still learning how to properly build Unit Tests
# in R. In the meantime, these will do the trick nicely.
# ==============================================================================

# ==============================================================================
# -- Functions --
# ==============================================================================

isLeapYear <- function(year) {
  # Helper function for randomFlowerDays()
  # Takes a single year as input and decides if that year is a leap year.
  # Returns either TRUE or FALSE
  # Source - http://en.wikipedia.org/wiki/Leap_year#Algorithm
  if(year %% 400 == 0) {
    return(TRUE)
    break
  }else if(year %% 100 == 0) {
    return(FALSE)
    break
  }else if(year %% 4 == 0){
    return(TRUE)
    break
  }else {return(FALSE)}
} # END - isLeapYear()


RandomFlowerDays <- function(year=NA) {
  # Lovely young ladies should receive flowers at least once a month.
  # This silly function helps you.
  # It accepts the argument "year" but it's not necessary.
  # It returns a vector of 12 dates (1x per month) on which you should buy
  # flowers. It will not return invalid dates such as February 31st.

  # -- Year --
  # Depends on 'date' and 'awk' unless year is designated by the user.
  if(is.na(year)) {
    currentYear <- as.integer(system("date | awk '{print $6}'", intern=TRUE))
  } else { currentYear <- year }

  booLeap <- isLeapYear(currentYear)
  vcYears <- rep.int(currentYear, 12)
  
  # -- Months -- 
  # Creates a vector, to hold the months of the year.
  vcMonths <- 1:12


  # -- Days --
  # Creates a naive vector, length = 12.
  # Each part of the vector is between 1 and 30
  vcDays <- sample(1:31, 12, replace=TRUE)

  # -- Correct Naive Dates --

  # Corrections for February are the most complex.
  if(booLeap == FALSE) {if(vcDays[2]>28){ vcDays[2] <- sample(1:28, 1) } }
  else { vcDays[2] <- sample(1:29, 1) }

  # Corrects for the fact that April has 30 days, not 31.
  if(vcDays[4]>30){ vcDays[4] <- sample(1:30, 1) }

  # Corrects for the fact that June has 30 days, not 31.
  if(vcDays[6]>30){ vcDays[6] <- sample(1:30, 1) }

  # Corrects for the fact that September has 30 days, not 31.
  if(vcDays[9]>30){ vcDays[9] <- sample(1:30, 1) }

  # Corrects for the fact that November has 30 days, not 31.
  if(vcDays[11]>30){ vcDays[11] <- sample(1:30, 1) }  

  # Create the dates dataframe, which will make it easy to print the results.
  stopifnot(length(vcYears)==12, length(vcMonths)==12, length(vcDays)==12)
  dfFlowerDays <- data.frame(vcYears, vcMonths, vcDays)
 
  days <- apply(dfFlowerDays,1,function(x) paste(x[1],"-",x[2],"-",x[3],sep=""))
  days <- as.Date(days)
  return(days)
  
} # END - randomFlowerDays



# ==============================================================================
# -- Tests --
# ==============================================================================

testIsLeapYear <- function(year) {  
  # Our test data sets.
  LeapYears <- c(1600,1604,1608,1612,1616,1620,1624,1628,1632,1636,1640,1644,1648,1652,1656,1660,1664,1668,1672,1676,1680,1684,1688,1692,1696,1704,1708,1712,1716,1720,1724,1728,1732,1736,1740,1744,1748,1752,1756,1760,1764,1768,1772,1776,1780,1784,1788,1792,1796,1804,1808,1812,1816,1820,1824,1828,1832,1836,1840,1844,1848,1852,1856,1860,1864,1868,1872,1876,1880,1884,1888,1892,1896,1904,1908,1912,1916,1920,1924,1928,1932,1936,1940,1944,1948,1952,1956,1960,1964,1968,1972,1976,1980,1984,1988,1992,1996,2000,2004,2008,2012,2016,2020,2024,2028,2032,2036,2040)
  NotLeapYears <- c(1601,1603,1609,1611,1617,1619,1625,1627,1633,1635,1641,1642,1650,1654,1658,1661,1669,1670,1674,1677,1681,1683,1689,1693,1694,1703,1709,1713,1717,1718,1725,1721,1734,1737,1739,1745,1746,1753,1755,1762,1763,1769,1773,1778,1783,1785,1787,1793,1799,1802,1809,1813,1817,1821,1825,1829,1833,1837,1841,1843,1847,1851,1855,1859,1863,1867,1871,1875,1879,1883,1887,1891,1895,1903,1907,1913,1917,1921,1927,1929,1931,1933,1942,1946,1947,1953,1957,1962,1965,1967,1973,1977,1979,1986,1989,1993,1997,2001,2003,2006,2014,2017,2021,2025,2029,2035,2038,2043)

  Test<- sapply(LeapYears, function(x) isLeapYear(x))

  if(length(Test[Test == FALSE])>0){
    print("Errors - LeapYears '1600-2040':")
    print(LeapYears[Test == FALSE])
  } else { print("No Errors in Leap Years tests") }

  

  
  Test<- sapply(NotLeapYears, function(x) isLeapYear(x))

  if(length(Test[Test == TRUE])>0){
    print("Errors - NotLeapYears '1600-2040':")
    print(NotLeapYears[Test == TRUE])
  } else { print("No Errors in Non-Leap Year tests.") }  
} # END - testIsLeapYear()

This is just a quick simple hack that I wrote to get more comfortable with R's date structures and string manipulation.