Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Care to simplify some working code?

by Voronich (Hermit)
on Sep 28, 2011 at 18:30 UTC ( #928384=perlquestion: print w/ replies, xml ) Need Help??
Voronich has asked for the wisdom of the Perl Monks concerning the following question:

(note: I've put my cleaned up verion of this code in a reply below.)

Well, tye went and did it once again, convinced me (with nary a nudge) to post something. So here goes. I have here some working code written casually. But it's ugly as homemade sin and while I am actually refactoring it for simplification, I'd be interested to see how other monks take a hack at it.

Background: For any given date I need to derive the following:

The last "business date" from the previous calendar quarter. Business date is "Monday through Friday" (i.e. if last date of the quarter is a Sunday, pull two days off and report the Friday.)

A couple notes:

  • These tests pass and the code works
  • Holidays are irrelevant.
  • Timezones are also irrelevant.
  • The resulting code is stupid
  • This runs at most once every few weeks.
  • NO CPAN. If it didn't ship with perl 5.6, it's out.(*sigh* yes really :-/)

So I set about TDD'ing the function "get_last_bus_day_of_prev_quarter" (worst name ever. Also taking suggestions to replace that) and it's dependencies in a separate script and all the expected stuff happened. As I encountered complexity that warranted a new testable function I added the tests for that function to the top of the list. I found stupid errors and fixed them. I came up with "really clever" solutions and... avoided them as I couldn't identify them after a bio-break so I went out of my way to not do anything overly clever. I found that I was biasing towards making the test lines themselves easy to read.

Then I was done. It worked. All my tests passed happy nice nice, and I plugged it in to the main code body.

But I was remarkably unsatisfied. It's...well, look at it. It's awful. It's actually the same size as the rest of the script it supports. Micromanaging the testing the way I did produced "small functional units" the way it's supposed to. But in producing "clean interfaces" (i.e. single string representations of dates and their kin) I ended up reproducing the extraction/concatenation logic all over the place.

What this REALLY means of course is that the task isn't done. I was kvetching about this and how I'm now going through and replacing those composite strings with their component parts (and how I should have caught that up front) when tye suggested I post it, looking to see how other people tackle the simplification problem.

So here ya go. This is the whole script, tests and all (for that one function.) How would you simplify this? (I do already have some stuff in the works.)

#!/usr/bin/perl -w use strict; use warnings; use Time::Local; use Test::More "no_plan"; test(); sub test { ok ( identify_quarter("201101") eq "2011Q1"); ok ( identify_quarter("201102") eq "2011Q1"); ok ( identify_quarter("201103") eq "2011Q1"); ok ( identify_quarter("201104") eq "2011Q2"); ok ( identify_quarter("201105") eq "2011Q2"); ok ( identify_quarter("201106") eq "2011Q2"); ok ( identify_quarter("201107") eq "2011Q3"); ok ( identify_quarter("201108") eq "2011Q3"); ok ( identify_quarter("201109") eq "2011Q3"); ok ( identify_quarter("201110") eq "2011Q4"); ok ( identify_quarter("201111") eq "2011Q4"); ok ( identify_quarter("201112") eq "2011Q4"); ok ( identify_quarter("201201") eq "2012Q1"); ok ( get_previous_quarter("2011Q4") eq "2011Q3"); ok ( get_previous_quarter("2011Q3") eq "2011Q2"); ok ( get_previous_quarter("2012Q1") eq "2011Q4"); ok ( last_month_of_quarter(1) == 3); ok ( last_month_of_quarter(2) == 6); ok ( last_month_of_quarter(3) == 9); ok ( last_month_of_quarter(4) == 12); ok ( get_next_month("201101") eq "201102"); ok ( get_next_month("201112") eq "201201"); ok ( last_day_of_month("201101") == 31); ok ( last_day_of_month("201202") == 29); ok ( get_last_month_of_quarter("2011Q1") eq "201103"); ok ( get_last_month_of_quarter("2011Q2") eq "201106"); ok ( get_last_month_of_quarter("2011Q3") eq "201109"); ok ( get_last_month_of_quarter("2011Q4") eq "201112"); ok ( get_last_month_of_quarter("2012Q1") eq "201203"); ok ( get_last_day_of_prev_quarter("20110101") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110203") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110310") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110331") eq "20101231"); ok ( get_last_day_of_prev_quarter("20110415") eq "20110331"); ok ( get_last_day_of_prev_quarter("20110516") eq "20110331"); ok ( get_last_day_of_prev_quarter("20110629") eq "20110331"); ok ( get_last_day_of_prev_quarter("20110731") eq "20110630"); ok ( get_last_day_of_prev_quarter("20110805") eq "20110630"); ok ( get_last_day_of_prev_quarter("20110930") eq "20110630"); ok ( get_last_day_of_prev_quarter("20111030") eq "20110930"); ok ( get_last_day_of_prev_quarter("20111130") eq "20110930"); ok ( get_last_day_of_prev_quarter("20111231") eq "20110930"); ok ( get_last_bus_day_of_prev_quarter("20110901") eq "20110630"); ok ( get_last_bus_day_of_prev_quarter("20120101") eq "20111230"); } sub get_last_day_of_prev_quarter { my ($date) = @_; my $this_quarter = identify_quarter($date); my $quarter = get_previous_quarter($this_quarter); my $last_month_of_quarter = get_last_month_of_quarter($quarter); my $ldom = last_day_of_month($last_month_of_quart +er); return $last_month_of_quarter . $ldom; } sub get_last_bus_day_of_prev_quarter { my ($date) = @_; my $new_date = get_last_day_of_prev_quarter($date); my $year = substr($new_date,0,4); my $month = substr($new_date,4,2); my $day = substr($new_date,6,2); my $epoch = timelocal(0,0,12, $day, $month-1, $year-1900); my @timestuff = localtime($epoch); # # If the day is a Sunday (0) or a Saturday (6) # # Subtract 1 or 2 days from the day. my $date_diff = 0; if ($timestuff[6] == 0) { $date_diff = 2; } if ($timestuff[6] == 6) { $date_diff = 1; } if ($date_diff > 0) { $epoch = $epoch - (60*60*24) * $date_diff; } @timestuff = localtime($epoch); # # Rebuild the YYYYMMDD string from the localtime bits. # return $timestuff[5] + 1900 . sprintf( "%02d",$timestuff[4] + 1) +. "$timestuff[3]"; } sub get_last_month_of_quarter { my ($yyyymm) = @_; return substr($yyyymm,0,4) . sprintf("%02d",last_month_of_quarter( +substr($yyyymm,5,1))); } sub last_month_of_quarter { my ($quarter) = @_; return $quarter * 3; } sub last_day_of_month { # This logic is moronic, but it works. # To get the last day of a given month, first take the first day # of the first month, convert it to epoch seconds, subtract a day # (86400 seconds), then re-convert back and pull the "day of month +" # element out of the list. my ($yyyymm) = @_; my $next_day = get_next_month($yyyymm) . "01"; my $epoch = timelocal(0,0,12,1, substr($next_day,4,2)-1, substr($next_day,0,4)-1900); $epoch = $epoch - ( 60*60*24 ); my @timestuff = localtime($epoch); return $timestuff[3]; } sub get_next_month { my ($yyyymm) = @_; my $year = substr($yyyymm,0,4); my $month = substr($yyyymm,4,2); if ($month == 12) { $month = 1; $year++; } else { $month++; } return $year . sprintf "%02d",$month; } sub get_previous_quarter { my ($quarter) = @_; my $year = substr($quarter,0,4); my $q = substr($quarter,5,1); if ($q == 1) { $q = 4; $year--; } else { $q--; } return "$year" . "Q$q"; } sub identify_quarter { my ($date) = @_; my $year = substr ($date,0,4); my $month = substr ($date,4,2); my $quarter = int(($month-1) / 3) +1; return "$year" . "Q$quarter"; }
Me

Comment on Care to simplify some working code?
Download Code
Re: Care to simplify some working code?
by BrowserUk (Pope) on Sep 28, 2011 at 19:18 UTC

    Assuming you don't actually need any of the intermediate stuff, this calculates it directly:

    #!/usr/bin/perl -slw use strict; use warnings; use Time::Local; use Test::More "no_plan"; sub lastBusinessDayPrevQ { my( $y, $m, $d ) = unpack 'A4A2A2', shift; my $t = timelocal( 0,0,12, $d, $m-1, $y ); $t -= 43200 until localtime( $t ) !~ m[Mar|Jun|Sep|Dec]; $t -= 43200 until localtime( $t ) =~ m[Mar|Jun|Sep|Dec]; $t -= 43200 until localtime( $t ) =~ m[Mon|Tue|Wed|Thu|Fri]; ( $y, $m, $d ) = unpack 'x20a4 X20a3 xa2', scalar localtime( $t ); $m = { Mar=>'03', Jun=>'06', Sep=>'09', Dec=>'12' }->{ $m }; return join '', $y, $m, $d; } test(); sub test { ok ( lastBusinessDayPrevQ("20110901") eq "20110630"); ok ( lastBusinessDayPrevQ("20120101") eq "20111230"); }

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      (hmm... I've tried posting a response to this 3 times now.)

      This is spectacular. Thanks very much. I haven't been made to feel quite so foolish in a very long time. Bravo sir.

      BrowserUk++

      Me

        Beware the caveats! See Is there an easy way to get the start date of the current week? for discussion of most of them.


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Care to simplify some working code?
by RichardK (Priest) on Sep 29, 2011 at 11:36 UTC

    Inspired by BrowserUk's clever solution -- how about this ?

    use strict; use warnings; use Time::Local; use Test::More "no_plan"; sub lastq_bday { my( $y, $m, $d ) = unpack 'A4A2A2', shift; my $q = int( ($m-1) /3 ) * 3; my $first = timelocal(0,0,12,1,$q,$y); $first -= 60*60*24; # last day of previous quarter my @t = localtime($first); $t[3] -= 2 if $t[6] == 0; #Sunday $t[3] -= 1 if $t[6] == 6; #Saturday return sprintf ("%d%02d%02d",1900+$t[5],$t[4]+1,$t[3]); } is ( lastq_bday("20110901"),"20110630"); is ( lastq_bday("20120101"),"20111230"); is ( lastq_bday("20110215"),"20101231"); is ( lastq_bday("20110407"),"20110331"); is ( lastq_bday("20110808"),"20110630"); is ( lastq_bday("20110101"),"20101231");
Reaped: Re: Care to simplify some working code?
by NodeReaper (Curate) on Sep 29, 2011 at 13:16 UTC
Re: Care to simplify some working code?
by Voronich (Hermit) on Sep 29, 2011 at 15:53 UTC

    So here's what I came up with (deciding to barrel foward with some rework and cleanup of the existing algorithm primarily as an exercise. I really was going to(and in fact already had) put BrowserUk's code in the main script. But the more I look at the result of the cleanup the more I like it. Computing rather than attrition makes for longer code. But it appeals more to my sense of order.

    Yeah I have to put exception handling in there. The code as it stands is awfully 'happy path'. But I'll trap errors in the input data going in to the primary function for now, then worry about the support functions later on.

    Thanks again to tye for the encouragement and help with the "is_deeply" and "is not ok" stuff. o/

    #!/usr/bin/perl -w use strict; use warnings; use Time::Local; use Test::More "no_plan"; test(); sub test { is ( identify_quarter(1), 1); is ( identify_quarter(2), 1); is ( identify_quarter(3), 1); is ( identify_quarter(4), 2); is ( identify_quarter(5), 2); is ( identify_quarter(6), 2); is ( identify_quarter(7), 3); is ( identify_quarter(8), 3); is ( identify_quarter(9), 3); is ( identify_quarter(10), 4); is ( identify_quarter(11), 4); is ( identify_quarter(12), 4); is_deeply ( [ get_previous_quarter(2011,4)],[(2011,3)]); is_deeply ( [ get_previous_quarter(2011,4)],[(2011,3)]); is_deeply ( [ get_previous_quarter(2011,3)],[(2011,2)]); is_deeply ( [ get_previous_quarter(2011,1)],[(2010,4)]); is ( last_month_of_quarter(1), 3); is ( last_month_of_quarter(2), 6); is ( last_month_of_quarter(3), 9); is ( last_month_of_quarter(4), 12); is_deeply ( [next_month(2011,1)] , [ (2011,2) ] ); is_deeply ( [next_month(2011,12)] , [ (2012,1) ] ); is ( last_day_of_month(2011,01), 31); is ( last_day_of_month(2011,02), 28); is ( last_day_of_month(2012,02), 29); is_deeply ( [ get_last_day_of_prev_quarter(2011,1,1) ],[ (2010,12, +31) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,2,1) ],[ (2010,12, +31) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,3,1) ],[ (2010,12, +31) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,3,1) ],[ (2010,12, +31) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,4,1) ],[ (2011,3,3 +1) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,5,1) ],[ (2011,3,3 +1) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,6,1) ],[ (2011,3,3 +1) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,7,1) ],[ (2011,6,3 +0) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,8,1) ],[ (2011,6,3 +0) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,9,1) ],[ (2011,6,3 +0) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,10,1) ],[ (2011,9, +30) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,11,1) ],[ (2011,9, +30) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,12,1) ],[ (2011,9, +30) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2011,9,1) ],[ (2011,6,3 +0) ] ); is_deeply ( [ get_last_day_of_prev_quarter(2012,1,1) ],[ (2011,12, +31) ] ); is_deeply ( [ get_last_bus_day_of_prev_quarter(2011,9,1) ],[ (2011 +,6,30) ]); is_deeply ( [ get_last_bus_day_of_prev_quarter(2012,1,1) ],[ (2011 +,12,30) ]); } sub get_last_day_of_prev_quarter { my ($yyyy,$mm,$dd) = @_; my ($year, $quarter) = get_previous_quarter($yyyy,identify_quarter +($mm)); my $month = $quarter * 3; my $day = last_day_of_month($year,$month); return ($year,$month,$day); } sub get_last_bus_day_of_prev_quarter { my ($yyyy,$mm,$dd) = @_; my ($year,$month,$day) = get_last_day_of_prev_quarter($yyyy,$mm,$d +d); my $epoch = timelocal(0,0,12, $day, $month-1, $year-1900); my @timestuff = localtime($epoch); # # If the day is a Sunday (0) or a Saturday (6) # # Subtract 1 or 2 days worth of seconds, then convert # back. my $date_diff = 0; if ($timestuff[6] == 0) { $date_diff = 2; } if ($timestuff[6] == 6) { $date_diff = 1; } if ($date_diff > 0) { $epoch = $epoch - (60*60*24) * $date_diff; } @timestuff = localtime($epoch); return ($timestuff[5] + 1900, $timestuff[4] + 1,$timestuff[3]); } sub last_day_of_month { # This logic is moronic, but it works. # To get the last day of a given month, first take the first day # of the first month, convert it to epoch seconds, subtract a day # (86400 seconds), then re-convert back and pull the "day of month +" # element out of the list. my ($yyyy,$mm) = @_; my ($year,$month) = next_month($yyyy,$mm); my $epoch = timelocal(0,0,12,1, $month-1, $year-1900); $epoch = $epoch - ( 60*60*24 ); my @timestuff = localtime($epoch); return $timestuff[3]; } sub next_month { my ($yyyy,$mm) = @_; if ($mm == 12) { $mm = 1; $yyyy++; } else { $mm++; } return ($yyyy,$mm); } sub get_previous_quarter { my ($yyyy,$quarter) = @_; if ($quarter == 1) { $quarter = 4; $yyyy--; } else { $quarter--; } return ($yyyy,$quarter); } sub identify_quarter { my ($mm) = @_; return int(($mm-1) / 3) +1; }
    Me

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://928384]
Approved by BrowserUk
Front-paged by planetscape
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (9)
As of 2014-12-22 12:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (116 votes), past polls