Re: [MacPerl] Parsing astronomical data in Perl

[Brian McNett <brianmc@telebyte.net>]

>You didn't mention if the records of the ASCII file were fixed length or
>not, but if so, try looking at the Perl function unpack() for ways to
>deal with fixed length data.

No, the records are certainly not fixed length.  I've already had some 
input on this, and the resulting code is a bit more verbose than I'd 
like, but the longest record ends with a 69 character remark field which 
is blank for many records.  In addition, quite frequently the 
cross-references to other catalogs which run from chars 147-181 are also 
blank.  The shortest record then is 147 characters, and the longest 257 
characters.  Happily, the fields I need to perform calculations on ar 
present in every record.  The missing fields come into play during the 
output part of the program, though and have to be dealt with.

# for each line in file
while (defined($line = <IN>)) {
  @line = split //, $line;  # split it to a list of characters
  unshift @line, 0;  # prepend a 0th list element to make indexes line up 

# dig out the fields we need 
  $ident = join '', @line[1..8];   # identifier of star
  $ident =~ s/\s*(.*?)\s*/$1/;
  $comp = join '', @line[9..10];   # number of components
  $comp =~ s/\s*(.*?)\s*/$1/;
  $distrel = $line[11];            # reliability of distance (ref1)
  $RAh = join '', @line[13..14];   # right ascension (hours)
  $RAh =~ s/\s*(.*?)\s*/$1/;
  $RAm = join '', @line[16..17];   # right ascension (minutes)
  $RAm =~ s/\s*(.*?)\s*/$1/;
  $RAs = join '', @line[19..20];   # right ascension (seconds)
  $RAs =~ s/\s*(.*?)\s*/$1/;
  $DEd = join '', @line[22..24];   # declination (degrees + sign)
  $DEd =~ s/\s*(.*?)\s*/$1/;
  $DEm = join '', @line[26..29];   # declination (minutes)
  $DEm =~ s/\s*(.*?)\s*/$1/;
  $pm = join '', @line[31..36];    # proper motion 
  $pm =~ s/\s*(.*?)\s*/$1/;
  $u_pm = join '', $line[37];      # uncertainty flag for pm (boolean)
  $pmPA = join '', @line[38..42];  # direction angle of proper motion
  $pmPA =~ s/\s*(.*?)\s*/$1/;
  $RV = join '', @line[44..49];    # Radial velocity
  $RV =~ s/\s*(.*?)\s*/$1/;
  $n_RV = join '', @line[51..53];  # Remark on radial velocity
  $n_RV =~ s/\s*(.*?)\s*/$1/;
  $Sp = join '', @line[55..66];    # Spectral type
  $Sp =~ s/\s*(.*?)\s*/$1/;
  $r_Sp = join '', $line[67];      # Selected Sources (ref2)
  $V = join '', @line[68..73];     # Apparent Magnitude
  $V =~ s/\s*(.*?)\s*/$1/;
  $n_V = join '', $line[74];       # Note on origin of magnitude (ref3)
  $joint_V = join '', $line[75];   # joint magnitude (should be a 'J')
  $B_V = join '', @line[76..80];   # color
  $B_V =~ s/\s*(.*?)\s*/$1/;
  $n_BV = join '', $line[81];      # Note on origin of magnitude (ref3)
  $joint_BV = join '', $line[82];
  $U_B = join '', @line[83..87];   # color
  $U_B =~ s/\s*(.*?)\s*/$1/;
  $n_UB = join '', $line[88];      # Note on origin of magnitude (ref3)
  $joint_UB = join '', $line[89];  # joint magnitude (should be a 'J')
  $R_I = join '', @line[90..94];   # color
  $R_I =~ s/\s*(.*?)\s*/$1/;       
  $n_RI = join '', $line[95];      # Note on origin of magnitude (ref3)
  $joint_RI = join '', $line[96];  # joint magnitude (should be a 'J')
  $trplx = join '', @line[97..102]; # trigonometric parallax
  $trplx =~ s/\s*(.*?)\s*/$1/;
  $e_trplx = join '', @line[103..107]; #Standard error of trig. parallax
  $e_trplx =~ s/\s*(.*?)\s*/$1/;
  $plx = join '', @line[109..114]; # Resulting parallax
  $plx =~ s/\s*(.*?)\s*/$1/;
  $e_plx  = join '', @line[115..119]; # Standard error of res.  parallax
  $e_plx  =~ s/\s*(.*?)\s*/$1/;
  $n_plx = join '', $line[120];     # [rwsop] Code on plx (ref5)
  $Mv = join '', @line[122..126];   # Absolute visual magnitude
  $Mv =~ s/\s*(.*?)\s*/$1/;
  $n_Mv = join '', @line[127..128]; # Note on Mv, copied from cols 74-75

# and so forth...
# once you get up to where existance of field is not guaranteed,
# check that the line is sufficiently long to have the field
# Actually this test starts around the 147th char.

  if ($#line >= 187) {
    $other = join '', @line[183..187];
    $other =~ s/\s*(.*?)\s*/$1/;
  } else {
# you might give it some default value here...
    $other = "";
  }


# Fungal Parataxonomy                   Mycology Information (Mycoinfo)
# Webmaster, Staff Writer      **The World's First Mycology E-Journal**   
# <mailto:webmaster@mycoinfo.com>            <http://www.mycoinfo.com/> 
# "A couple of guys trying to do something great..."



***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch