rndmpick.pl

This program was designed to replace the Tennessee Random Selection/Reporting program written 6 years ago in C/Oracle on a VAX. Because they needed to get a new list right away, but had moved to NT and were going to install a new database schema in a couple months, they decided they could live with just getting a list of randomly selected hered and processing them by hand.

source code | SQL Code

Requirements

To randomly select a specified percentage of herds from the database.

Key constraints:

Need to be able to select just certain types of herds (based on species and excluding specific ones based on entries in user_code_fields)
Must select herds from each county. I know this violates randomness.

main select ORDERs BY county code
randompick program selects one out whatever (1 out 5 for 25% in this sample). To maintain randomness, I change the index I select (1,2,3,4 or 5) for each group of 5.

Process

Run a SQL statement spooling all the info you want for each herd to a flat file.
Run the flatfile through the rndmpick.pl program.

Source Code Notes

Open files for reading or writing (using lessthan, greaterthan signs)
while <more lines in file> process each line
perform modulus operation (%) on current index
if $mod indicates you've got a new group of 5 (or $limit)

after that, if the current index is selected, print line to the output file

rndmpick.pl Source Code

#!/usr/local/bin/perl 

##############################
# rndmpick.pl by Mike Moxcey
#               for TN PRV random selection study
#       Takes input list of herdinfo (one line/record)
#               in county order (sql select)
#       And outputs file of 1 out $limit
#               such as 1 out of 5 or one out of 10
#####################################################
$infile = "totlelig.lst"; #input file name
$outfile= "rndmprem.lst"; #output file name

$limit=5;       # choose 1 out of LIMIT
                # here it is one out of 5 ==>$limit=5

# srand(1999);  #SeedRandom generator with same number for same results
                # else is autoseeded with time each time pgm runs

open (INFILE, "< $infile") || print "Error opening $infile file";
open (OUTFILE, "> $outfile") || print "Error opening $outfile file";
$ctr=0;

while () {
  $currline=$_;
  $ctr++;
  $mod= ($ctr%$limit);  # =1,2,3 ... $limit-1, 0
  if ($mod == 1) {      # if new group of limiting nrs
                        # i.e. if $limit=5, then if 1,6,11,16....
    $rndmpick=int(rand $limit); #  then choose new random selector
  }                             # between 0 and $limit-1
  if ($mod==$rndmpick ) {
#    print (OUTFILE "ctr=$ctr currline=$currline");
    print (OUTFILE "$currline");
  }
}
close (INFILE); 
close (OUTFILE); 

# &test; # call to a test routine.  Currently commented out

# End of rndmpick.pl  Following are subroutines

##########################################################
# here is a test
# it shows modulus goes 1,2,3,4,0 for each group of 5
#       (would change if $limit changes)
##########################################################
sub test {

for ($i=1;$i<21;$i++) {
  $mod= ($i%$limit);
  if ($mod == 1) {      # if new group of limiting nrs
                        # i.e. if $limit=5, then if 1,6,11,16....
    $r=int(rand $limit);        #  then choose new random selector
  }
  print "ctr=$i. Random =$r. Limit=$limit. Modu=$mod ";

  if ($mod==$r) {
    print "This is the selection \n"
  }
  else { print "\n";}
}

} #end test subroutine

SQL Code

set pause off pagesize 0 linesize 400
spool totlelig.lst

SELECT p.prem_id, prem_name, p.prem_state, p.county, 
prem_address, prem_city, lname, fname, address, city, p.state, 
zip_code, phone, pr_remark, sp.type_op, c.co_name, max(coll_date)  
FROM cds.premises p,cds.prem_species sp, cds.county c, 
prms.test_summary sum 
WHERE sp.prem_id = p.prem_id and p.prem_id = sum.prem_id(+) 
  and p.prem_state = c.state and p.county = c.county 
  and (sp.sp_user_code_1 not like 'OOB%' 
    or sp.sp_user_code_1 is null) 
  and species = 'POR' 
  and p.prem_state = ( select lk_desc from cds.lookup 
                       where lk_type = 'STE' 
                       and lk_code = 'STCODE') 
GROUP BY p.prem_id, prem_name, p.prem_state, p.county, 
prem_address, prem_city, lname, fname, address, city, p.state, 
zip_code, phone, pr_remark, sp.type_op, c.co_name 
ORDER BY p.county, prem_name; 

spool off
exit

Mike Moxcey Feb 1999