(no subject)

[outlier_lynn]

Well. I have finally generalized the calendar routine sufficiently to satisfy myself. :) Although, I do want to add the "fifth week" stuff.


# Given a day (Mon, Tue, etc) and a Month (Jan, Feb)
# and year (2004), return the x week date of that day
# for the indicated month if now is true or following
# month is now is false. Good for first 4 weeks only --
# no fifth weeks allowed.
proc get_x_day {instance day mon yr {now {true}}} {
if {$now} {
set when [clock scan $day -base [clock scan "1 $mon $yr month ago"]]
} else {
set when [clock scan $day -base [clock scan "1 $mon $yr"]]
}
regexp -- {([0-9]+)[ ]+([0-9]+)} [clock format $when -format "%m %e"] trash month date
set days [get_month_length [string trimleft $month 0]]
set til_end [expr $days - $date]
set next_date [expr { (7 * $instance) - ($til_end % 7) }]
set add [expr $next_date + $til_end]
return [clock scan "$add days" -base $when]
}


Comments welcome. I'd love to have this be more simple. The only command that isn't a standard tcl command is "get_month_length." It grabs the number of days in the month passed as an argument. the %e is not portable. It is the day of the month with leading zero's stripped. %d would be portable, but I'd have to strip leading zeros by hand. As I don't expect to run this anywhere but Linux, I'll leave it.

Comments

I don't think that way!

[http://users.livejournal.com/_greg/]

Your code does something very difficult in a compact way You've really been getting into this problem and I salute your ability to create this procedure. I would be inclined to break it down quite a bit. As a first stab, I came up with:

# Note: An ISO standard date string is YEAR-MONTH-DAY
# rather than American MONTH/DAY/YEAR or European DAY.MONTH.YEAR

# Given: month in 1-12, year in full 4-digits
# Returns: weekday which starts that month as 0-6
proc weekday_starting_month {month year} {
  clock format [clock scan "$year-$month-1"] -format {%w}
}

# given: weekday in 0-6, month in 1-12, year in full 4-digits
# returns: day of month (1-7) containing first $weekday
proc first_given_weekday_of_month {weekday month year} {
  set starting_day [weekday_starting_month $month $year]
  set day_offset [expr {$weekday - $starting_day}]
  expr {$day_offset + ($day_offset < 0 ? 8 : 1)}
}

# given: n in 1-5, weekday in 0-6, month in 1-12, year in full 4-digits
# returns: day of month (1-31) containing n'th $weekday if exists, 0 otherwise
proc nth_given_weekday_of_month {n weekday month year} {
  set first_day [first_given_weekday_of_month $weekday $month $year]
  set nth [expr {$n - 1}]; # nth is now 0-4
  set time [clock scan "$year-$month-$first_day $nth week"]
  foreach {day month2} [clock format $time -format "%e %m"] {}; # multiple assignment
  set month2 [string trimleft $month2 {0}]; # trim off any leading zeros
  expr {$month2 == $month ? $day : 0}
}

I dislike the fact that I'm doing three clock scans, and yet I'm finding the code easier to follow than the more optimized version I'm imagining. Therefore, unless I started to get a speed problem, I'd try to let it alone (although my hands are still twitching.

A path I gave up on. :)

[crazed-lynn.livejournal.com]

I started down this path then gave up. I liked the idea that I could get the 5ths this way. I was standing at a different starting point, though, and I didn't see how to get to this solution from where I was. :)

Is "foreach {day month2} [clock format $time -format "%e %m"] {}" more efficient than "regexp -- {([0-9]+)[ ]+([0-9]+)} [clock format $when -format "%m %e"] trash month date"? And it somehow looks like cheating to me. :)

Love.

And another thing

[crazed-lynn.livejournal.com]

I was trying to make best use of the builtin clock math that tcl has. Letting it determine when months and years needed to roll over.

This all started because I was looking for the second Friday of the month I was in IF I hadn't already passed it or the second Friday of the following month. It was a lot cleaning to let clock deal with getting the months/years correct.

I generalized from that starting point. And it took awhile. :)