bin/create_cont_model

   1 #!/usr/local/bin/perl
   2
   3 use FindBin qw($Bin);
   4 use lib "$Bin/../lib";
   5
   6 # Don't edit the line below, it must look exactly like this.
   7 # Everything above this line will be replaced #
   8
   9 use PsN;
  10 use data;
  11 use model;
  12 use strict;
  13 use Data::Dumper;
  14
  15 use Getopt::Long;
  16 use vars qw/ $opt_help
  17              $opt_h
  18              $opt_cont_column
  19              $opt_wrap_column
  20              $opt_new_model
  21              $opt_new_data
  22              $opt_debug
  23              $opt_debug_package
  24              $opt_debug_subroutine /;
  25
  26 ## Configure the command line parsing
  27 Getopt::Long::config("auto_abbrev");
  28
  29 ## Declare the options
  30 my $res = GetOptions("help",                 # Display help message
  31                      "h|?",
  32                      "idcolumn:i",
  33                      "cont_column:i",
  34                      "wrap_column:i",
  35                      "new_model:s",
  36                      "new_data:s",
  37                      "directory:s",
  38                      "debug:0",
  39                      "debug_package:s",
  40                      "debug_subroutine:s" );
  41
  42 exit unless $res;
  43
  44 if($opt_help or $opt_h) {
  45   print <<'ENDHELP';
  46
  47   create_cont_model
  48
  49       create_cont_model is a perl script that wraps the rows in a data
  50       set with more than 20 columns. Rows that do not end up at
  51       exactly 20 will be padded with dummy columns.
  52
  53     Usage:
  54
  55       create_cont_model filename
  56       [-cont_column=column_number]
  57       [-wrap_column=column_number]
  58       [-new_model=new_filename]
  59       [-new_data=new_filename]
  60
  61     Example:
  62
  63       ./create_cont_model -idc=1 -new_model=new_wrapped.mod old.mod
  64
  65       ./create_cont_model -idc=1 -new_model=new_wrapped.mod -new_data=new_wrapped.dta old.mod
  66
  67     Options:
  68
  69       -cont_column
  70         The number of the column where the CONT data itemn should be
  71         placed. The default is to put it as the last item in each row.
  72
  73       -wrap_column
  74         The number of the columns in each row. The default is 20.
  75
  76       -new_model
  77         The name of the new model file.
  78
  79       -new_data
  80         The name of the new data set.
  81
  82 ENDHELP
  83
  84   exit;
  85 }
  86
  87 ## Check that we do have a model file
  88 if ( scalar(@ARGV) < 1 ) {
  89   print "A model file must be specified. Use 'create_cont_model -h' for help.\n";
  90   exit;
  91 }
  92
  93 if ( not defined $opt_new_model ) {
  94   print "The name of the new model file must be specified using -new_model.\n".
  95     "Use 'create_cont_model -h' for help.\n";
  96   exit;
  97 }
  98
  99 if ( not defined $opt_new_data ) {
 100   print "The name of the new data file must be specified using -new_data.\n".
 101     "Use 'create_cont_model -h' for help.\n";
 102   exit;
 103 }
 104
 105 #ui -> category( 'model' );
 106
 107 debug -> level( $opt_debug );
 108 debug -> package( $opt_debug_package );
 109 debug -> subroutine( $opt_debug_subroutine );
 110
 111 my $mod = model -> new ( filename => $ARGV[0] );
 112 my $new_mod = $mod -> copy( copy_data       => 1,
 113                             data_file_names => [$opt_new_data],
 114                             filename        => $opt_new_model );
 115
 116 $new_mod -> drop_dropped();
 117
 118 $new_mod -> wrap_data( cont_column => $opt_cont_column,
 119                        wrap_column => $opt_wrap_column );
 120
 121 $new_mod -> _write( write_data => 1 );
 122
 123 #my $new_mod = $mod -> copy( copy_data       => 1,
 124 #                           data_file_names => [$opt_new_data],
 125 #                           filename        => $opt_new_model );
 126
 127 #$new_mod -> wrap_data( cont_column => $opt_cont_column,
 128 #                      wrap_column => $opt_wrap_column );
 129
 130 #$new_mod -> _write( write_data => 1 );
 131 #$new_mod -> {'data'}[0] -> _write;
 132
 133 # my @model_header = @{$mod -> problems -> [0] -> header};
 134 # my @datafiles = @{$mod -> datafiles};
 135
 136 # # my $data = data -> new ( filename     => $datafiles[0],
 137 # #                      model_header => \@model_header,
 138 # #                      idcolumn     => $mod -> idcolumns -> [0],
 139 # #                      ignoresign   => $mod -> ignoresigns -> [0] );
 140 # my $data = $mod -> datas -> [0];
 141 # $data -> model_header( \@model_header );
 142
 143 # open( NEWDATA, ">$opt_new_data" );
 144 # my ($data_ref, $prim_ref, $sec_ref ) = $data ->
 145 #   format_data( wrap         => 1,
 146 #              cont_column  => $opt_cont_column,
 147 #              wrap_column  => $opt_wrap_column );
 148 # print NEWDATA @{$data_ref};
 149 # close( NEWDATA );
 150
 151 # $mod -> problems -> [0] -> primary_columns( $prim_ref );
 152 # $mod -> problems -> [0] -> secondary_columns( $sec_ref );
 153 # $mod -> datafiles( new_names => [$opt_new_data] );
 154 # $mod -> filename( $opt_new_model );
 155 # $mod -> _write;