subroutines for close to half

[Aldebaran]

Hello Monks, may the peace of computing be with you,

I'm looking for some new syntax for a script that calculates conjunctions based on the ephemera as provided by the good people at fourmilab. As it is now, I find myself making static calls to a median function which causes execution to follow the same course every time. This is boring the heck out of me and does not allow me to see how things run under slightly-differing scenarios.

What follows are the call and subroutine.

  my $guess = median( $upper, $lower );
  say "guess is $guess";
  sub median {
  my ( $up, $low ) = @_;
  my $return = ( $up + $low ) / 2.0;
  return $return;
}

I seek to re-write these as being "close to half" as opposed to half.

I've seen treatments of perl that generate domains using ellipses, but I seek one on the reals. These are represented in perl logic by floats.

The first routine I would like to define is one that returns a float on a uniform interval between .4 and .6, generated stochastically. The other one I seek is a similar such with a normal distribution.

Thank you for your comment,

[Anonymous Monk]

sub closetohalf
  {
  my ($up, $low) = @_;
  $low + ($up - $low) * (0.4 + rand 0.2);
  }

[Aldebaran]

Thanks, AM, I've got results, and having a stochastic means of taking guesses has been a key in making it as robust as it is.

#! /usr/bin/perl
use warnings;
use strict;
use 5.010;
use WWW::Mechanize::GZip;
use HTML::TableExtract qw(tree);
use open ':std', OUT => ':utf8';
use Prompt::Timeout;
use constant TIMEOUT  => 3;
use constant MAXTRIES => 30;

my $site = 'http://www.fourmilab.ch/yoursky/cities.html';
my $mech = 'WWW::Mechanize::GZip'->new;
$mech->get($site);
$mech->follow_link( text => 'Portland OR' );
my $before_bound = 2457496.65;    #before conjunction
my $after_bound  = 2457496.75;    #after conjunction
$mech->set_fields(qw'date 2');
my $moonstring = 5;
my $jstr       = 3;
my $upper      = $before_bound;
my $lower      = $after_bound;
my $equal;
my $equal_sec;
my $now_string = localtime;
my $filename   = 'planet7.txt';
open( my $jh, '>>', $filename ) or die "Could not open file '$filename
+' $!";
say $jh "Script executed at $now_string";
my $attempts = 1;

while ( ( $jstr != $moonstring ) ) {

   my $default = ( ( $attempts >= MAXTRIES ) ) ? 'N' : 'Y';
   my $answer = prompt( "Make query number $attempts?", $default, TIME
+OUT );
   exit if $answer =~ /^N/i;
   say "upper is $upper";
   say "lower is $lower";
   my $guess = closetohalf( $upper, $lower );
   say "guess is $guess";
   $mech->set_fields( jd => $guess );
   $mech->click_button( value => "Update" );
   my $te = 'HTML::TableExtract'->new;
   $te->parse( $mech->content );
   my $table      = ( $te->tables )[3];
   my $table_tree = $table->tree;
   my $venus      = $table_tree->cell( 5, 1 )->as_text;
   my $jupiter    = $table_tree->cell( 7, 1 )->as_text;
   $moonstring = string_to_second($venus);
   say "moon seconds is $moonstring";
   $jstr = string_to_second($jupiter);
   say "jupiter seconds is $jstr";

   if ( $jstr > $moonstring ) {
      $upper = $guess;
   }
   elsif ( $moonstring > $jstr ) {
      $lower = $guess;
   }
   else {
      $equal = $guess;
      say "equal, while condition should fail $equal";
      $equal_sec = $moonstring;
   }
   $te->delete;
   $attempts++;
}

say $jh "equal seconds is $equal_sec";

###redesign 4/20/16
## determining beginning
my $outer = $before_bound;
my $inner = $equal;
say $jh join "\t", 'moonstring', 'jstr', 'outer', 'inner', 'guess';
$attempts = 1;
while ( ( abs( $outer - $inner ) > .00001 ) ) {

   my $default = ( ( $attempts >= MAXTRIES ) ) ? 'N' : 'Y';
   my $answer = prompt( "Make query number $attempts?", $default, TIME
+OUT );
   exit if $answer =~ /^N/i;
   say "outer is $outer";
   say "inner is $inner";
   my $guess = closetohalf( $outer, $inner );
   say "guess is $guess";
   $mech->set_fields( jd => $guess );
   $mech->click_button( value => "Update" );
   my $te = 'HTML::TableExtract'->new;
   $te->parse( $mech->content );
   my $table      = ( $te->tables )[3];
   my $table_tree = $table->tree;
   my $venus      = $table_tree->cell( 5, 1 )->as_text;
   my $jupiter    = $table_tree->cell( 7, 1 )->as_text;
   $moonstring = string_to_second($venus);
   $jstr       = string_to_second($jupiter);
   say $jh join "\t", $moonstring, $jstr, $outer, $inner, $guess;

   if ( $moonstring < $jstr ) {
      $outer = $guess;
   }
   elsif ( $moonstring == $jstr ) {
      $inner = $guess;
   }
   else {
      die "retrograde motion or bad data";
   }
   $te->delete;
   $attempts++;
}
say $jh "after beginning contraction, upper is $outer";
say $jh "after beginning contraction, lower is $inner";
my $begin_time = $inner;

## determine end time
$outer = $after_bound;
$inner = $equal;
say $jh join "\t", 'moonstring', 'jstr', 'outer', 'inner', 'guess';
$attempts = 1;
while ( ( abs( $outer - $inner ) > .00001 ) ) {

   my $default = ( ( $attempts >= MAXTRIES ) ) ? 'N' : 'Y';
   my $answer = prompt( "Make query number $attempts?", $default, TIME
+OUT );
   exit if $answer =~ /^N/i;
   say "outer is $outer";
   say "inner is $inner";
   my $guess = closetohalf( $outer, $inner );
   say "guess is $guess";
   $mech->set_fields( jd => $guess );
   $mech->click_button( value => "Update" );
   my $te = 'HTML::TableExtract'->new;
   $te->parse( $mech->content );
   my $table      = ( $te->tables )[3];
   my $table_tree = $table->tree;
   my $venus      = $table_tree->cell( 5, 1 )->as_text;
   my $jupiter    = $table_tree->cell( 7, 1 )->as_text;
   $moonstring = string_to_second($venus);
   $jstr       = string_to_second($jupiter);
   say $jh join "\t", $moonstring, $jstr, $outer, $inner, $guess;
   if ( $moonstring > $jstr ) {
      $outer = $guess;
   }
   elsif ( $moonstring == $jstr ) {
      $inner = $guess;
   }
   else {
      die "retrograde motion or bad data";
   }
   $te->delete;
   $attempts++;
}

say $jh "after ending contraction, outer is $outer";
say $jh "after ending contraction, inner is $inner";
my $end_time      = $inner;
my $jul_length    = $end_time - $begin_time;
my $second_length = $jul_length * 86400;
say "duration in seconds is $second_length";
say $jh "duration in seconds is $second_length";

sub string_to_second {
   my $string = shift;
   my $return = 9000;
   if ( my $success = $string =~ /^(\d*)h\s+(\d*)m\s+(\d*)s$/ ) {
      $return = 3600 * $1 + 60 * $2 + $3;
   }
   else {
      say "string was misformed";
   }
   return $return;
}

sub closetohalf {
   my ( $up, $low ) = @_;
   $low + ( $up - $low ) * ( 0.4 + rand 0.2 );
}

Output:

Script executed at Sun Apr 24 16:40:08 2016
equal seconds is 39783
moonstring    jstr    outer    inner    guess
39726    39783    2457496.65    2457496.69915925    2457496.67869833
39753    39783    2457496.67869833    2457496.69915925    2457496.6885
+3017
39769    39783    2457496.68853017    2457496.69915925    2457496.6942
+0768
39777    39783    2457496.69420768    2457496.69915925    2457496.6971
+6155
39780    39783    2457496.69716155    2457496.69915925    2457496.6981
+1072
39781    39783    2457496.69811072    2457496.69915925    2457496.6986
+7181
39782    39783    2457496.69867181    2457496.69915925    2457496.6989
+1007
39782    39783    2457496.69891007    2457496.69915925    2457496.6990
+2581
39783    39783    2457496.69902581    2457496.69915925    2457496.6990
+8113
39782    39783    2457496.69902581    2457496.69908113    2457496.6990
+5188
39783    39783    2457496.69905188    2457496.69908113    2457496.6990
+6548
39782    39783    2457496.69905188    2457496.69906548    2457496.6990
+5783
after beginning contraction, upper is 2457496.69905783
after beginning contraction, lower is 2457496.69906548
moonstring    jstr    outer    inner    guess
39864    39783    2457496.75    2457496.69915925    2457496.72857204
39818    39783    2457496.72857204    2457496.69915925    2457496.7117
+5627
39800    39783    2457496.71175627    2457496.69915925    2457496.7055
+5956
39792    39783    2457496.70555956    2457496.69915925    2457496.7023
+8023
39788    39783    2457496.70238023    2457496.69915925    2457496.7009
+2664
39785    39783    2457496.70092664    2457496.69915925    2457496.6998
+935
39784    39783    2457496.6998935    2457496.69915925    2457496.69946
+611
39783    39783    2457496.69946611    2457496.69915925    2457496.6993
+0239
39783    39783    2457496.69946611    2457496.69930239    2457496.6993
+7787
39783    39783    2457496.69946611    2457496.69937787    2457496.6994
+1601
39784    39783    2457496.69946611    2457496.69941601    2457496.6994
+3739
39784    39783    2457496.69943739    2457496.69941601    2457496.6994
+2669
39783    39783    2457496.69942669    2457496.69941601    2457496.6994
+21
after ending contraction, outer is 2457496.69942669
after ending contraction, inner is 2457496.699421
duration in seconds is 30.7171538472176

Does the ultimate result seem plausible? I think I have a geometric justification for why this should be close to the number of days in a month. (Jupiter's position in seconds remains unchanged during the event.)

Beyond whether this makes any sense physically is how it looks and works as perl, and I'm accepting any criticisms along those lines. Thank you, and happy skywatching....

[Anonymous Monk]

sub closetonormal
  {
  my($up, $low) = @_;
  my $normal = 0;
  $normal += rand for 1..12; # from Wikipedia
  $low + ($up - $low) * $normal / 12;
  }