From: Jan "Yenya" Kasprzak <kas@fi.muni.cz>
Date: Mon, 13 Nov 2023 09:14:39 +0000 (+0100)
Subject: 2019 day 18 - slow and ugly bruteforce
X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?p=aoc.git;a=commitdiff_plain;h=9fde662cbadbdbbdc34221f3a72decc0db1a2113

2019 day 18 - slow and ugly bruteforce
---

diff --git a/2019/35.pl b/2019/35.pl
new file mode 100755
index 0000000..07758eb
--- /dev/null
+++ b/2019/35.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+
+use v5.36;
+use Data::Dumper;
+use Array::Heap;
+use feature 'multidimensional';
+
+my @map = map { chomp; [ split // ] } <>;
+
+my %pos_of;
+for my $y (0 .. $#map) {
+	for my $x (0 .. $#{ $map[0]}) {
+		my $c = $map[$y][$x];
+		next if $c !~ /[a-z@]/;
+		$pos_of{$c} = [ $x, $y ];
+	}
+}
+
+my $nkeys = keys %pos_of;
+say "nkeys = $nkeys";
+
+$; = ';';
+
+my $best;
+
+my $min_dist = 1_000_000;
+
+my %min_cost;
+my @q0;
+sub walk {
+	my ($cost, @opened) = @_;
+
+	my %opened = map { $_ => 1 } @opened;
+
+	my $key = $opened[0] . join('', sort @opened);
+
+	if (defined $min_cost{$key} && $min_cost{$key} <= $cost) {
+		return;
+	}
+
+	$min_cost{$key} = $cost;
+
+	say "walk $min_dist $cost - $key ", length $key;
+	if ($nkeys + 1 == length $key) {
+		say "Found!";
+		exit 1;
+	}
+
+	my $p = $pos_of{$opened[0]};
+	my @q = [ @$p, $cost ];
+
+	my %seen;
+	$seen{$p->[0],$p->[1]} = 1;
+
+	my %dist;
+
+	while (my $pos = shift @q) {
+		my ($x, $y, $steps) = @$pos;
+
+		my $v = $map[$y][$x];
+		next if $v eq '#';
+		if ($v =~ /[a-z]/ && !$opened{$v}) {
+			$dist{$v} //= $steps;
+			# say "opened=". scalar @opened;
+			$min_dist = $steps if $min_dist > $steps
+				&& @opened == keys %pos_of;
+			push_heap @q0, [ $steps, $v, @opened ];
+		}
+		if ($v =~ /[A-Z]/) {
+			next if !$opened{lc($v)};
+		}
+	
+		for my ($dx, $dy) (1, 0, 0, 1, -1, 0, 0, -1) {
+			my ($nx, $ny) = ($x + $dx, $y + $dy);
+			next if $seen{$nx,$ny}++;
+			push @q, [ $nx, $ny, $steps+1 ]
+				if $steps + 1 < $min_dist;
+		}
+	}
+}
+
+push_heap @q0, [0, '@'];
+while (@q0) {
+	my $elem = pop_heap @q0;
+	walk(@$elem);
+}
+
+say $min_dist;
diff --git a/2019/36.pl b/2019/36.pl
new file mode 100755
index 0000000..f56553c
--- /dev/null
+++ b/2019/36.pl
@@ -0,0 +1,96 @@
+#!/usr/bin/perl -w
+
+use v5.36;
+use Data::Dumper;
+use Array::Heap;
+use feature 'multidimensional';
+
+my @map = map { chomp; [ split // ] } <>;
+
+my %pos_of;
+for my $y (0 .. $#map) {
+	for my $x (0 .. $#{ $map[0]}) {
+		my $c = $map[$y][$x];
+		next if $c !~ /[a-z1-4]/;
+		$pos_of{$c} = [ $x, $y ];
+	}
+}
+
+my $nkeys = keys %pos_of;
+say "nkeys = $nkeys";
+
+$; = ';';
+
+my $best;
+
+my $min_dist = 1_000_000;
+
+my %min_cost;
+my $max_opened;
+my $max_cost;
+my @q0;
+sub walk {
+	my ($cost0, $cost, @opened) = @_;
+
+	my @robots = splice(@opened, 0, 4);
+	my %opened = map { $_ => 1 } @opened;
+
+	my $key = join('', $robots[0], sort(@robots[1..3]), '|', sort @opened);
+
+	if (defined $min_cost{$key} && $min_cost{$key} <= $cost) {
+		return;
+	}
+
+	$min_cost{$key} = $cost;
+
+	$max_opened = @opened if (!defined $max_opened || @opened > $max_opened);
+	if (!defined $max_cost || $max_cost < $cost) {
+		$max_cost = $cost;
+		say "walk $cost - $key ", length $key, ' ', $max_opened;
+	}
+	if ($nkeys == @opened) {
+		say "Found!";
+		exit 1;
+	}
+		
+
+	my $p = $pos_of{$robots[0]};
+	my @q = [ @$p, $cost ];
+
+	my %seen;
+	$seen{$p->[0],$p->[1]} = 1;
+
+	my %dist;
+
+	while (my $pos = shift @q) {
+		my ($x, $y, $steps) = @$pos;
+
+		my $v = $map[$y][$x];
+		next if $v eq '#';
+		if ($v =~ /[a-z]/ && !$opened{$v}) {
+			$dist{$v} //= $steps;
+			my $cost = $steps + $nkeys - @opened;
+			# say "opened=". scalar @opened;
+			push_heap @q0, [ $cost, $steps, $v, @robots[1..3], $v, @opened ];
+			push_heap @q0, [ $cost, $steps, $robots[1], $v, @robots[2..3], $v, @opened ];
+			push_heap @q0, [ $cost, $steps, $robots[2], $v, @robots[1,3], $v, @opened ];
+			push_heap @q0, [ $cost, $steps, $robots[3], $v, @robots[1..2], $v, @opened ];
+		}
+		if ($v =~ /[A-Z]/) {
+			next if !$opened{lc($v)};
+		}
+	
+		for my ($dx, $dy) (1, 0, 0, 1, -1, 0, 0, -1) {
+			my ($nx, $ny) = ($x + $dx, $y + $dy);
+			next if $seen{$nx,$ny}++;
+			push @q, [ $nx, $ny, $steps+1 ];
+		}
+	}
+}
+
+push_heap @q0, [0, 0, 1, 2, 3, 4, 1, 2, 3, 4];
+while (@q0) {
+	my $elem = pop_heap @q0;
+	walk(@$elem);
+}
+