bin/create_subsets

   1 #!/usr/local/bin/perl
   2
   3 use FindBin qw($Bin);
   4 use lib "$Bin/../lib";
   5 # Don't edit the line below, it must look exactly like this.
   6 # Everything above this line will be replaced #
   7
   8 use PsN;
   9 use data;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use vars qw/ $opt_help /;
  14 use vars qw/ $opt_idcolumn
  15              $opt_stratify_on
  16              $opt_bins
  17              $opt_debug
  18              $opt_debug_package
  19              $opt_debug_subroutine /;
  20
  21 ## Configure the command line parsing
  22 Getopt::Long::config("auto_abbrev");
  23
  24 ## Declare the options
  25 my $res = GetOptions("help",                 # Display help message
  26                      "idcolumn:i",
  27                      "stratify_on:i",
  28                      "bins:i",
  29                      "debug:0",
  30                      "debug_package:s",
  31                      "debug_subroutine:s" );
  32
  33 exit unless $res;
  34
  35 if($opt_help) {
  36   print <<'ENDHELP';
  37
  38   create_subsets.pl
  39
  40       The create_subsets script creates subsets of the individuals of
  41       a data set.
  42
  43     Usage:
  44
  45       create_subsets.pl
  46       -bins=3
  47       [-idcolumn=column_number]
  48       [-stratify_on=column_number]
  49       datafile
  50
  51     Example:
  52
  53       ./create_subsets.pl -idc=1 -bins=3 -stratify_on=5 datafile
  54
  55 ENDHELP
  56
  57   exit;
  58 }
  59
  60 ## Check that we do have a model file
  61 if ( scalar(@ARGV) < 1 ) {
  62   print "A data file must be specified. Use 'create_subsets -h' for help.\n";
  63   exit;
  64 }
  65
  66 debug -> level( $opt_debug );
  67 debug -> package( $opt_debug_package );
  68 debug -> subroutine( $opt_debug_subroutine );
  69
  70 my $data = data -> new ( filename => $ARGV[0],
  71                          idcolumn => $opt_idcolumn );
  72
  73 my @subsets = @{$data -> subsets( bins => $opt_bins,
  74                                   stratify_on => $opt_stratify_on )};
  75
  76 foreach my $sub ( @subsets ) {
  77   $sub -> _write;
  78 }