lib/model/problem/init_record_subs.pm

   1 # {{{ include statements
   2
   3 start include statements
   4 use model::problem::record::init_option;
   5 end include statements
   6
   7 # }}} include statements
   8
   9 # {{{ restore_inits
  10
  11 start restore_inits
  12       {
  13         if ( defined $self -> options ) {
  14           foreach my $option ( @{$self -> options} ){
  15             $option -> restore_init;
  16           }
  17         }
  18       }
  19 end restore_inits
  20
  21 # }}} restore_inits
  22
  23 # {{{ set_random_inits
  24 start set_random_inits
  25       {
  26         if ( defined $self -> options and not $self -> {'same'} and
  27              not $self -> {'fix'} ) {
  28           foreach my $option ( @{$self -> options} ){
  29             $option -> set_random_init( degree => $degree );
  30           }
  31         }
  32       }
  33 end set_random_inits
  34 # }}} set_random_inits
  35
  36 # {{{ store_inits
  37 start store_inits
  38       {
  39         if ( defined $self -> options ) {
  40           foreach my $option ( @{$self -> options} ){
  41             $option -> store_init;
  42           }
  43         }
  44       }
  45 end store_inits
  46 # }}} store_inits
  47
  48 # {{{ _add_option
  49
  50 start _add_option
  51       {
  52         my $opt_obj =
  53           model::problem::record::init_option ->
  54               new ( option_string => $option_string,
  55                     on_diagonal   => $on_diagonal,
  56                     fix           => $fix );
  57         push( @{$self -> {'options'}}, $opt_obj ) if( $opt_obj );
  58       }
  59 end _add_option
  60
  61 # }}} _add_option
  62
  63 # {{{ _format_record
  64
  65 start _format_record
  66       {
  67         my @class_names = split('::',ref($self));
  68         my $fname = uc(pop(@class_names));
  69         $formatted[0] = "\$".$fname." ";
  70         my $len;
  71
  72         my $otype = $self -> {'type'};
  73         my $same  = $self -> {'same'};
  74         my $fix   = $self -> {'fix'};
  75         my $size  = $self -> {'size'};
  76
  77         if ( defined $otype ) {
  78           $formatted[0] = $formatted[0]." $otype";
  79           if ( defined $size ) {
  80             $formatted[0] = $formatted[0]."($size)";
  81           }
  82           if ( $fix) {
  83             $formatted[0] = $formatted[0]." FIX";
  84           }
  85           if ( $same) {
  86             $formatted[0] = $formatted[0]." SAME\n";
  87           }
  88         }
  89         my $i = 0;
  90         $len = length $formatted[0];
  91         if ( defined $self -> {'options'} ) {
  92           foreach my $option ( @{$self -> {'options'}} ) {
  93             $len = 0 if $i++;
  94             $formatted[0] = $formatted[0].' '.
  95               $option -> _format_option( len => $len)."\n";
  96           }
  97         } else {
  98           $formatted[0] = $formatted[0]."\n";
  99         }
 100
 101         if ( defined $self -> {'comment'} ) {
 102           push( @formatted, @{$self -> {'comment'}} );
 103           $formatted[$#formatted] = $formatted[$#formatted];
 104         }
 105       }
 106 end _format_record
 107
 108 # }}} _format_record
 109
 110 # {{{ _read_options
 111 start _read_options
 112       {
 113         my @inits = ();
 114         my @row   = ();
 115         my @digits = ();
 116         my @fix = ();
 117         my @comments = ();
 118         my ( $any_fixed, $block_fixed ) = ( 0, 0 );
 119         if ( defined $self -> {'record_arr'} ) {
 120           my ( $digit, $comment, $fixed ) = ( undef, undef, 0 );
 121           for ( @{$self -> {'record_arr'}} ) {
 122             chomp;
 123             s/^\s+//;
 124             s/\s+$//;
 125             s/^\s*\$\w+//;
 126             next unless( length($_) > 0 );
 127             if( /^\s*\;/ ) {
 128               # This is a comment row
 129               push( @{$self -> {'comment'}}, $_ . "\n" );
 130             } else {
 131               # Make sure that the labels and units are in one string
 132               s/\;\s+/\;/g;
 133               # Get rid of unwanted spaces
 134 #             s/\s*\,\s*/\,/g;
 135 #             s/\s+FIX/FIX/g;
 136               s/\s*\)/\)/g;
 137               s/\(\s*/\(/g;
 138               $any_fixed++ if /FIX/;
 139               $self -> {'type'} = 'DIAGONAL' if /DIAG\w*/;
 140               $self -> {'type'} = 'BLOCK'    if /BLOCK*/;
 141               $self -> {'size'}  = $2
 142                 if s/^\s*(BLOCK|DIAG\w*)\s*\((\d+)\)\s*//;
 143               $self -> {'same'}  = 1         if s/SAME//;
 144               push ( @inits, $_ );
 145               my ( $line, $line_comment ) = split( ";", $_, 2 );
 146               @row = split( " ",$line );
 147               for ( my $i = 0; $i <= $#row; $i++ ) {
 148                 $_ = $row[$i];
 149                 if ( /\d+/ ) {
 150                   if ( defined $digit ) {
 151                     push( @digits, $digit );
 152                     push( @fix   , $fixed );
 153                     push( @comments, $comment );
 154                   }
 155                   $comment = $i == $#row ? $line_comment : undef;
 156                   $fixed = 0;
 157                   $digit = $_;
 158                 } elsif ( /FIX/ and not $fixed ) {
 159                   $fixed = 1;
 160                 } else {
 161                   die "init_record_subs -> _read_options: Unknown option $_\n";
 162                 }
 163               }
 164             }
 165           }
 166           if ( defined $digit ) {
 167             push( @digits, $digit );
 168             push( @fix   , $fixed );
 169             push( @comments, $comment );
 170           }
 171         }
 172
 173         $block_fixed = 1 if ( $any_fixed and $self -> {'type'} eq 'BLOCK' );
 174         $self -> {'fix'} = $block_fixed;
 175
 176         my $row = 1;
 177         my $on_diag;
 178         for ( my $i = 0; $i <= $#digits; $i++ ) {
 179           if ( $self -> {'type'} eq 'BLOCK' ) {
 180             if ( $i+1 == $row*($row+1)/2 ) {
 181               $on_diag = 1;
 182               $row++;
 183             } else {
 184               $on_diag = 0;
 185             }
 186           } else {
 187             $on_diag = 1;
 188           }
 189
 190           $fix[$i] = 0 if ( $block_fixed );
 191           my $com_str = defined $comments[$i] ? ';'.$comments[$i] : '';
 192           $self -> _add_option( option_string => $digits[$i].$com_str,
 193                                 fix           => $fix[$i],
 194                                 on_diagonal   => $on_diag );
 195         }
 196
 197 #       if ( defined $self -> {'record_arr'} ) {
 198 #         for ( @{$self -> {'record_arr'}} ) {
 199 #       for ( @inits ) {
 200 #         next unless( length($_) > 0 );
 201 #         # Split inits and labels/units
 202 #         my ( $line, $comment ) = split( ";", $_, 2 );
 203 #         # Split the init string to see if we have more than one init.
 204 #         @row = split( " ",$line );
 205 #         if ( $#row <=0 ) {
 206 #           # If we only have one init, send the whole row to option
 207 #           $self -> _add_option( option_string => $_ );
 208 #           print "LINE: $_\n";
 209 #           print "adding one init\n";
 210 #           # if ( $self -> {'debug'} );
 211 #         } else {
 212 #           # If we have more than one init, send one init at a time to option
 213 #           print "LINE: $_\n";
 214 #           print "adding ",$#row+1," inits\n";
 215 #           # if ( $self -> {'debug'} );
 216 #           for ( @row ) {
 217 #             $self -> _add_option( option_string => $_ );
 218 #           }
 219 #         }
 220 #       }
 221       }
 222 end _read_options
 223 # }}} _read_options
 224