view release on metacpan or  search on metacpan

lib/Astro/Catalog/IO/Cluster.pm  view on Meta::CPAN

            dec   => $objdec,
            name  => $star->id());

        # and push it into the Astro::Catalog::Item object
        $star->coords($coords);

        # x & y
        if ($separated[8] ne '0.000') {
            $star->x($separated[8]);
        }
        if ($separated[9] ne '0.000') {
            $star->y($separated[9]);
        }

        # number of magnitudes and colours
        $lines[1] =~ s/^\s+//;
        my @colours = split(/\s+/, $lines[1]);

        my @quality;
        my (@colors, @fluxes);
        foreach my $j (0 .. $#colours) {
            # colours have minus signs
            if (lc($colours[$j]) =~ "-") {
                # build a colour object and push it into the @colors array
                my @filters = split "-", $colours[$j];
                my $color = new Astro::FluxColor(
                        upper => new Astro::WaveBand(Filter => $filters[0]),
                        lower => new Astro::WaveBand(Filter => $filters[1]),
                        quantity => new Number::Uncertainty(
                            Value => $separated[3*$j+10],
                            Error => $separated[3*$j+11]));
                push @colors, $color;

                # quality flags
                $quality[$j] = $separated[3*$j+12];
            }
            else {
                my $mag = new Astro::Flux(
                        new Number::Uncertainty(
                            Value => $separated[3*$j+10],
                            Error => $separated[3*$j+11]),
                        'mag', $colours[$j]);
                push @fluxes, $mag;

                # quality flags
                $quality[$j] = $separated[3*$j+12];

                # increment counter
                $j = $j + 2;
            }
        }

        $star->fluxes(new Astro::Fluxes(@fluxes, @colors));

        # set default "good" quality
        $star->quality(0);

        # check and set quality flag
        foreach my $k (0 .. $#colours) {
            # if quality not good then set bad flag
            if (Scalar::Util::looks_like_number($quality[$k])) {
                if (defined $quality[$k] && $quality[$k] != 0) {
                    $star->quality(1);
                }
            }
            else {
                if (defined $quality[$k] && $quality[$k] ne "OO") {
                    $star->quality(1);
                }
            }
        }

        # push it onto the stack
        $catalog->pushstar($star);
    }

    $catalog->origin('IO::Cluster');
    return $catalog;

}

=item B<_write_catalog>

Will write the catalog object to an standard ARK Cluster format file

    $lines = Astro::Catalog::IO::Cluster->_write_catalog($catalog, %opts);

where $catalog is an Astro::Catalog object and allowable options are
currently C<Colours> and C<Mags>, e.g.

    $lines = Astro::Catalog::IO::Cluster->_write_catalog(
        $catalog, Magnitudes => \@mags, Colours => \@colours );

where magnitudes and colours passed in the array will be used in the catalog
despite the presence of other

    my @mags = ('R');
    my @colour = ('B-R', 'B-V');
    \@lines = Astro::Catalog::IO::Cluster->write_catalog(
        $catalog, Magnitudes => \@mags, Colours => \@colours);

will write a catalog with R, B-R and B-V.

=cut

sub _write_catalog {
    croak('Usage: _write_catalog($catalog, [%opts])') unless scalar(@_) >= 1;
    my $class = shift;
    my $catalog = shift;

    # real list of filters and colours in the catalog
    my @filters = $catalog->starbyindex(0)->what_filters();
    my @colours = $catalog->starbyindex(0)->what_colours();

    # number of stars in catalog
    my $number = $catalog->sizeof();

    # number of filters & colours
    my $num_mags = $catalog->starbyindex(0)->what_filters();
    my $num_cols = $catalog->starbyindex(0)->what_colours();

lib/Astro/Catalog/IO/Cluster.pm  view on Meta::CPAN

            }
        }
    }

    # same for colours
    my %seen_col;
    foreach my $k (0 .. $#{$cols}) {
        next if $seen_col{$cols->[$k]} ++;
        foreach my $l (0 .. $num_cols-1) {
            if (${$cols}[$k] eq $colours[$l]) {
                push @out_cols, ${$cols}[$k];
                last;
            }
        }
    }

    # write header
    my @output;
    my $output_line;

    # check to see if we're outputing all the filters and colours
    my $total = scalar(@out_mags) + scalar(@out_cols);

    push @output, "$total colours were created";
    push @output, "@out_mags @out_cols";

    # wierd and odd
    $output_line = "Origin: " . $catalog->origin() . " "
        if defined $catalog->origin();

    if (defined $catalog->get_ra() && defined $catalog->get_dec()) {
        $output_line = $output_line .
            "  Field Centre: RA " . $catalog->get_ra() .
            ", Dec " . $catalog->get_dec() . " ";
    }

    $output_line = $output_line .
        "  Catalogue Radius: " . $catalog->get_radius() .  " arcmin"
        if defined $catalog->get_radius();

    $output_line = $output_line;
    push @output, $output_line;

    # write body

    # loop through all the stars in the catalog
    foreach my $star (0 .. $#$stars) {
        $output_line = undef;

        # field, number, ra, dec and x&y position
        my $field = ${$stars}[$star]->field;
        if (defined $field) {
            $output_line = $field . "  ";
        }
        else {
            $output_line = "0 ";
        }

        my $id = ${$stars}[$star]->id;
        if (defined $id &&
                Scalar::Util::looks_like_number($id)) {
            $output_line = $output_line . $id . "  ";
        }
        else {
            $output_line = $output_line . $star . " ";
        }

        # fiddle with the dec, olv versions of the Fortran Cluster
        # parser don't like + signs for northern hemisphere dec's
        my $dec = ${$stars}[$star]->dec();
        $dec =~ s/\+//;

        $output_line = $output_line . ${$stars}[$star]->ra() . "  ";
        $output_line = $output_line . $dec . "  ";

        my $x = ${$stars}[$star]->x;
        my $y = ${$stars}[$star]->y;

        if (defined $x && defined $y) {
            $output_line = $output_line . $x . " " . $y . " ";
        }
        else {
            $output_line = $output_line . "0.000  0.000  ";
        }

        # magnitudes
        foreach my $out_mag (@out_mags) {
            # Grab each magnitude listed in the @out_mags array and append
            # it to the output line.
            my $out_mag_value = ${$stars}[$star]->get_magnitude($out_mag);
            if (defined $out_mag_value) {
                $output_line .= $out_mag_value . "  ";
            }
            else {
                $output_line .= "0.000 ";
            }

            # And get the error, if it exists.
            my $out_mag_error = ${$stars}[$star]->get_errors($out_mag);
            if (defined $out_mag_error) {
                $output_line .= $out_mag_error . "  ";
            }
            else {
                $output_line .= "0.000 ";
            }

            # And the quality.
            my $quality = ${$stars}[$star]->quality;
            if (defined $quality) {
                $output_line .= $quality . "  ";
            }
            else {
                $output_line .= "0 ";
            }
        }

        # Now for the colours.
        foreach my $out_col (@out_cols) {
            # Grab each colour listed in the @out_cols array and append it
            # to the output line.
            my $out_col_value = ${$stars}[$star]->get_colour($out_col);