#!/usr/bin/perl
#
# run a test of the "match" program, and compare its outputs to some
#   known values.  
#
# The test input files were created using one set of points which were
#   transformed in a cubic manner with the following coefficients:
#    
#       x'                       y'
#     a =  0.0                  i =  0.0
#     b =  0.707                j =  0.707
#     c = -0.707                k =  0.707
#     d =  0.00005              l =  0.00005
#     e = -0.00005              m = -0.00005
#     f =  0.00005              n =  0.00005
#     g =  0.0000001            o =  0.0000001
#     h =  0.0000001            p =  0.0000001
#
#   This corresponds roughly to a 45-degree rotation, with a little
#   distortion thrown in.  We check the result of the "match" program
#   to verify that it derives coefficients which are close to these values.
#   
#   Print error messages as we go (if errors occur),
#   and exit with code
#
#        0           if all goes well
#        1           if error(s) occur
#        
# MWR 6/12/2000
# 

# set this to 1 to enable lots of debugging messages
$debug = 0;

# When we're running 'make', the "srcdir" is where the input files 
#   for the self-test live.
# But when we're running the test manually, the input files are
#   in the current directory
$srcdir = $ENV{"srcdir"};
if (length($srcdir) < 1) {
  $srcdir = ".";
}
if ($debug > 0) {
  printf "srcdir is $srcdir\n";
}
$input_a = "$srcdir/selfa.dat";
$input_b = "$srcdir/selfb.dat";

# make sure that the two data files exist
if (!(-r $input_a) || !(-r $input_b)) {
  printf STDERR "can't open input file(s) $input_a and $input_b\n";
  exit(1);
}

# this will be the final exit code -- if 0, all is well.  
#   We increment it every time a test fails
$final_code = 0;

# we're going to run three tests: one each for linear, quadratic,
#    and cubic transformations.  
#    
# first, the linear: we run two tests, for "transonly" and "recalc" options
$teststr = "./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 linear transonly";
$retval = `./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 linear transonly`;
if ($debug > 0) {
  printf "running linear test, transonly.  \n";
  printf "$teststr\n";
  printf "$retval\n";
}
$final_code += check_linear($retval);

$retval = 
  `./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 linear recalc`;
if ($debug > 0) {
  printf "running linear test, recalc  Result is:\n";
  printf "$retval";
}
$final_code += check_linear($retval);


# now, the tests with a quadratic plate solution
$retval = `./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 quadratic transonly`;
if ($debug > 0) {
  printf "running quadratic test, transonly.  Result is:\n";
  printf "$retval";
}
$final_code += check_quadratic($retval);

$retval = `./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 quadratic recalc`;
if ($debug > 0) {
  printf "running quadratic test, recalc  Result is:\n";
  printf "$retval";
}
$final_code += check_quadratic($retval);


# now, the tests with a cubic plate solution
$retval = `./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 cubic transonly`;
if ($debug > 0) {
  printf "running cubic test, transonly.  Result is:\n";
  printf "$retval";
}
$final_code += check_cubic($retval);

$retval = `./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 cubic recalc`;
if ($debug > 0) {
  printf "running cubic test, recalc  Result is:\n";
  printf "$retval";
}
$final_code += check_cubic($retval);


# check the "id1=" and "id2=" options
$retval = `./match $input_a 1 2 3 $input_b 1 2 3 trirad=0.002 nobj=20 linear id1=0 id2=0`; 
if ($debug > 0) {
  printf "running test of id1=, id2= options.  Results is:\n";
  printf "$retval";
}
$final_code += check_id("matched.mtA", "matched.mtB");



# remove some temp files we created during the tests
unlink("matched.mtA");
unlink("matched.mtB");
unlink("matched.unA");
unlink("matched.unB");


if ($final_code == 0) {
  printf "match: passed all tests\n";
} else {
  printf "match: failed some test(s)\n";
}
exit($final_code);



#############################################################################
# PROCEDURE: check_linear
# 
# This procedure examines the output TRANS structure returned by the
#   "match" code for a linear transformation.  We make sure that each
#   of the TRANS coefficients is in the proper range.
#
# The TRANS should have 6 coeffs, and look something like this:
#
#   TRANS: a=0.043661422     b=0.707484673     c=-0.707367056    
#          d=0.077633855     e=0.708066513     f=0.706880146    
#
# Returns:
#   0           if all goes well
#   > 0         if one or more coeffs are outside their proper range
#                    (the value is the number of coeffs which fail test)
#
sub check_linear {
  my($string, 
     @words,
     $a, $b, $c, $d, $e, $f,
     $ret_code);

  $string = $_[0];
  $ret_code = 0;

  @words = split(/\s+/, $string);
  if ($#words != 6) {
    printf STDERR "check_linear: wrong number of words in $string\n";
    return(1);
  }

  $ret_code += check_value($words[1], 0.0,   0.10, "coeff a");
  $ret_code += check_value($words[2], 0.707, 0.02, "coeff b");
  $ret_code += check_value($words[3],-0.707, 0.02, "coeff c");
  $ret_code += check_value($words[4], 0.0,   0.10, "coeff d");
  $ret_code += check_value($words[5], 0.707, 0.02, "coeff e");
  $ret_code += check_value($words[6], 0.707, 0.02, "coeff f");

  return($ret_code);
}


#############################################################################
# PROCEDURE: check_quadratic
# 
# This procedure examines the output TRANS structure returned by the
#   "match" code for a quadratic transformation.  We make sure that each
#   of the TRANS coefficients is in the proper range.
#
# The TRANS should have 12 coeffs, and look something like this:
#
#   TRANS: a=-0.003196734    b=0.706512474     c=-0.706392173    
#          d=0.000033325     e=-0.000078381    f=0.000063959 
#          g=0.033404956     h=0.707162877     i=0.707694690  
#          j=0.000031248     k=-0.000084174    l=0.000056344    
#
# Returns:
#   0           if all goes well
#   > 0         if one or more coeffs are outside their proper range
#                    (the value is the number of coeffs which fail test)
#
sub check_quadratic {
  my($string, 
     @words,
     $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l,
     $ret_code);

  $string = $_[0];
  $ret_code = 0;

  @words = split(/\s+/, $string);
  if ($#words != 12) {
    printf STDERR "check_quadratic: wrong number of words in $string\n";
    return(1);
  }

  $ret_code += check_value($words[1], 0.0,   0.10, "coeff a");
  $ret_code += check_value($words[2], 0.707, 0.02, "coeff b");
  $ret_code += check_value($words[3],-0.707, 0.02, "coeff c");
  $ret_code += check_value($words[4], 0.00005, 0.00010, "coeff d");
  $ret_code += check_value($words[5],-0.00005, 0.00010, "coeff e");
  $ret_code += check_value($words[6], 0.00005, 0.00010, "coeff f");
  $ret_code += check_value($words[7], 0.0,   0.10, "coeff g");
  $ret_code += check_value($words[8], 0.707, 0.02, "coeff h");
  $ret_code += check_value($words[9], 0.707, 0.02, "coeff i");
  $ret_code += check_value($words[10], 0.00005, 0.00010, "coeff j");
  $ret_code += check_value($words[11],-0.00005, 0.00010, "coeff k");
  $ret_code += check_value($words[12], 0.00005, 0.00010, "coeff l");

  return($ret_code);
}


#############################################################################
# PROCEDURE: check_cubic
# 
# This procedure examines the output TRANS structure returned by the
#   "match" code for a cubic transformation.  We make sure that each
#   of the TRANS coefficients is in the proper range.
#
# The TRANS should have 16 coeffs, and look something like this:
#
#   TRANS: a=-0.003196734    b=0.706512474     c=-0.706392173    
#          d=0.000033325     e=-0.000078381    f=0.000063959 
#          g=0.033404956     h=0.707162877     i=0.707694690  
#          j=0.000031248     k=-0.000084174    l=0.000056344    
#
# Returns:
#   0           if all goes well
#   > 0         if one or more coeffs are outside their proper range
#                    (the value is the number of coeffs which fail test)
#
sub check_cubic {
  my($string, 
     @words,
     $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o, $p,
     $ret_code);

  $string = $_[0];
  $ret_code = 0;

  @words = split(/\s+/, $string);
  if ($#words != 16) {
    printf STDERR "check_cubic: wrong number of words in $string\n";
    return(1);
  }

  $ret_code += check_value($words[1], 0.0,   0.10, "coeff a");
  $ret_code += check_value($words[2], 0.707, 0.02, "coeff b");
  $ret_code += check_value($words[3],-0.707, 0.02, "coeff c");
  $ret_code += check_value($words[4], 0.00005, 0.00010, "coeff d");
  $ret_code += check_value($words[5],-0.00005, 0.00010, "coeff e");
  $ret_code += check_value($words[6], 0.00005, 0.00010, "coeff f");
  $ret_code += check_value($words[7], 0.0000001, 0.00001, "coeff g");
  $ret_code += check_value($words[8], 0.0000001, 0.00001, "coeff h");
  $ret_code += check_value($words[9], 0.0,   0.10, "coeff i");
  $ret_code += check_value($words[10], 0.707, 0.02, "coeff j");
  $ret_code += check_value($words[11], 0.707, 0.02, "coeff k");
  $ret_code += check_value($words[12], 0.00005, 0.00010, "coeff l");
  $ret_code += check_value($words[13],-0.00005, 0.00010, "coeff m");
  $ret_code += check_value($words[14], 0.00005, 0.00010, "coeff n");
  $ret_code += check_value($words[15], 0.0000001, 0.00001, "coeff o");
  $ret_code += check_value($words[16], 0.0000001, 0.00001, "coeff p");

  return($ret_code);
}


##############################################################################
# PROCEDURE: check_value
# 
# usage: check_value    value_string correct_value slop name
# 
# This procedure compares the value within "value_string" to "correct_value"; 
# if the two are equal within the "slop"
#
#                correct_value - slop < value < correct_value + slop
#
#   then the function returns 0.  Otherwise, it prints an error message
#   describing the actual and expected values, using the "name" given
#   as the final arg
#
# The "value_string" has a single letter, an equals sign, and then a
#   numerical value, like this:
#    
#             a=0.4342300
#            
#   We need to grab the number from this string as a first step, before
#   we can compare it to the correct value.
#  
# RETURNS
#    0            if all goes well
#    1            if value is outside range (plus prints error message)
#
sub check_value {
  my($value_string, $value, $correct_value, $slop, $name,
     $min, $max);

  $value_string = $_[0];
  $value = $value_string;
  $value =~ s/^[a-z]=//;
  $correct_value = $_[1];
  $slop = $_[2];
  $name = $_[3];

  $min = $correct_value - $slop;
  $max = $correct_value + $slop;

  if (($value < $min) || ($value > $max)) {
    printf STDERR "%s has value %10.6e outside range %10.6e %10.6e\n",
                    $name, $value, $min, $max;
    return(1);
  }

  return(0);
}




#############################################################################
# PROCEDURE: check_id
# 
# This procedure looks at the output files created by a match of 
#   the test data.  Each of the two files in the test data set
#   contains an ID code in column 0.  Matching stars in the two
#   input files have the same ID value, so the corresponding lines
#   in the output files ought to have the same ID values, too.
#
# Returns:
#   0           if all goes well
#   > 0         if one or more IDs in the two output files don't match
#
sub check_id {
  my($output_a, $output_b, 
     @words,
     $nid_a, $nid_b, 
     @id_a, @id_b,
     $ret_code);

  $output_a = $_[0];
  $output_b = $_[1];
  $ret_code = 0;

  # first, make sure that the output files exist
  if (!(-r $input_a) || !(-r $input_b)) {
    printf STDERR "check_id: can't open output file(s) $output_a and $output_b";
    return(1);
  }

  # now, walk through the two output files.  They should have the same
  #   number of lines, and the first word in each line (the ID value)
  #   ought to be the same.
  open(OUTPUT_A, $output_a) || die("check_id: can't open file $output_a");
  open(OUTPUT_B, $output_b) || die("check_id: can't open file $output_b");

  $nid_a = 0;
  while (<OUTPUT_A>) {
    @words = split(/\s+/, $_);
    $id_a[$nid_a] = $words[1];
    $nid_a++;
  }
  close(OUTPUT_A);
    
  $nid_b = 0;
  while (<OUTPUT_B>) {
    @words = split(/\s+/, $_);
    $id_b[$nid_b] = $words[1];
    $nid_b++;
  }
  close(OUTPUT_B);
    
  if ($nid_a != $nid_b) {
    printf STDERR "check_id: output files have different number of lines\n";
    return(1);
  }
  
  for ($i = 0; $i < $nid_a; $i++) {
    if ($debug > 0) {
      printf "  check_id: line %3d  A %6d   B %6d \n", 
                                       $i, $id_a[$i], $id_b[$i];
    }
    if ($id_a[$i] != $id_b[$i]) {
      printf STDERR "check_id: ID mismatch for line $i\n";
      $ret_code++;
    }
  }

  return($ret_code);
}