Astro-Flux
view release on metacpan or search on metacpan
# Return right here with undef if $derived is false.
return if ( ! $derived );
# Return right here if we are not looking for a 'mag' or 'magnitude'.
return if ( $type !~ /^mag/i );
# Get the reference waveband for the current flux such that the
# reference waveband doesn't have only a pointer back to the current
# one.
my ($ref_flux, $ref_datetime);
my $running_total = undef;
my $running_error = undef;
foreach my $flux ( @{${$self->{FLUXES}}{$key}} ) {
if( defined( $flux->reference_waveband ) &&
( scalar( @{${$self->{FLUXES}}{$flux->reference_waveband->natural}} > 1 ) ||
${${$self->{FLUXES}}->{$flux->reference_waveband->natural}}[0]->reference_waveband != $waveband ) ) {
if ( defined $args{'datetime'} ) {
if ( defined $flux->datetime ) {
$running_total += $flux->quantity('mag');
$running_error += $flux->error('mag')*$flux->error('mag');
$ref_flux = ${${$self->{FLUXES}}->{$flux->reference_waveband->natural}}[0];
$ref_datetime = $flux->datetime();
last;
}
} else {
$running_total += $flux->quantity('mag');
$running_error += $flux->error('mag')*$flux->error('mag');
$ref_flux = ${${$self->{FLUXES}}{$flux->reference_waveband->natural}}[0];
last;
}
}
}
# If we have a reference flux, get the magnitude from that waveband and add
# it to the running total.
if( defined( $ref_flux ) ) {
my $mag = $self->flux( waveband => $ref_flux->waveband, derived => 1 )->quantity('mag');
my $err = $self->flux( waveband => $ref_flux->waveband, derived => 1 )->error('mag');
if ( defined $args{'datetime'} ) {
if ( defined $ref_datetime ) {
$running_total += $mag;
$running_error += $err if defined $err;
}
} else {
$running_total += $mag;
$running_error += $err if defined $err;
}
}
$running_error = sqrt( $running_error ) if defined $running_error;
# Form a flux object with the running total and the input waveband,
# and return that.
if( ! defined( $running_total ) ) {
return undef;
} else {
my $number;
if ( defined $running_error ) {
$number = new Number::Uncertainty( Value => $running_total,
Error => $running_error );
} else {
$number = $running_total;
}
if ( defined $args{'datetime'} ) {
my $returned_flux = new Astro::Flux( $number, 'mag', $waveband,
quality => new Misc::Quality( derived => 1 ),
datetime => $ref_datetime );
return $returned_flux;
} else {
my $returned_flux = new Astro::Flux( $number, 'mag', $waveband,
quality => new Misc::Quality( derived => 1 ) );
return $returned_flux;
}
}
}
=item B<color>
Returns the color for two requested wavebands.
my $color = $fluxes->color( upper => new Astro::WaveBand( Filter => 'H' ),
lower => new Astro::WaveBand( Filter => 'J' ) );
my $color = $fluxes->color( upper => new Astro::WaveBand( Filter => 'H' ),
lower => new Astro::WaveBand( Filter => 'J' ),
datetime => new DateTime );
Arguments are passed as key-value pairs. The two mandatory named arguments are
'upper' and 'lower', denoting the upper (longer wavelength) and lower (shorter
wavelength) wavebands for the color. The value for either can be either an
C<Astro::WaveBand> object or a string that can be used to create a new
C<Astro::WaveBand> object via its Filter parameter.
The above example will return the first H-K color in the Fluxes object. The
optional datetime arguement allows you to return a colour at a specific datetime
stamp.
=cut
sub color {
my $self = shift;
my %args = @_;
my $result;
if( ! defined( $args{'upper'} ) ) {
croak "upper waveband argument must be passed to &Astro::Fluxes::color";
}
if( ! defined( $args{'lower'} ) ) {
croak "lower waveband argument must be passed to &Astro::Fluxes::color";
}
my $upper = $args{'upper'};
my $lower = $args{'lower'};
# Upgrade the wavebands to proper Astro::WaveBand objects if necessary.
if( ! UNIVERSAL::isa( $upper, "Astro::WaveBand" ) ) {
$upper = new Astro::WaveBand( Filter => $upper );
}
if( ! UNIVERSAL::isa( $lower, "Astro::WaveBand" ) ) {
$lower = new Astro::WaveBand( Filter => $lower );
}
# First, find out if we have an easy job. Check if the lower refers to
# the upper, from which we can get the colour directly.
my $upper_key = $upper->natural();
my $lower_key = $lower->natural();
foreach my $flux ( @{${$self->{FLUXES}}{$lower_key}} ) {
if( defined( $flux->reference_waveband ) ) {
if ( defined $args{'datetime'} ) {
next unless defined $flux->datetime;
if ( ($flux->datetime <=> $args{'datetime'}) != 0 ) {
my $datetime = $flux->datetime;
next;
} else {
my $datetime = $flux->datetime;
}
}
my $ref_key = $flux->reference_waveband()->natural();
if( $ref_key eq $upper_key ) {
my $num;
if ( defined $flux->error('mag') ) {
$num = new Number::Uncertainty ( Value => $flux->quantity('mag'),
Error => $flux->error('mag') )
} else {
$num = new Number::Uncertainty ( Value => $flux->quantity('mag') );
}
if ( defined $flux->datetime() ) {
my $color = new Astro::FluxColor( lower => $lower,
upper => $upper,
quantity => $num,
datetime => $flux->datetime() );
return $color;
} else {
my $color = new Astro::FluxColor( lower => $lower,
upper => $upper,
quantity => $num );
return $color;
}
}
}
}
# So we're here. Maybe we can get magnitudes for the upper and lower wavebands.
my $upper_mag;
my $lower_mag;
if ( defined( $args{'datetime'} ) ) {
$upper_mag = $self->flux( waveband => $upper, derived => 1,
datetime => $args{'datetime'} );
$lower_mag = $self->flux( waveband => $lower, derived => 1,
datetime => $args{'datetime'} );
} else {
$upper_mag = $self->flux( waveband => $upper, derived => 1 );
$lower_mag = $self->flux( waveband => $lower, derived => 1 );
}
if( defined( $upper_mag ) && defined( $lower_mag ) ) {
my $num;
my $value = $lower_mag->quantity('mag') - $upper_mag->quantity('mag');
if ( defined $upper_mag->error('mag') && $lower_mag->error('mag') ) {
my $error = sqrt( $upper_mag->error('mag')*$upper_mag->error('mag')
+ $lower_mag->error('mag')*$lower_mag->error('mag') );
$num = new Number::Uncertainty ( Value => $value,
Error => $error )
} else {
$num = new Number::Uncertainty ( Value => $value );
}
if ( defined $lower_mag->datetime() && defined $upper_mag->datetime() ) {
my $color = new Astro::FluxColor( lower => $lower,
upper => $upper,
quantity => $num,
datetime => $lower_mag->datetime() );
return $color;
} else {
my $color = new Astro::FluxColor( lower => $lower,
upper => $upper,
quantity => $num );
return $color;
}
}
# At this point I don't really know how to get a colour. If we're here
# that means we have some kind of colour-colour relation that we might
# be able to get the desired colour from...
# Return undef in the meandatetime.
return undef;
}
=item B<pushfluxes>
Push C<Astro::Flux> and C<Astro::FluxColor> object into the C<Astro::Fluxes>
object,
$fluxes->pushfluxes( $flux1, $flux2, $color1 );
Any number of C<Astro::Flux> or C<Astro::FluxColor> objects can
be passed as arguments.
=cut
sub pushfluxes {
my $self = shift;
foreach my $arg ( @_ ) {
if( UNIVERSAL::isa( $arg, "Astro::Flux" ) ) {
my $key = $arg->waveband()->natural();
push @{${$self->{FLUXES}}{$key}}, $arg;
push @{$self->{FLUX}}, $arg->waveband();
} elsif( UNIVERSAL::isa( $arg, "Astro::FluxColor" ) ) {
# Create an Misc::Quality object saying that these are derived
# magnitudes.
my $quality = new Misc::Quality( 'derived' => 1 );
# Create two flux objects, one for the lower and one for the upper.
my $num = new Number::Uncertainty( Value => $arg->quantity,
Error => $arg->error );
my ( $lower_flux, $upper_flux );
if ( defined $arg->datetime() ) {
$lower_flux = new Astro::Flux( $num , 'mag', $arg->lower,
quality => $quality,
reference_waveband => $arg->upper,
datetime => $arg->datetime );
$upper_flux = new Astro::Flux( -1.0 * $num, 'mag', $arg->upper,
quality => $quality,
reference_waveband => $arg->lower,
datetime => $arg->datetime );
} else {
$lower_flux = new Astro::Flux( $num , 'mag', $arg->lower,
quality => $quality,
reference_waveband => $arg->upper );
$upper_flux = new Astro::Flux( -1.0 * $num, 'mag', $arg->upper,
quality => $quality,
reference_waveband => $arg->lower );
}
my $lower_key = $lower_flux->waveband->natural;
my $upper_key = $upper_flux->waveband->natural;
push @{${$self->{FLUXES}}{$lower_key}}, $lower_flux;
push @{${$self->{FLUXES}}{$upper_key}}, $upper_flux;
my $color = $arg->upper() . "-" . $arg->lower();
push @{$self->{COLOR}}, $color;
}
}
return $self;
}
=item B<allfluxes>
Returns an array of all the C<Astro::Flux> objects contained in the
C<Astro::Fluxes> object,
@fluxes_not_dervied = $fluxes->allfluxes();
@fluxes_including_dervied = $fluxes->allfluxes( 'derived' );
by default this will not return the derived fluxes, however the method
takes an optional arguement of 'derived', in which case it will do.
=cut
sub allfluxes {
my $self = shift;
my $flag;
if ( @_ ) {
my $arg = shift;
if( $arg eq 'derived' ) {
$flag = 1;
}
}
my %fluxes = %{$self->{FLUXES}};
( run in 1.565 second using v1.01-cache-2.11-cpan-98e64b0badf )