use strict;
use warnings;
use Time::HiRes qw(time);

# ---------------------------------------------------------------------------
# read_file
# Purpose:
#   Read non-blank lines from a file as values.
# Parameters:
#   fileSpec - input file path.
# Returns:
#   The values as a list; dies if the input file cannot be opened.
# Variables used:
#   input_file, values - input handle and collected lines.
# ---------------------------------------------------------------------------
sub read_file {
	print "READING INPUT FILE...";
	my ($fileSpec) = @_;
	open my $input_file, '<', $fileSpec or die "Cannot open $fileSpec: $!";
	my @values = map {chomp; $_} grep {/\S/} <$input_file>;
	close $input_file;
	print "DONE.\n";
	return @values;
}

# ---------------------------------------------------------------------------
# save_file
# Purpose:
#   Write supplied values to a file, one per line.
# Parameters:
#   values - array reference; fileSpec - output file path.
# Returns:
#   None; dies on open or close errors.
# Variables used:
#   output_file - output handle.
# ---------------------------------------------------------------------------
sub save_file {
	print "SAVING OUTPUT FILE...";
	my ($values, $fileSpec) = @_;
	open my $output_file, '>', $fileSpec or die "Cannot create $fileSpec: $!";
	print {$output_file} "$_\n" for @$values;
	close $output_file or die "Cannot close $fileSpec: $1";
	print "DONE.\n";
}

# ---------------------------------------------------------------------------
# sift_down
# Purpose:
#   Restore the max-heap property below root in values[0..end).
# Parameters:
#   values - array reference; root - subtree root; end - exclusive heap end.
# Returns:
#   None; mutates the referenced array.
# Variables used:
#   child - selected child index.
# ---------------------------------------------------------------------------
sub sift_down {
	my ($values, $root, $end) = @_;
	while (2 * $root + 1 < $end) {
		my $child = 2 * $root + 1;
		$child++ if $child + 1 < $end && $values->[$child] < $values->[$child + 1];
		return if $values->[$root] >= $values->[$child];
		@$values[$root, $child] = @$values[$child, $root];
		$root = $child;
	}
}

# ---------------------------------------------------------------------------
# heapsort
# Purpose:
#   Sort the referenced array in place and measure elapsed time.
# Parameters:
#   values - array reference to sort.
# Returns:
#   Elapsed wall-clock seconds.
# Variables used:
#   startTime, endTime - timer values; start/end - heap traversal indices.
# ---------------------------------------------------------------------------
sub heapsort {
	print "SORTING ELEMENTS...";
	my ($values) = @_;
	my $startTime = time;
	
	sift_down($values, $_, scalar @$values) for reverse 0 .. int(@$values / 2) -1;
	
	for(my $end = @$values -1; $end > 0; $end--) {
		@$values[0, $end] = @$values[$end, 0];
		sift_down($values, 0, $end);
	}
	
	my $endTime = time;
	print "DONE.\n";
	return $endTime - $startTime;
}

print "***HEAPSORT PERL***\n";
my @values = read_file("D:/Sorting/Sorting_Input.txt");
my $elapsed = heapsort(\@values);
save_file(\@values, "D:/Sorting/Output_PERL.txt");
print "***RUN COMPLETE***\n";
printf "HEAPSORT TOOK %.6f SECONDS.\n", $elapsed;