#!/usr/bin/perl
use v5.35.0;
use List::Util 'sum';
use List::Pairwise 'mapp';

# Each tile on the input map is represented here as a pair, to account
# for location and orientation both contributing to the movement cost
# rules. From any half-tile with an even index, its counterparts in
# adjacent columns (only) can be reached at a cost of 1; those with
# odd indexes link adjacent rows likewise. Switching to the other
# half-tile in a pair costs 1000.
#
# If that seems kind of weird and arbitrary, think of the maze as a
# printed circuit board with tracks running only vertically on one side
# and only horizontally on the other. The half-tiles for any given tile,
# then, are just its two sides, and it costs much more to lube up and
# squeeze through a via than it does to take one step along a track.

my ($width, @wall, @exits);
my $size = 0;
while (<>) {
	$width //= 2 * length;
	for (split //) {
		@wall[$size, $size ^ 1] = (/#|\v/) x 2;
		# Start is a kind of exit point; cost to
		# escape the maze there is zero
		push @exits, [0, $size, $_] if /[ES]/;
		# Every end point is actually two exits,
		# one for each allowable orientation; cost
		# to escape from either is also zero
		push @exits, [0, $size ^ 1, $_] if /E/;
		$size += 2;
	}
}

# Flood-fill the map, starting simultaneously from all exits and working in
# strict cost order, to work out lowest cost to escape (lcte) for all tiles.

my @lcte;

# Don't actually need to flood the whole thing, just enough to find all the
# places where the flood spreading from the S exit meets one spreading from
# either of the two E exits. Those junctions will each be on a a path of
# least cost to both S and E, and therefore a path of least cost across the
# whole maze.

my @junctions;

# To make detecting junction tiles possible, we need to keep track of where
# any given tile was flooded from.

my @origin = ('') x $size;

# Flood-filling to solve mazes with a consistent cost to step from one room
# to the next is straightforward, but the cost rules make this one a little
# more complicated. To deal with this we maintain two work queues, one for
# steps taken in a cheap direction and the other for the expensive side-
# switching steps.

my @cheap = @exits;
my @expensive;

# The expensive queue will tend to fill with higher costs than those found
# in the cheap queue, but although both queues will remain in strict cost
# order internally because of the way they're filled, their drain ends do
# need testing to find out which is offering the lower cost at any given
# step. This is still a *lot* less work than that involved in trying to
# keep any kind of unified queue properly sorted, if only because both
# the arrays involved only ever need manipulating at their ends and Perl
# is good at doing that.

my $best_score;
for (;;) {
	my ($cost, $pos, $from) = @{
		if (@cheap) {
			if (@expensive) {
				if ($cheap[0][0] < $expensive[0][0]) {
					shift @cheap
				} else {
					shift @expensive
				}
			} else {shift @cheap}
		}
		elsif (@expensive) {shift @expensive}
		else {last}
	};
	#show(guts(@expensive), guts(@cheap), "$cost $pos $from");

	if (defined $lcte[$pos]) {
		# Detect flood meeting points
		if (($origin[$pos] || $from) ne $from) {
			my $path_score = $cost + $lcte[$pos];
			$best_score //= $path_score;
			last if $path_score > $best_score;
			push @junctions, [$cost, $pos, $from, $path_score];
		}

		# but don't otherwise reprocess already-seen tiles
		next;
	}

	# Tile is newly flooded - record that
	$lcte[$pos] = $cost;
	$origin[$pos] = $from;

	# and flood its neighbours
	my $step = $pos & 1? $width : 2;

	my $next = $pos - $step;
	push @cheap, [$cost+1, $next, $from]
	unless $next < 0 || $wall[$next] || $origin[$next] eq $from;

	$next = $pos + $step;
	push @cheap, [$cost+1, $next, $from]
	unless $next >= $size || $wall[$next] || $origin[$next] eq $from;

	$next = $pos ^ 1;
	push @expensive, [$cost+1000, $next, $from]
	unless $origin[$next] eq $from;
}

#show();
#show_wide();

for my ($cost, $junction, $from, $path_score) (map {@$_} @junctions) {
	say	"Via half-tile $junction: ",
		"$cost from $from, ",
		"$lcte[$junction] from $origin[$junction], ",
		"total $path_score";
}

# Starting from each of the flood junctions, walk back toward both its
# flood origins to find all the tiles on all the best paths. This needs
# another flood fill because paths can converge as well as diverge, but
# it doesn't need the split queue shenanigans; the next tiles to step to
# can always be found by looking for those with a LCTE exactly 1 or 1000
# less than the current tile's.

my @best_way = (0) x $size;
my @queue = map {([@$_[0,1]], [$lcte[$$_[1]], $$_[1]])} @junctions;
while (@queue) {
	my ($cost, $pos) = @{shift @queue};
	#show(guts(@queue), "$cost $pos");

	$cost -= 1;
	my $step = $pos & 1? $width : 2;
	my $next = $pos - $step;
	unless ($next < 0 || $wall[$next] ||
	       	$best_way[$next] || $lcte[$next] != $cost) {
		$best_way[$next] = 1;
		push @queue, [$cost, $next];
	}

	$next = $pos + $step;
	unless ($next >= $size || $wall[$next] ||
	       	$best_way[$next] || $lcte[$next] != $cost) {
		$best_way[$next] = 1;
		push @queue, [$cost, $next];
	}

	$cost -= 999;
	$next = $pos ^ 1;
	unless ($best_way[$next] || $lcte[$next] != $cost) {
		$best_way[$next] = 1;
		push @queue, [$cost, $next]
	}
}

# The junctions themselves get filled in last, just so that the flood fill
# can be coded to take advantage of paths converging toward S and E by
# stopping early when a tile already known to be on a best path is found;
# that doesn't work well when trying to start two simultaneous fills from
# the same starting point if it isn't left empty to begin with.

@best_way[map {$$_[1]} @junctions] = (1) x @junctions;

#show();
#show_wide();
say sum(mapp sub {$a || $b}, @best_way), " tiles on best paths";



sub guts {
	return '-' unless @_;
	if (@_ == 1) {
		my $arg = $_[0] // 'und';
		my $ref = ref($arg);
		if ($ref eq 'ARRAY') {
			return '['.join(' ', map {guts($_)} @$arg).']';
		} elsif ($ref eq 'HASH') {
			return '{'.join(' ', map {$_.'=>'.guts($$arg{$_})} sort keys %$arg).'}';
		} else {
			return $arg;
		}
	}
	return '(' . join(' ', map {guts($_)} @_) . ')';
}



sub show {
	say shift while @_;
	for (my $row = 0; $row < $size; $row += $width) {
		my $line = sprintf '%5d ', $row;
		for (my $pos = $row; $pos < $row + $width; ++$pos) {
			if ($wall[$pos]) {$line .= '#'}
			elsif ($best_way[$pos]) {$line .= 'O'}
			elsif ($origin[$pos]) {$line .= $origin[$pos]}
			else {$line .= $pos&1 ? '|' : '-'}
		}
		say $line;
	}
	say '';
}



sub show_wide {
	say shift while @_;
	for (my $row = 0; $row < $size; $row += $width) {
		my $line = sprintf '%5d ', $row;
		for (my $pos = $row; $pos < $row + $width; ++$pos) {
			if ($wall[$pos]) {$line .= '#######'}
			elsif (defined $lcte[$pos]) {
				$line .= sprintf(
					'%5d%s%s',
					$lcte[$pos],
					$origin[$pos],
					$best_way[$pos]? 'O' : ' '
				);
			} else {$line .= $pos & 1 ? '  ^ v  ' : '  < >  '}
			$line .= '|' if $pos & 1;
		}
		say $line;
	}
	say '';
}