#!/usr/bin/perl -w
use strict;

# transpose_for_qdf.pl
# Utility script written to bypass the Excel 255-column limitation in preparing
# data. The idea is to prepare the data in transposed format and then use this
# script to transpose it.
# Invoked with the name of a text file, this program transposes it by treating a tab character
# as a separator that forces placement of the words into different
# rows of the output file. Thus a line such as
# XX	3.0	#$#*	-2e9
# will be turned into a column
# XX
# 3.0
# #$#*
# -2e9
# Empty cells will be transposed properly.
# The transposed data will be written to a new file with suffix x.txt
# Clare Nelson, KSU Plant Path, 12.21.06
# NOTE that it will NOT work right with tab-separated fields containing spaces. Don't
# allow any spaces except as separators.

my $sXposed_insert = "_x";
my $sUsageMsg = "Usage: perl $0
<input datafile name>";

if (@ARGV < 1) { die $sUsageMsg;}
my ($infile) = @ARGV;
my $outfile = decorate_name($infile, $sXposed_insert);
my $input_2D_ref = file_to_2D_arr($infile);
transpose_array_2D_to_file($input_2D_ref, $outfile);

## SUBROUTINES ##

sub decorate_name # inserts a substring before the file suffix
{
  my ($name, $insert) = @_;
  my $pos = rindex($name, '.'); # find first "." from right end
  if ($pos > 0)
  { my $prefix = substr($name, 0, $pos);
    my $suffix = substr($name, $pos);
    return $prefix . $insert . $suffix;
  }
  else {return $name . $insert;}
}

# loads a file with whitespace-separated lines into an array of references to arrays.
# Lines need not have the same numbers of words.
# CN changed to split on single whitespace, 11.2.09
sub file_to_2D_arr
{
  my $infile = shift;
  
  my @arr_2D;
  my $count = 0;

  open (INFILE, $infile) || die "Cannot open \"$infile\" : $!";
  while (my $line = <INFILE>)
  { my @temp_arr = split(/\s/, $line);
     $arr_2D[$count++] = \@temp_arr;
  }
  close INFILE;
  return \@arr_2D;
}

# Writes a 2D array to a string in transposed form. Doesn't assume all subarrays are of same length.
# Added precision and missing symbol CN 2.27.10
sub transpose_array_2D_to_text
{
	my ($arr_2D_ref, $precision, $missing_symbol) = @_;
 	if (defined($precision))
  { $precision = "\%\." . $precision . "f";}
 	if (!defined($missing_symbol))
  { $missing_symbol = "";}
 	my ($printval, $text);
  my $max_row_len = find_max_row_len($arr_2D_ref);
  for (my $col = 0; $col < $max_row_len; $col++)
  {
    foreach my $row_arr_ref(@$arr_2D_ref)
    {
      my $val = $row_arr_ref->[$col];
      if (!defined($val)) {$printval = $missing_symbol;}
      elsif (defined($precision) && $val !~ /\D/) # is numerical
	    { $printval = sprintf($precision, $val);}
	    else
	    { $printval = $val;}     
      $text .= "$printval\t";
    }
    $text .= "\n";
  }
  return $text;
}

# Writes a 2D array to a file in transposed form. Doesn't assume all subarrays are of same length.
sub transpose_array_2D_to_file
{
	my ($arr_2D_ref, $outfile, $do_append) = @_;
	my $text = transpose_array_2D_to_text($arr_2D_ref);
	writefile($text, $outfile, $do_append);
}
	
sub find_max_row_len
{
	my $arr_2D_ref = shift;
	my $max_len = 0;
	foreach my $row_arr_ref(@$arr_2D_ref)
	{
		my $len = @$row_arr_ref;
		if ($len > $max_len) {$max_len = $len;}
	}
	return $max_len;
}

sub writefile
{
  my ($stuff, $outfile, $do_append) = @_;
  my $how_char = $do_append ? ">>" : ">";
  open(OUTFILE, "$how_char$outfile") || die "Cannot open \"$outfile\" : $!";
  print OUTFILE $stuff;
  close OUTFILE;
}