#!/usr/bin/perl 

# modified version 24.01.2004 by Thomas Lidy (TL)
# transforms a SOMLIB vector file (which has the filename from which each 
# vector was extracted stored in the last column)
# to an ARFF weka vector file with the CLASS as last column
# based on a ground_truth file that stores filenames and their classes.

# 23.05.2005 (TL): now .arff is always appended to file name instead of replacing extension
# 23.03.2006 (TL): processing header with $-lines with arbitrary # of lines
# 18.11.2008 (TL): in case class contains spaces, put into quotes

# 18.01.2010 (TL): introduced escape function for quoting spaces and escaping ' characters
#		   introduced option to include filename as attribute in .arff files (hardcoded option a.t.m.)

unless (@ARGV==2) { Usage(); }

#print @ARGV . "\n";

$filesep = '/';

unless (-e $ARGV[1]){
    #Usage();
    print "$ARGV[1] does not exist. \n";
    exit 1;
}

$groundtruth = $ARGV[1];
$include_filename = 1;


# 1) read in groundtruth and store in HASH

my %ground = ();
my @classes_gt = ();

open(ING, "$groundtruth");
while (<ING>) 
{
  chomp;
  if ((index($_,',') == -1) & (index($_,"\t") == -1))
  {
	print "\nERROR: No field delimiter , or <TAB> in groundtruth file found!\n\n";
        Usage();
  }
  #($filen,$class) = split(/[\,\t]/, $_);
  # for LMD ignore , in filenames:
  ($filen,$class) = split(/[\t]/, $_);

  # in case class contains spaces, put into quotes
  #if (index($class,' ') > 0) { $class = "'" . $class . "'"; }
  
  #$ground{ $filen } = $class;
  $ground{ $filen } = &escape($class);
  #print "ground: " . $class . "\n";
}

close(ING);

print "GROUNDTRUTH: # of files: " . keys( %ground ) . "\n";

#while ( ($key, $val) = each (%ground) )
#{
#  print "$key *** $val\n";
#}

my @vallist = values(%ground);

undef %saw;
@classes_gt = grep(!$saw{$_}++, @vallist);
@classes_gt = sort(@classes_gt);

print "GROUNDTRUTH: # of classes: " . @classes_gt . "\n";
print "GROUNDTRUTH classes: @classes_gt \n";


# 2) convert input file(s) to ARFF format with classes


#if ( (index($ARGV[0],'*') > -1) || (index($ARGV[0],'?') > -1) )
#{
while ($infile = <$ARGV[0]>)    # globbing for the case of wildcards
{
  
  print "$infile ... ";

if (!(-e $infile))
{
    print "File does not exist. \n";
}
else
{


$outfile = $infile;
$name = $outfile;
$name =~ s/(.*)\.vec$/$1/g;
$outfile = $outfile . ".arff";
#`rm -f $outfile`;


open(OUT, ">" . $outfile);
$out = "";

open(IN, "$infile");


#read header lines starting with $

$line = <IN>; 
chomp($line);

while (substr($line,0,1) eq '$')
{
	@array = split(/ /,$line);
	if ($array[0] eq '$XDIM') { $XDIM = $array[1] };
	if ($array[0] eq '$VEC_DIM') { $VEC_DIM = $array[1] };

	$line = <IN>; 
	chomp($line);
} 

$_ = $line;

$first_run = "true";
%classes = ();
while ($_) 
{
    if ($_ =~ /^\%.*/i){
	print OUT "$_ \n";
    }
    else {
        	@splitArray = split(/\ /, $_, $VEC_DIM+1);
		$filename = pop @splitArray;	# remove filename at the last column of line
		$i = @splitArray;

		if ($first_run eq "true") {
		    print OUT "\@RELATION $name\n\n";
			    for ($z=0; $z < $i; $z++) {
				print OUT "\@ATTRIBUTE term" . $z . "\tREAL\n";
	    			}
          	    if ($include_filename) {
			print OUT "\@ATTRIBUTE SongName\tstring\n";
		    }
		    print OUT "\@ATTRIBUTE class\t{" . join(',',sort(@classes_gt)) . "}\n\n";
		    print OUT "\@DATA\n";
	 	    $first_run = "false";
		}	    

	# determine class of file through groundtruth

	if (exists $ground{$filename})
	{
	  $class = $ground{$filename};
	  $line_out = join(',',@splitArray);
	  print OUT $line_out;
	  if ($include_filename) { 
		  $filenamestr = &escape($filename);
		  print OUT ",$filenamestr";
	  }
	  print OUT ",$class\n";
	}
	else
	{
	  print "ERROR: File $filename is not listed in groundtruth file!\n"
	}
    }

    $_ = <IN>;
    chomp;
    $_ =~ s/^\$(.*)/\% \$$1/g;
}
print "done.\n";
close(IN);
close(OUT);



# replace ---class--- whith all available classes
#foreach $class (sort(keys(%classes))) {
#    $possible_cats = $possible_cats . $class . ",";
#}
#$possible_cats =~ s/(.*),$/{$1}/g;

# `perl -pi -e 's/---class---/$possible_cats/g' $outfile`;		


} # end if file does not exist / else
} # end while (all files)
#} # end if


## subroutines
## -----------

sub escape {
	my($escstring) = @_;
          my $quote = 0;
	  if (index($escstring,"'") > 0) { 
		$quote= 1 ; 
		$escstring =~ s/\'/\\\'/g; 
		#print "escaped: " . index($escstring,"'") . " - $filenamestr\n"; 
		# TODO: investigate why this line is also output for strings NOT containing a '
		# e.g. filename world/world_6-cutty_wren.wav in ISMIRgenre
	  }
	  if (index($escstring,' ') > 0) { $quote = 1; }
          if ($quote) { $escstring = "'" . $escstring . "'"; } 
	return $escstring;
}

sub Usage {
    print "$0 <somlib_vectorfile> <groundtruth_file>\n";
    print "\n";
    print "<somlib_vectorfile> is allowed to contain wildcards (*,?), however\n";
    print "the expression has to be quoted then. Example:\n";
    print "\n";
    print "$0 \"*.vec\" /data/coll/groundtruth.txt\n";
    print "\n";
    print "<groundtruth_file> is a comma-separated file in the format:\n";
    print "<filename>,<class>\n";
    print "\n";
    exit;
}
