From: Jan "Yenya" Kasprzak <kas@fi.muni.cz>
Date: Thu, 23 Dec 2021 10:03:03 +0000 (+0100)
Subject: Day 23: too long, too complicated. Do not read this.
X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?a=commitdiff_plain;h=1b679d223ab429d5367d0650bfb9b20b1028e299;p=aoc2021.git

Day 23: too long, too complicated. Do not read this.
---

diff --git a/45.pl b/45.pl
new file mode 100755
index 0000000..b5ff0b9
--- /dev/null
+++ b/45.pl
@@ -0,0 +1,208 @@
+#!/usr/bin/perl -w
+
+use v5.16;
+
+#  ab c d e fg
+#    h j l n
+#    i k m o
+
+my %g = (
+	'h' => {
+		'a' => [ 3, 'b' ],
+		'b' => [ 2, '' ],
+		'c' => [ 2, '' ],
+		'd' => [ 4, 'c' ],
+		'e' => [ 6, 'cd' ],
+		'f' => [ 8, 'cde' ],
+		'g' => [ 9, 'cdef' ],
+	},
+	'i' => {
+		'a' => [ 4, 'bh' ],
+		'b' => [ 3, 'h' ],
+		'c' => [ 3, 'h' ],
+		'd' => [ 5, 'ch' ],
+		'e' => [ 7, 'cdh' ],
+		'f' => [ 9, 'cdeh' ],
+		'g' => [ 10, 'cdefh' ],
+	},
+	'j' => {
+		'a' => [ 5, 'bc' ],
+		'b' => [ 4, 'c' ],
+		'c' => [ 2, '' ],
+		'd' => [ 2, '' ],
+		'e' => [ 4, 'd' ],
+		'f' => [ 6, 'de' ],
+		'g' => [ 7, 'def' ],
+	},
+	'k' => {
+		'a' => [ 6, 'bcj' ],
+		'b' => [ 5, 'cj' ],
+		'c' => [ 3, 'j' ],
+		'd' => [ 3, 'j' ],
+		'e' => [ 5, 'dj' ],
+		'f' => [ 7, 'dej' ],
+		'g' => [ 8, 'defj' ],
+	},
+	'l' => {
+		'a' => [ 7, 'bcd' ],
+		'b' => [ 6, 'cd' ],
+		'c' => [ 4, 'd' ],
+		'd' => [ 2, '' ],
+		'e' => [ 2, '' ],
+		'f' => [ 4, 'e' ],
+		'g' => [ 6, 'ef' ],
+	},
+	'm' => {
+		'a' => [ 8, 'bcdl' ],
+		'b' => [ 7, 'cdl' ],
+		'c' => [ 5, 'dl' ],
+		'd' => [ 3, 'l' ],
+		'e' => [ 3, 'l' ],
+		'f' => [ 5, 'el' ],
+		'g' => [ 7, 'efl' ],
+	},
+	'n' => {
+		'a' => [ 9, 'bcde' ],
+		'b' => [ 8, 'cde' ],
+		'c' => [ 6, 'de' ],
+		'd' => [ 4, 'e' ],
+		'e' => [ 2, '' ],
+		'f' => [ 2, '' ],
+		'g' => [ 3, 'f' ],
+	},
+	'o' => {
+		'a' => [ 10, 'bcden' ],
+		'b' => [ 9, 'cden' ],
+		'c' => [ 7, 'den' ],
+		'd' => [ 5, 'en' ],
+		'e' => [ 3, 'n' ],
+		'f' => [ 3, 'n' ],
+		'g' => [ 4, 'fn' ],
+	},
+);
+
+for my $node (keys %g) {
+	for my $n2 (keys %{ $g{$node} }) {
+		$g{$n2}->{$node} = $g{$node}->{$n2};
+	}
+}
+
+my %home = (
+	h => 'A',
+	i => 'A',
+	j => 'B',
+	k => 'B',
+	l => 'C',
+	m => 'C',
+	n => 'D',
+	o => 'D',
+);
+
+my %otherhome = (
+	h => 'i',
+	j => 'k',
+	l => 'm',
+	n => 'o',
+);
+%otherhome = (%otherhome, reverse %otherhome);
+
+my %cost_of = (
+	A => 1,
+	B => 10,
+	C => 100,
+	D => 1000,
+);
+
+my @type = qw( A A B B C C D D );
+
+sub can_move {
+	my ($pos, $who, $dst) = @_;
+	my $i = 0;
+	my %rpos = map { $_ => $i++ } @$pos;
+	my $src = $pos->[$who];
+	my $mytype = $type[$who];
+	return 0 if defined $rpos{$dst}; # occupied
+	return 0 if !$home{$src} && !$home{$dst}; # cant move in a hallway
+	if ($home{$dst}) {
+		return 0 if $home{$dst} ne $mytype; # not own home
+		my $other = $otherhome{$dst};
+		return 0 if defined $rpos{$other} && $type[$rpos{$other}] ne $mytype;
+		return 0 if $other gt $dst && !defined $rpos{$other};
+	}
+
+	# path exists?
+	my $c = $g{$src}->{$dst};
+	return 0 if !$c;
+
+	# path occupied?
+	for my $in (split //, $c->[1]) {
+		return 0 if $rpos{$in};
+	}
+
+	# say "can_move $who$type[$who]=>$dst ", join(',', keys %rpos);
+	return $c->[0];
+}
+
+my %pos_seen;
+my $min_cost = 100_000;
+sub walk {
+	my ($pos, $moved, $cost, $moves) = @_;
+	my $key = join(' ', @$pos, $cost);
+	return if $pos_seen{$key}++;
+	my $athome = 0;
+	# say "walk ", join(' ', @$pos), " cost $cost";
+	for my $i (0 .. $#$pos) {
+		my @dsts; 
+		if (!$moved->{$i}) {
+			@dsts = 'a' .. 'g';
+		} elsif ($moved->{$i} == 1) {
+			@dsts = grep { $home{$_} eq $type[$i] } keys %home;
+		} else {
+			$athome++;
+		}
+		for my $dst (@dsts) {
+			my $acost = can_move($pos, $i, $dst);
+			next if !$acost;
+			$acost *= $cost_of{$type[$i]};
+			next if $cost + $acost >= $min_cost;
+
+			my @npos = @$pos;
+			$npos[$i] = $dst;
+
+			my %nmoved = %$moved;
+			$nmoved{$i}++;
+
+			my @nmoves = @$moves;
+			push @nmoves, "$i$type[$i]=>$dst $acost";
+			
+			walk(\@npos, \%nmoved, $cost + $acost, \@nmoves);
+		}
+	}
+	if ($athome == 8) {
+		if (!$min_cost || $cost < $min_cost) {
+			$min_cost = $cost;
+			say "athome = $athome cost $cost $min_cost: ",
+				join(', ', @$moves);
+		}
+	}
+}
+
+
+walk( [qw( h k i l j o m n )], {}, 0, [ ]);
+# walk( [qw( i o h l j m k n )], { 0 => 2, 5 => 2 }, 0, [ ]);
+
+#############
+#...........#
+###B#C#B#D###
+  #A#D#C#A#
+  #########
+
+
+
+			
+			
+		
+			
+		
+
+
diff --git a/46.pl b/46.pl
new file mode 100755
index 0000000..4cacd82
--- /dev/null
+++ b/46.pl
@@ -0,0 +1,264 @@
+#!/usr/bin/perl -w
+
+use v5.16;
+
+#  ab c d e fg
+#    h l p t
+#    i m q u
+#    j n r v
+#    k o s w
+
+my %g = (
+	'h' => {
+		'a' => [ 3, 'b' ],
+		'b' => [ 2, '' ],
+		'c' => [ 2, '' ],
+		'd' => [ 4, 'c' ],
+		'e' => [ 6, 'cd' ],
+		'f' => [ 8, 'cde' ],
+		'g' => [ 9, 'cdef' ],
+	},
+	'l' => {
+		'a' => [ 5, 'bc' ],
+		'b' => [ 4, 'c' ],
+		'c' => [ 2, '' ],
+		'd' => [ 2, '' ],
+		'e' => [ 4, 'd' ],
+		'f' => [ 6, 'de' ],
+		'g' => [ 7, 'def' ],
+	},
+	'p' => {
+		'a' => [ 7, 'bcd' ],
+		'b' => [ 6, 'cd' ],
+		'c' => [ 4, 'd' ],
+		'd' => [ 2, '' ],
+		'e' => [ 2, '' ],
+		'f' => [ 4, 'e' ],
+		'g' => [ 6, 'ef' ],
+	},
+	't' => {
+		'a' => [ 9, 'bcde' ],
+		'b' => [ 8, 'cde' ],
+		'c' => [ 6, 'de' ],
+		'd' => [ 4, 'e' ],
+		'e' => [ 2, '' ],
+		'f' => [ 2, '' ],
+		'g' => [ 3, 'f' ],
+	},
+);
+
+for my $n1 (keys %g) {
+	my $prevnodes = $n1;
+	for my $i (1..3) {
+		my $n2 = chr(ord($n1)+$i);
+		for my $n3 (keys %{ $g{$n1} }) {
+			my $c = $g{$n1}->{$n3};
+			$g{$n2}->{$n3} = [ $c->[0] + $i, $c->[1].$prevnodes ];
+		}
+		$prevnodes .= $n2;
+	}
+}
+
+# symmetric
+for my $node (keys %g) {
+	for my $n2 (keys %{ $g{$node} }) {
+		$g{$n2}->{$node} = $g{$node}->{$n2};
+	}
+}
+
+my %home = (
+	h => 'A',
+	l => 'B',
+	p => 'C',
+	t => 'D',
+);
+
+my %lowerhome;
+for my $n1 (keys %home) {
+	for (1..3) {
+		my $n2 = chr(ord($n1)+$_);
+		$home{$n2} = $home{$n1};
+	}
+}
+
+my %home_of = (
+	A => [ 'h' .. 'k' ],
+	B => [ 'l' .. 'o' ],
+	C => [ 'p' .. 's' ],
+	D => [ 't' .. 'w' ],
+);
+
+my %cost_of = (
+	A => 1,
+	B => 10,
+	C => 100,
+	D => 1000,
+);
+
+my @type = qw( A A A A B B B B C C C C D D D D );
+
+sub can_move {
+	my ($pos, $who, $dst) = @_;
+	my $i = 0;
+	my %rpos = map { $_ => $i++ } @$pos;
+	my $src = $pos->[$who];
+	my $mytype = $type[$who];
+	return 0 if defined $rpos{$dst}; # occupied
+	return 0 if !$home{$src} && !$home{$dst}; # cant move in a hallway
+
+	# path exists?
+	my $c = $g{$src}->{$dst};
+	return 0 if !$c;
+
+	# path occupied?
+	for my $in (split //, $c->[1]) {
+		return 0 if defined $rpos{$in};
+	}
+
+	# say "can_move $who$type[$who]=>$dst ", join(',', keys %rpos);
+	return $c->[0];
+}
+
+sub gen_pos {
+	my ($pos) = @_;
+	my $text = <<'EOF';
+#############
+#ab.c.d.e.fg#
+###h#l#p#t###
+  #i#m#q#u#
+  #j#n#r#v#
+  #k#o#s#w#
+  #########
+EOF
+	for my $i (0 .. $#$pos) {
+		$text =~ s/$pos->[$i]/$type[$i]/gxms;
+	}
+	$text =~ s/[a-z]/./gxms;
+	return join('', @$pos) . "\n" .$text;
+}
+
+sub print_pos { say gen_pos(shift) }
+
+my %pos_seen;
+my $min_cost = 100_000;
+sub walk {
+	my ($pos, $moved, $can_move, $free_home, $cost, $moves) = @_;
+
+	my $key = join(' ', @$pos, $cost);
+	return if $pos_seen{$key}++;
+
+	my $finished = grep { $moved->{$_} && $moved->{$_} == 2 } 0 .. $#$pos;
+	my $stepped =  grep { $moved->{$_} && $moved->{$_} == 1 } 0 .. $#$pos;
+	# say "stepped $stepped, finished: $finished";
+	if ($finished == @$pos) {
+		if (!$min_cost || $cost < $min_cost) {
+			$min_cost = $cost;
+			say "cost $cost $min_cost: ", @$moves;
+		}
+	}
+
+	my $x = 0;
+	my %rpos = map { $_ => $x++ } @$pos;
+
+if (0) {
+	say "walk ", join(' ', @$pos), " cost $cost, can_move = ",
+		join(',', keys %$can_move),
+		" free_home = ", join(',', keys %$free_home);
+	print_pos($pos);
+}
+
+	for my $i (grep { !$moved->{$_} } keys %$can_move) {
+		my @dsts;
+
+		my %nmoved = %$moved;
+		my %ncan_move = %$can_move;
+		my %nfree_home = %$free_home;
+
+		my $mypos = $pos->[$i];
+		my $mytype = $type[$i];
+
+		$nmoved{$i}++;
+
+		delete $ncan_move{$i};
+		my $under = chr(ord($mypos)+1);
+		if (defined $home{$under} && $home{$mypos} eq $home{$under}
+			&& !$moved->{$rpos{$under}}) { 
+			$ncan_move{$rpos{$under}} = 1;
+		} else {
+			$nfree_home{$home{$mypos}} = $mypos;
+		}
+		for my $dst (grep { !defined $rpos{$_} } 'a' .. 'g') {
+			my $acost = can_move($pos, $i, $dst);
+			next if !$acost;
+			$acost *= $cost_of{$type[$i]};
+			next if $cost + $acost >= $min_cost;
+
+			my @npos = @$pos;
+			$npos[$i] = $dst;
+
+			my @nmoves = @$moves;
+			push @nmoves, "$i$type[$i]$pos->[$i]=>$dst $acost\n" . gen_pos($pos) . "\n";
+			
+			# print_pos($pos);
+			# say $nmoves[-1];
+			walk(\@npos, \%nmoved, \%ncan_move, \%nfree_home, $cost + $acost, \@nmoves);
+		}
+	}
+
+	for my $i (grep { $moved->{$_} && $moved->{$_} == 1 } keys %$moved) {
+		my $mypos = $pos->[$i];
+		my $mytype = $type[$i];
+		next if !$free_home->{$mytype};
+		my $dst = $free_home->{$mytype};
+
+		my $acost = can_move($pos, $i, $dst);
+		next if !$acost;
+		$acost *= $cost_of{$type[$i]};
+		next if $cost + $acost >= $min_cost;
+
+		my %nmoved = %$moved;
+		my %ncan_move = %$can_move;
+		my %nfree_home = %$free_home;
+
+		$nmoved{$i}++;
+
+		delete $nfree_home{$mytype};
+		my $above = chr(ord($dst)-1);
+		if ($home{$above} && $home{$above} eq $mytype) {
+			$nfree_home{$mytype} = $above;
+		}
+
+		delete $ncan_move{$i};
+		
+		my @npos = @$pos;
+		$npos[$i] = $dst;
+
+		my @nmoves = @$moves;
+		push @nmoves, "$i$type[$i]$pos->[$i]=>$dst $acost\n" . gen_pos($pos) . "\n";
+		# say "xxx ", $nmoves[-1];
+		# print_pos($pos);
+		walk(\@npos, \%nmoved, \%ncan_move, \%nfree_home, $cost + $acost, \@nmoves);
+	}
+
+	# say "return";
+}
+
+my $prod = 1;
+#          A A A A B B B B C C C C D D D D
+walk( [qw( h o r u k n p q l m v w i j s t )],
+ 	{},
+ 	{ map { $_ => 1 } qw(0 8 6 15) },
+ 	{},
+	0, [ ]) if $prod;
+walk( [qw( k r u w h n p q l m s v i j o t )],
+	{ 0 => 2, 10 => 2 },
+	{ map { $_ => 1 } qw(4 8 6 15) },
+	{ },
+	0, [ ]) if !$prod;
+
+say $min_cost;
+#############
+#...........#
+###B#C#B#D###
+  #A#D#C#A#
+  #########