Index: trunk/tools/roc.exposure
===================================================================
--- trunk/tools/roc.exposure	(revision 30592)
+++ trunk/tools/roc.exposure	(revision 30592)
@@ -0,0 +1,315 @@
+#!/usr/bin/env perl
+
+# USAGE
+if (@ARGV != 2) { die "USAGE: roc.exposure (subdir) (expname)\n" ; }
+
+$dbname = "gpc1";
+$subdir = $ARGV[0];
+$expname = $ARGV[1];
+$savelists = 0;
+$loadlists = 0;
+
+@rochost = ("ipp005", "ipp006", "ipp007", "ipp040", "ipp045");
+
+if ($loadlists) {
+    &load_from_file();
+} else {
+    &load_from_nebulous();
+}
+
+# we have 60 unique chips; attempt to make 6 groups of 10 chips
+$Ntotal = @chiplist;
+$Nalloc = 0;
+for (my $j = 0; $j < 6; $j++) {
+    $Npass = mkgroup($j, 10);
+    $Nalloc += $Npass;
+}
+
+print "$expname : $Nalloc of $Ntotal (first pass)\n";
+
+# re-attempt to add any missed chips to the groups
+if ($Nalloc < @chiplist) {
+    for (my $i = 0; $i < @chiplist; $i++) {
+	my $thischip = $chiplist[$i];
+	if ($chipused[$thischip]) { next; }
+	$status = 0;
+	for (my $j = 0; ($status == 0) && ($j < 6); $$j ++) {
+	    $status = &ckchip ($thischip, $j);
+	}
+    }
+
+    # re-check the totals
+    $Nalloc = 0;
+    for (my $j = 0; $j < 6; $j++) {
+	$Nalloc += $Nchip[$j];
+    }
+    print "$expname : $Nalloc of $Ntotal (second pass)\n";
+    
+    if ($Nalloc < @chiplist) {
+	die "unable to assign all files for $expname, skipping\n";
+    }
+}
+
+for (my $j = 0; $j < 6; $j++) {
+    &mkroc($j);
+}
+
+for (my $i = 0; $i < @cullURIs; $i++) {
+    $command = "neb-cull $cullURIs[$i] --volume $cullHosts[$i]";
+    my $status = vsystem ($command);
+    if ($status) { die "failed to neb-cull with $command\n"; }
+}
+
+vsystem ("regtool -dbname $dbname -updatebyquery -set_state roc -exp_name $expname");
+
+exit 0;
+
+# query database for imfiles, query nebulous for instances, generate:
+# %chiphost - hash array of all instance hosts (key = chipID.seq)
+# %chipfile - hash array of all instance files (key = chipID.seq)
+# @chiplist - array of all unique chips
+# %chipused - hash array noting if chip has already been used (key = chipID)
+sub load_from_nebulous {
+
+    %chipused = ();
+    @chiplist = ();
+    %chiphost = ();
+    %chipfile = ();
+
+    @reglist = `regtool -dbname $dbname -processedimfile -exp_name $expname | grep uri`;
+    if ($?) { die "failed to get uri list from regtool\n"; }
+
+    foreach $line (@reglist) {
+
+	($tmp1, $tmp2, $uri) = split (" ", $line);
+
+	# get the chip id
+	($chipID) = $uri =~ m|ota(\d\d).fits|;
+	if (!$chipID) { die "failed to get chip ID for $uri\n"; }
+
+	# printf "uri: $uri, chipID: %s\n", $chipID;
+
+	push @chiplist, $chipID;
+	$chipused{$chipID} = 0;
+	$urilist{$chipID} = $uri;
+
+	@imfiles = `neb-locate --all --path $uri`;
+
+	for ($seq = 0; $seq < @imfiles; $seq ++) {
+	    $imfile = $imfiles[$seq];
+	    chomp $imfile;
+
+	    ($hostID) = $imfile =~ m|/data/(ipp\d\d\d).0/nebulous/|;
+
+	    # printf "chipID: $chipID, hostID: $hostID\n";
+
+	    # push @hostIDs, $hostID;
+	    # push @chipIDs, $chipID;
+	    # push @fileIDs, $imfile;
+
+	    $thischip = "$chipID.$seq";
+	    $chiphost{$thischip} = $hostID;
+	    $chipfile{$thischip} = $imfile;
+	}	
+    }
+
+    # (optionally) save the results
+    if ($savelists) {
+	open (FILE, ">chiplist.dat");
+	for (my $i = 0; $i < @chiplist; $i++) {
+	    $chipID = $chiplist[$i];
+	    print FILE "$urilist{$chipID} $chiplist[$i]\n";
+	}
+	close (FILE);
+
+	@keys = keys %chiphost;
+	open (FILE, ">chiphost.dat");
+	foreach $key (@keys) {
+	    printf FILE "$key %s %s\n", $chiphost{$key}, $chipfile{$key};
+	}
+	close (FILE);
+    }
+}
+
+# load data from a file (for testing)
+# %chiphost - hash array of all instance hosts (key = chipID.seq)
+# %chipfile - hash array of all instance files (key = chipID.seq)
+# @chiplist - array of all unique chips
+# %chipused - hash array noting if chip has already been used (key = chipID)
+sub load_from_file {
+
+    %chipused = ();
+    @chiplist = ();
+    %chiphost = ();
+    %chipfile = ();
+
+    # (optionally) save the results
+    open (FILE, "chiplist.dat");
+    @lines = <FILE>;
+    close (FILE);
+    foreach $line (@lines) {
+	($uri, $chipID) = split (" ", $line);
+
+	push @chiplist, $chipID;
+	$urilist{$chipID} = $uri;
+	$chipused{$chipID} = 0;
+    }
+
+
+    open (FILE, "chiphost.dat");
+    @lines = <FILE>;
+    close (FILE);
+
+    foreach $line (@lines) {
+	($key, $hostID, $file) = split (" ", $line);
+	$chiphost{$key} = $hostID;
+	$chipfile{$key} = $file;
+	$chipkeep{$key} = 0;
+    }
+
+    foreach $chipID (@chiplist) {
+	# print "chipID: $chipID\n";
+    }
+
+    @keys = keys %chiphost;
+    foreach $key (@keys) {
+	# printf "$key %s %s\n", $chiphost{$key}, $chipfile{$key};
+    }
+}
+
+# select 10 chipIDs that (a) have not already been used and (b) are on a host that is not
+# yet used for this group
+sub mkgroup {
+
+    my $group = $_[0];
+    my $Nmax = $_[1];
+    my $N = 0; 
+    my($i, $status);
+
+    $Nchip[$group] = 0;
+
+    for ($i = 0; ($N < $Nmax) && ($i < @chiplist); $i++) {
+	my $thischip = $chiplist[$i];
+	if ($chipused[$thischip]) { next; }
+	$status = &ckchip($thischip, $group);
+	if ($status) {
+	    $chipused[$thischip] = 1;
+	    $N ++;
+	}
+    }
+    return $N;
+}
+
+sub ckchip {
+
+    my($chipID) = $_[0];
+    my($group) = $_[1];
+
+    $seq = 0; 
+    while (1) {
+
+	# does this chip entry exist?
+	my $thischip = "$chipID.$seq";
+	my $thisfile = $chipfile{$thischip};
+	# print "thischip $thischip, thisfile: $thisfile\n";
+	if ("$thisfile" eq "") {
+	    return 0;
+	}
+
+	$thishost = $chiphost{$thischip};
+	# print "thishost $thishost\n";
+	if ($host[$group]{$thishost} == 0) {
+	    # use this host:
+	    $host[$group]{$thishost} = 1;
+	    $N = $Nchip[$group];
+
+	    # note the entries we are keeping
+	    $chipkeep{$thischip} = 1;
+
+	    $file[$group][$N] = $thisfile;
+	    $chip[$group][$N] = $chipID;
+	    $Nchip[$group] ++;
+	    
+	    # print "$group, $chip[$group][$N], $file[$group][$N]\n";
+
+	    &mkcull($chipID, $seq);
+
+	    return 1;
+	}
+	$seq ++;
+    }
+}
+
+sub mkroc {
+
+    my $group = $_[0];
+
+    $inlist = "";
+
+    $N = $Nchip[$group];
+
+    # choose an acceptable outhost
+    $skiphost = 1;
+    $usehost = "";
+    for (my $j = 0; $skiphost && ($j < @rochost); $j++) {
+	if ($host[$group]{$rochost[$j]} == 0) {
+	    $skiphost = 0;
+	    $usehost = $rochost[$j];
+	}
+    }
+    if ($skiphost) {
+	die "no valid ROC host for group $group\n";
+    }
+
+    # generate the system command to create the roc file for this group:
+    for (my $i = 0; $i < $N; $i ++) {
+	$inlist = "$inlist $file[$group][$i]";
+    }
+
+    $outdir = "/data/$usehost.0/roc/$subdir";
+    if (! -d $outdir) {
+	mkdir $outdir;
+    }
+    $command = "roc -create $outdir/$expname.$group.roc $inlist";
+
+    my $status = vsystem ($command);
+    if ($status) { die "failed to create roc file with $command\n"; }
+	
+    open (ROCFILE, ">>rocfile.$usehost.txt");
+    print ROCFILE "$command\n";
+    close (ROCFILE);
+}
+
+sub mkcull {
+
+    my($chipID) = $_[0];
+    my($seqKeep) = $_[1];
+
+    # find the instances which need to be culled:
+    my $seq = 0;
+    while (1) {
+	if ($seq == $seqKeep) { $seq ++; next; }
+
+	my $thischip = "$chipID.$seq";
+	my $thisfile = $chipfile{$thischip};
+
+	if ("$thisfile" eq "") {
+	    return 1;
+	}
+
+	my $thishost = $chiphost{$thischip};
+	my $thisuri = $urilist{$chipID};
+
+	push @cullURIs, $thisuri;
+	push @cullHosts, $thishost;
+	$seq ++;
+    }
+    return 1;
+}
+
+sub vsystem {
+    print STDERR "@_\n";
+    my $status = system ("@_");
+    return $status;
+    # return 0;
+}