DateTime::Event::Random - DateTime extension for creating random datetimes.

DateTime-Event-Random documentation Contained in the DateTime-Event-Random distribution.

Index

Code Index:

NAME

Top

DateTime::Event::Random - DateTime extension for creating random datetimes.

SYNOPSIS

Top

 use DateTime::Event::Random;

 # Creates a random DateTime
 $dt = DateTime::Event::Random->datetime;

 # Creates a random DateTime in the future
 $dt = DateTime::Event::Random->datetime( after => DateTime->now );

 # Creates a random DateTime::Duration between 0 and 15 days
 $dur = DateTime::Event::Random->duration( days => 15 );

 # Creates a DateTime::Set of random dates 
 # with an average density of 4 months, 
 # that is, 3 events per year, with a span 
 # of 2 years
 my $dt_set = DateTime::Event::Random->new(
                  months => 4,   # events occur about 3 times a year
                  start =>  DateTime->new( year => 2003 ),
                  end =>    DateTime->new( year => 2005 ) ); 

 print "next is ", $dt_set->next( DateTime->today )->datetime, "\n";
 # output: next is 2004-02-29T22:00:51

 my @days = $dt_set->as_list;
 print join('; ', map{ $_->datetime } @days ) . "\n";
 # output: 2003-02-16T21:08:58; 2003-02-18T01:24:13; ...

DESCRIPTION

Top

This module provides convenience methods that let you easily create DateTime::Set, DateTime, or DateTime::Duration objects with random values.

USAGE

Top

* new

Creates a DateTime::Set object that contains random events.

  my $random_set = DateTime::Event::Random->new;

The events occur at an average of once a day, forever.

You may give density parameters to change this. The density is specified as a duration:

  my $two_daily_set = DateTime::Event::Random->new( days => 2 );

  my $three_weekly_set = DateTime::Event::Random->new( weeks => 3 );

  my $random_set = DateTime::Event::Random->new( duration => $dur );

If span parameters are given, then the set is bounded:

  my $rand = DateTime::Event::Random->new(
                 months => 4,   # events occur about 3 times a year
                 start =>  DateTime->new( year => 2003 ),
                 end =>    DateTime->new( year => 2005 ) );

Note that the random values are generated on demand, which means that the values may not be repeateable between iterations. See the new_cached constructor for a solution.

A DateTime::Set object does not allow for the repetition of values. Each element in a set is different.

The DateTime::Set accessors (as_list, iterator/next/previous) always return sorted datetimes.

* new_cached

Creates a DateTime::Set object representing the set of random events.

    my $random_set = DateTime::Event::Random->new_cached;

If a set is created with new_cached, then once an value is seen, it is cached, such that all sequences extracted from the set are equal.

Cached sets are slower and take more memory than sets generated with the plain new constructor. They should only be used if you need unbounded sets that would be accessed many times and when you need repeatable results.

This method accepts the same parameters as the new method.

* datetime

Returns a random DateTime object. 

    $dt = DateTime::Event::Random->datetime;

If a span is specified, then the returned value will be within the span:

    $dt = DateTime::Event::Random->datetime( span => $span );

    $dt = DateTime::Event::Random->datetime( after => DateTime->now );

You can also specify locale and time_zone parameters, just like in DateTime->new().

* duration

Returns a random DateTime::Duration object.

    $dur = DateTime::Event::Random->duration;

If a duration is specified, then the returned value will be within the duration:

    $dur = DateTime::Event::Random->duration( duration => $dur );

    $dur = DateTime::Event::Random->duration( days => 15 );

INTERNALS

Top

* _random_init
* _random_duration

These methods are called by DateTime::Set to generate the random datetime sequence.

You can override these methods in order to make different random distributions. The default random distribution is "uniform".

The internals API is not stable.

COOKBOOK

Top

* Make a random datetime
  use DateTime::Event::Random;

  my $dt = DateTime::Event::Random->datetime;

  print "datetime " .  $dt->datetime . "\n";
* Make a random datetime, today
  use DateTime::Event::Random;

  my $dt = DateTime->today + DateTime::Event::Random->duration( days => 1 );

  print "datetime " .  $dt->datetime . "\n";

This is another way to do it. It takes care of length of day problems, such as DST changes and leap seconds:

  use DateTime::Event::Random;

  my $dt_today = DateTime->today;
  my $dt_tomorrow = $dt_today + DateTime::Duration->new( days => 1 );

  my $dt = DateTime::Event::Random->datetime( 
               start =>  $dt_today, 
               before => $dt_tomorrow );

  print "datetime " .  $dt->datetime . "\n";
* Make a random sunday
  use DateTime::Event::Random;

  my $dt = DateTime::Event::Random->datetime;
  $dt->truncate( to => week );
  $dt->add( days => 6 );

  print "datetime " . $dt->datetime . "\n";
  print "weekday " .  $dt->day_of_week . "\n";
* Make a random friday-13th
  use DateTime::Event::Random;
  use DateTime::Event::Recurrence;

  my $day_13 = DateTime::Event::Recurrence->monthly( days => 13 );
  my $friday = DateTime::Event::Recurrence->weekly( days => 6 ); 
  my $friday_13 = $friday->intersection( $day_13 );

  my $dt = $friday_13->next( DateTime::Event::Random->datetime );

  print "datetime " .  $dt->datetime . "\n";
  print "weekday " .   $dt->day_of_week . "\n";
  print "month day " . $dt->day . "\n";

AUTHOR

Top

Flavio Soibelmann Glock fglock@pucrs.br

COPYRIGHT

Top

Copyright (c) 2004 Flavio Soibelmann Glock. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the LICENSE file included with this module.

SEE ALSO

Top

datetime@perl.org mailing list

DateTime Web page at http://datetime.perl.org/

DateTime and DateTime::Duration - date and time.

DateTime::Set - "sets"

DateTime-Event-Random documentation Contained in the DateTime-Event-Random distribution. 
package DateTime::Event::Random;

use strict;
use DateTime::Set;
use vars qw( $VERSION @ISA );
use Carp;

BEGIN {
    $VERSION = 0.03;
}

sub new_cached {
    my $class = shift;
    my %args = @_;   # the parameters are validated by DT::Set

    my $density = $class->_random_init( \%args );

    my $cache_set = DateTime::Set->empty_set;
    my $cache_last;
    my $cache_first;

    my $get_cached = 
                sub {
                    my $dt = $_[0];
                    my $prev = $cache_set->previous( $dt );
                    my $next = $cache_set->next( $dt );
                    return ( $prev, $next ) if defined $prev && defined $next;

                    # initialize the cache
                    unless ( defined $cache_last )
                    {
                        $cache_last = $dt - $class->_random_duration( $density );
                        $cache_first = $cache_last->clone;
                        $cache_set = $cache_set->union( $cache_last );
                    };

                    while ( $cache_last <= $dt ) {
                        $cache_last += $class->_random_duration( $density );
                        $cache_set = $cache_set->union( $cache_last );
                    };

                    while ( $cache_first >= $dt ) {
                        $cache_first -= $class->_random_duration( $density );
                        $cache_set = $cache_set->union( $cache_first );
                    };

                    $prev = $cache_set->previous( $dt );
                    $next = $cache_set->next( $dt );
                    return ( $prev, $next );
                };

    my $cached_set = DateTime::Set->from_recurrence(
        next =>  sub {
                    return $_[0] if $_[0]->is_infinite;
                    my ( undef, $next ) = &$get_cached( $_[0] );
                    return $next;
                 },
        previous => sub {
                    return $_[0] if $_[0]->is_infinite;
                    my ( $previous, undef ) = &$get_cached( $_[0] );
                    return $previous;
                 },
        %args,
    );
    return $cached_set;

}

sub new {
    my $class = shift;
    my %args = @_;   # the parameters will be validated by DT::Set
    my $density = $class->_random_init( \%args );
    return DateTime::Set->from_recurrence(
        next =>     sub {
                        return $_[0] if $_[0]->is_infinite;
                        $_[0] + $class->_random_duration( $density );
                    },
        previous => sub {
                        return $_[0] if $_[0]->is_infinite;
                        $_[0] - $class->_random_duration( $density );
                    },
        %args,
    );
}

sub _random_init {
    my $class = shift;
    my $args = shift;  

    my $density = 0;

    if ( exists $args->{duration} )
    {
        my %dur = $args->{duration}->deltas;
        $args->{ $_ } = $dur{ $_ } for ( keys %dur );
        delete $args->{duration};
    }

    $density += ( delete $args->{nanoseconds} ) / 1E9 if exists $args->{nanoseconds};
    $density += ( delete $args->{seconds} ) if exists $args->{seconds};
    $density += ( delete $args->{minutes} ) * 60 if exists $args->{minutes};
    $density += ( delete $args->{hours} )  * 60*60 if exists $args->{hours};
    $density += ( delete $args->{days} )   * 24*60*60 if exists $args->{days};
    $density += ( delete $args->{weeks} )  * 7*24*60*60 if exists $args->{weeks};
    $density += ( delete $args->{months} ) * 365.24/12*24*60*60 if exists $args->{months};
    $density += ( delete $args->{years} )  * 365.24*24*60*60 if exists $args->{years};

    $density = 24*60*60 unless $density;  # default = 1 day

    return {
        density => $density,
        starting => 1,
    };
}

sub _random_duration {
    my $class = shift;
    my $param = shift;

    my $tmp;
    if ( $param->{starting} )
    {
        $param->{starting} = 0;

        # this is a density function that approximates to 
        # the "duration" in seconds between a random and
        # a non-random date.
        $tmp = log( 1 - rand ) * ( - $param->{density} / 2 );
    }
    else
    {
        # this is a density function that approximates to 
        # the "duration" in seconds between two random dates.
        $tmp = log( 1 - rand ) * ( - $param->{density} );
    }


    # split into "days", "seconds" and "nanoseconds"

    my $days = int( $tmp / ( 24*60*60 ) );
    if ( $days > 1000 ) 
    {
        return DateTime::Duration->new(
               days =>        $days,
               seconds =>     int( rand( 61 ) ),
               nanoseconds => int( rand( 1E9 ) ) );
    }

    my $seconds = int( $tmp );
    return DateTime::Duration->new( 
               seconds =>     $seconds, 
               nanoseconds => int( 1E9 * ( $tmp - $seconds ) ) ); 
}


sub datetime {
    my $class = shift;
    carp "Missing class name in call to ".__PACKAGE__."->datetime()"
        unless defined $class;
    my %args = @_;

    my $locale    = delete $args{locale};
    my $time_zone = delete $args{time_zone};

    my $dt = $class->_random_datetime_no_locale( %args );

    $dt->set( locale => $locale ) if defined $locale;
    $dt->set( time_zone => $time_zone ) if defined $time_zone;
    return $dt;
}

sub _random_datetime_no_locale {
    my $class = shift;
    my %args = @_;
    my %span_args;
    my $span;
    if ( exists $args{span} )
    {
        $span = delete $args{span};
    }
    else
    {
        for ( qw( start end before after ) )
        {
            $span_args{ $_ } = delete $args{ $_ } if exists $args{ $_ };
        }
        $span = DateTime::Span->from_datetimes( %span_args )
            if ( keys %span_args );
    } 

    if ( ! defined $span ||
         ( $span->start->is_infinite && 
           $span->end->is_infinite ) )
    {
        my $dt = DateTime->now( %args );
        $dt->add( months =>      ( 0.5 - rand ) * 1E6 );
        $dt->add( days =>        ( 0.5 - rand ) * 31 );
        $dt->add( seconds =>     ( 0.5 - rand ) * 24*60*60 );
        $dt->add( nanoseconds => ( 0.5 - rand ) * 1E9 );
        return $dt;
    }

    return undef unless defined $span->start;

    if ( $span->start->is_infinite )
    {
        my $dt = $span->end;
        $dt->add( months =>      ( - rand ) * 1E6 );
        $dt->add( days =>        ( - rand ) * 31 );
        $dt->add( seconds =>     ( - rand ) * 24*60*60 );
        $dt->add( nanoseconds => ( - rand ) * 1E9 );
        return $dt;
    }

    if ( $span->end->is_infinite )
    {
        my $dt = $span->start;
        $dt->add( months =>      ( rand ) * 1E6 );
        $dt->add( days =>        ( rand ) * 31 );
        $dt->add( seconds =>     ( rand ) * 24*60*60 );
        $dt->add( nanoseconds => ( rand ) * 1E9 );
        return $dt;
    }

    my $dt1 = $span->start;
    my $dt2 = $span->end;
    my %deltas = $dt2->subtract_datetime( $dt1 )->deltas;
    # find out the most significant delta
    if ( $deltas{months} ) {
        $deltas{months}++;
        $deltas{days} = 31;
        $deltas{minutes} = 24*60;
        $deltas{seconds} = 60;
        $deltas{nanoseconds} = 1E9;
    }
    elsif ( $deltas{days} ) {
        $deltas{days}++;
        $deltas{minutes} = 24*60;
        $deltas{seconds} = 60;
        $deltas{nanoseconds} = 1E9;
    }
    elsif ( $deltas{minutes} ) {
        $deltas{minutes}++;
        $deltas{seconds} = 60;
        $deltas{nanoseconds} = 1E9;
    }
    elsif ( $deltas{seconds} ) {
        $deltas{seconds}++;
        $deltas{nanoseconds} = 1E9;
    }
    else {
        $deltas{nanoseconds}++;
    }

    my %duration;
    my $dt;
    while (1) 
    {
        %duration = ();
        for ( keys %deltas ) 
        {
            $duration{ $_ } = int( rand() * $deltas{ $_ } ) 
                if $deltas{ $_ };
        }
        $dt = $dt1->clone->add( %duration );
        return $dt if $span->contains( $dt );

        %duration = ();
        for ( keys %deltas ) 
        {
            $duration{ $_ } = int( rand() * $deltas{ $_ } )
                if $deltas{ $_ };
        }
        $dt = $dt2->clone->subtract( %duration );
        return $dt if $span->contains( $dt );
    }
}

sub duration {
    my $class = shift;
    carp "Missing class name in call to ".__PACKAGE__."->duration()"
        unless defined $class;
    my $dur;
    if ( @_ ) 
    {
        if ( $_[0] eq 'duration' ) 
        {
            $dur = $_[1];
        }
        else
        {
            $dur = DateTime::Duration->new( @_ );
        }
    }
    if ( $dur ) {
        my $dt1 = DateTime->now();
        my $dt2 = $dt1 + $dur;
        my $dt3 = $class->datetime( start => $dt1, before => $dt2 );
        return $dt3 - $dt1;
    }
    return DateTime->now() - $class->datetime();
}

1;

__END__