File indexing completed on 2024-04-28 03:42:52

0001 #!/usr/bin/perl
0002 #
0003 # tycdatatomysql_pm.pl   Put star data from Tycho-1/Tycho-2 ASCII data file into a database
0004 #
0005 # CAUTION: Will truncate the table supplied!
0006 #
0007 # NOTE: The Tycho-1 text data file should be supplied via stdin:
0008 #  use  cat <tycho-1 data file> | <this script> to achieve this.
0009 #
0010 # This version of the script takes into account the proper motion of the star for J2000.0 +/- x millenia
0011 use strict;
0012 use DBI;
0013 use HTMesh;
0014 use Math::Trig;
0015 use Math::Complex;
0016 
0017 my $ERROR;
0018 my @STARS;
0019 
0020 my $VERBOSE = 0;
0021 
0022 my $cnt;
0023 
0024 # For database handling
0025 my $db_db = shift;
0026 my $db_user = shift;
0027 !($db_db eq "") and !($db_user eq "") or print "USAGE: " . $0 . " <database name> <MySQL Username> [[MySQL Password [Table [Millenia]]]\n" and exit;
0028 my $db_pass = shift;
0029 my $db_tbl = shift;
0030 my $pm_millenia = shift;
0031 ($pm_millenia eq "") and $pm_millenia = 10;
0032 if($db_tbl eq "") {
0033     $db_tbl = "tycho"
0034 }
0035 
0036 my $db_query = qq/CREATE DATABASE IF NOT EXISTS `$db_db`;/;
0037 my $db_select_query = qq/USE `$db_db`/;
0038 
0039 my $tbl_query = qq/
0040 CREATE TABLE IF NOT EXISTS `$db_tbl` (
0041   `Trixel` int(11) NOT NULL COMMENT 'Trixel Number',
0042   `RA` double NOT NULL COMMENT 'RA Hours',
0043   `Dec` double NOT NULL COMMENT 'Declination Degrees',
0044   `dRA` double NOT NULL COMMENT 'Proper Motion along RA',
0045   `dDec` double NOT NULL COMMENT 'Proper Motion along Dec',
0046   `PM` double NOT NULL COMMENT 'Proper Motion (magnitude)',
0047   `V` float NOT NULL COMMENT 'Visual Magnitude',
0048   `B` float NOT NULL COMMENT 'Blue Magnitude',
0049   `Mag` float NOT NULL COMMENT 'Magnitude for sorting',
0050   `UID` int(11) NOT NULL auto_increment COMMENT 'Unique ID',
0051   `Copies` tinyint(8) NOT NULL COMMENT 'Number of Copies of the star',
0052   PRIMARY KEY  (`UID`),
0053   UNIQUE KEY `UID` (`UID`),
0054   KEY `Trixel` (`Trixel`,`PM`,`Mag`)
0055 ) ENGINE=MyISAM DEFAULT CHARSET=latin1 AUTO_INCREMENT=1;/;
0056 
0057 my $tbl_trunc_query = qq/TRUNCATE TABLE `$db_tbl`/;
0058 
0059 # For the HTMesh
0060 my $level = 6;
0061 
0062 # Create a new HTMesh, of level $level
0063 my $mesh = new HTMesh($level);
0064 
0065 # Get the database handle
0066 my $dbh = DBI->connect("DBI:mysql:", $db_user, $db_pass, { RaiseError => 1, AutoCommit => 0 });
0067 
0068 my @fields = qw/Trixel RA Dec dRA dDec PM V B Mag Copies/;
0069 
0070 $dbh->do($db_query);
0071 $dbh->do($db_select_query);
0072 $dbh->do($tbl_query);
0073 #$dbh->do($tbl_trunc_query);                 # Avoid truncating the table, because we might want to process split files
0074 $dbh->commit();
0075 
0076 if( $VERBOSE ) {
0077     for( @fields ) {
0078         printf $_ . "|";
0079     }
0080     printf "\n";
0081 }
0082 
0083 while(<>) {
0084     m/^\s*#/ and do { print if $VERBOSE; next};
0085     m/\S/ or     do { print if $VERBOSE; next};
0086     chomp;
0087     my $star = kstars_unpack($_) or do {
0088         warn sprintf("%4d: FORMAT ERROR ($ERROR):\n$_\n", $.);
0089         next;
0090     };
0091     $star->{line} = $.;
0092 
0093     if( $VERBOSE ) {
0094         for(@fields) {
0095             printf $star->{$_} . "|";
0096         }
0097         printf "\n";
0098     }
0099 
0100     my ( $RA1, $Dec1 ) = proper_motion_coords( $star->{RA}, $star->{Dec}, $star->{dRA}, $star->{dDec}, -$pm_millenia * 1000 );
0101     my ( $RA2, $Dec2 ) = proper_motion_coords( $star->{RA}, $star->{Dec}, $star->{dRA}, $star->{dDec}, $pm_millenia * 1000 );
0102 
0103 #    ( $star->{PM} > 1000.0 ) and print "$RA1, $Dec1 : $star->{RA}, $star->{Dec} : $RA2, $Dec2\n";
0104 
0105     my $leftDec;
0106     my $rightDec;
0107     my $topRA;
0108     my $botRA;
0109 
0110     my $verbose = 0;
0111 #    if( $star->{HD} == "91125" ) {
0112 #        $verbose = 1;
0113 #    }
0114 #    else {
0115 #       print $star->{HD} . "\n";
0116 #    }
0117 
0118     $verbose and print "(RA1, RA2, Dec1, Dec2) = ($RA1 ,$RA2 ,$Dec1 ,$Dec2 )\n";
0119 
0120     if( $Dec1 < $Dec2 ) {
0121         $leftDec = $Dec1;
0122         $rightDec = $Dec2;
0123     }
0124     else {
0125         $leftDec = $Dec2;
0126         $rightDec = $Dec1;
0127     }
0128 
0129     if( $RA1 < $RA2 ) {
0130         $topRA = $RA1;
0131         $botRA = $RA2;
0132     }
0133     else {
0134         $topRA = $RA2;
0135         $botRA = $RA1;
0136     }
0137 
0138     $verbose and print "leftDec = $leftDec and topRA = $topRA\n";
0139 
0140     my $epsilon = ( 90.0 / 3600.0 ) / 15.0;
0141 
0142     $star->{originalTrixelID} = $mesh->lookup_id( $star->{RA}, $star->{Dec} );
0143 
0144     $verbose and print "Original trixel ID = " . $star->{originalTrixelID};
0145 
0146     my @trixels;
0147     if( $star->{Name} eq "" && $star->{GName} eq "" ) {
0148 
0149         my $separation = sqrt( hour2deg($botRA - $topRA) * hour2deg($botRA - $topRA) + ($leftDec - $rightDec) * ($leftDec - $rightDec) );
0150 
0151         # HTMesh::intersect is called (in DeepStarComponent::draw()) with a 1 degree "safety" margin.
0152     # So we tolerate upto < 1 degree of proper motion without duplication
0153         if( $separation > 50 / 60 ) {
0154 #            $mesh->intersect_poly4( $botRA, $leftDec,
0155 #                                    $botRA - $epsilon, $leftDec + $epsilon,
0156 #                                    $topRA - $epsilon, $rightDec - $epsilon,
0157 #                                    $topRA, $rightDec);
0158             $mesh->intersect_poly4( $topRA, $rightDec,
0159                                     $topRA - $epsilon, $rightDec - $epsilon,
0160                                     $botRA - $epsilon, $leftDec + $epsilon,
0161                                     $botRA, $leftDec);
0162 
0163             @trixels = $mesh->results();
0164         }
0165         if( !@trixels ) {
0166            @trixels = $mesh->lookup_id( $star->{RA}, $star->{Dec} );
0167         }
0168     }
0169     else {
0170         @trixels = $mesh->lookup_id( $star->{RA}, $star->{Dec} );
0171     }
0172         
0173     for(@trixels) {
0174         my $tid = $_;
0175         $star->{Trixel} = $tid - 32768; # TODO: Change magic number if HTM level changes
0176         $star->{Copies} = 0;
0177         if( $star->{originalTrixelID} == $tid ) {
0178             $star->{Copies} = @trixels;
0179         }
0180         $verbose and print "Trixel = " . $star->{Trixel} . "\n";
0181         my $query ||= qq/INSERT INTO `$db_tbl` (/ .
0182             join(", ", map {"`$_`"} @fields) .
0183             qq/) VALUES (/ .
0184             join(", ", map {"?"} @fields) .
0185             qq/)/;
0186         my $sth ||= $dbh->prepare($query);
0187         $sth->execute(@$star{@fields});
0188     }
0189         
0190 }
0191 
0192 $dbh->commit();
0193 
0194 $dbh->disconnect();
0195 
0196 exit;
0197 
0198 #----------------------------------------------------------------------------
0199 #--- Subroutines ------------------------------------------------------------
0200 #----------------------------------------------------------------------------
0201 
0202 sub kstars_unpack {
0203     my $line = shift;
0204     chomp $line;
0205 
0206     # Column number 78 demarkates between numeric data and the genetive/long names
0207     my $s1 = substr($line, 0, 80, "");
0208 
0209     # Comments on the File format:
0210     # ============================
0211     # * Most fields are of variable width
0212     # * All fields are separated by atleast one space and have a non-blank value,
0213     #   excepting the case of genetive name and long name fields
0214     #
0215     # Fields are: 
0216     # -----------
0217     # RA Dec pmRA pmDec B V Tyc2ID[=0]
0218     #
0219     # The regexp used here is as strict as possible on the adherence to field formats
0220     
0221     $s1 =~ m{^\s*(\d?\d?\d\.\d{6})\s   # RA Hours
0222             \s*(-?\d?\d\.\d{6})\s      # DEC Degrees
0223             \s*(-?\d+\.\d\d\d)\s       # dRA/dt 
0224             \s*(-?\d+\.\d\d\d)\s       # dDec/dt
0225             \s*([- \d]\d\.\d\d\d)\s    # B Magnitude
0226             \s*([- \d]\d\.\d\d\d)\s    # V Magnitude
0227             }x or do 
0228         {
0229             $ERROR = "Positional Error (0-59)";
0230             return;
0231         };
0232     
0233     my $star = {
0234         RA        => $1 * 24.0 / 360.0,
0235         Dec       => $2,
0236     dRA       => $3,
0237     dDec      => $4,
0238         B         => $5,
0239         V         => $6,
0240         PM        => sqrt($3 * $3 + $4 * $4)
0241     };
0242 
0243     if( $star->{V} == 30.0 && $star->{B} != 30.0 ) {
0244     $star->{Mag} = $star->{B} - 1.6;
0245     }
0246     else {
0247     $star->{Mag} = $star->{V};
0248     }
0249     
0250     return $star;
0251 }
0252 
0253 sub proper_motion_coords {
0254     my ( $ra0, $dec0, $pmRA, $pmDec, $years ) = @_;
0255 
0256     my $theta0 = hour2rad($ra0);
0257     my $lat0   = deg2rad($dec0);
0258 
0259     my $pm = sqrt( $pmRA * $pmRA + $pmDec * $pmDec ) * $years;
0260     my $dir0 = ( $pm > 0 ) ? atan2( $pmRA, $pmDec ) : atan2( -$pmRA, -$pmDec );
0261     ( $pm < 0 ) and $pm = - $pm;
0262 #    print "$pm, $dir0\n";
0263 
0264     my $dst = milliarcsecond2rad($pm);
0265 
0266     my $phi0 = pi/2 - $lat0;
0267 
0268     my $lat1   = asin(sin($lat0)*cos($dst) +
0269                       cos($lat0)*sin($dst)*cos($dir0));
0270     my $dtheta = atan2(sin($dir0)*sin($dst)*cos($lat0),
0271                        cos($dst)-sin($lat0)*sin($lat1));
0272 
0273     return (rad2hour($theta0 + $dtheta), rad2deg($lat1));
0274     #return (rad2milliarcsecond($dtheta) * cos($lat0),
0275     #        rad2milliarcsecond($lat1 - $lat0));
0276 }
0277 
0278 sub hour2rad {
0279     return deg2rad($_[0] * 15.);
0280 }
0281 
0282 sub rad2hour {
0283     return rad2deg($_[0]) / 15.;
0284 }
0285 
0286 sub milliarcsecond2rad {
0287     return deg2rad( $_[0] / ( 60 * 60 * 1000));
0288 }
0289 sub rad2milliarcsecond {
0290     return rad2deg( $_[0]) * ( 60 * 60 * 1000);
0291 }