Merge pull request #1925 from brtastic/challenge-68

Challenge 68 solutions

2 files changed, 206 insertions, 0 deletions

diff --git a/challenge-068/brtastic/perl/ch-1.pl b/challenge-068/brtastic/perl/ch-1.pl
new file mode 100644
index 0000000000..ce89789781
--- /dev/null
+++ b/challenge-068/brtastic/perl/ch-1.pl
@@ -0,0 +1,106 @@
+use v5.26;
+use warnings;
+
+use constant ROW => 0;
+use constant COL => 1;
+use constant TRIGGER_VALUE => 0;
+use constant DEFAULT_VALUE => 1;
+
+sub make_rule {
+	my ($type, $value) = @_;
+
+	return sub {
+		my ($val) = @_;
+		return $val->[$type] eq $value
+			? TRIGGER_VALUE : DEFAULT_VALUE;
+	};
+}
+
+sub zero_matrix {
+	my ($matrix) = @_;
+	my @rules;
+
+	my sub apply_rules {
+		my ($val) = @_;
+		my $new_value = DEFAULT_VALUE;
+
+		foreach my $rule (@rules) {
+			$new_value = $rule->($val);
+			last if $new_value ne DEFAULT_VALUE;
+		}
+		return $new_value;
+	}
+
+	my sub transform_forth {
+		for my $m_ind (keys $matrix->@*) {
+			for my $n_ind (keys $matrix->[$m_ind]->@*) {
+				my $value = $matrix->[$m_ind][$n_ind];
+				my @new_value = ($m_ind, $n_ind);
+				$matrix->[$m_ind][$n_ind] = \@new_value;
+
+				if ($value eq TRIGGER_VALUE) {
+					push @rules, make_rule ROW, $new_value[ROW];
+					push @rules, make_rule COL, $new_value[COL];
+				}
+			}
+		}
+	}
+
+	my sub transform_back {
+		for my $m_val ($matrix->@*) {
+			for my $n_val ($m_val->@*) {
+				$matrix->[$n_val->[0]][$n_val->[1]] = apply_rules($n_val);
+			}
+		}
+	}
+
+	transform_forth;
+	transform_back;
+	return $matrix;
+}
+
+use Test::More;
+
+is_deeply zero_matrix([
+	[1, 1, 1],
+	[1, 1, 1],
+	[1, 1, 1],
+]), [
+	[1, 1, 1],
+	[1, 1, 1],
+	[1, 1, 1],
+];
+
+is_deeply zero_matrix([
+	[1, 0, 1],
+	[1, 1, 1],
+	[1, 1, 1],
+]), [
+	[0, 0, 0],
+	[1, 0, 1],
+	[1, 0, 1],
+];
+
+is_deeply zero_matrix([
+	[1, 0, 1],
+	[1, 1, 1],
+	[1, 0, 1],
+]), [
+	[0, 0, 0],
+	[1, 0, 1],
+	[0, 0, 0],
+];
+
+is_deeply zero_matrix([
+	[1, 1, 1, 1],
+	[1, 0, 0, 1],
+	[1, 0, 0, 1],
+	[1, 1, 1, 1],
+]), [
+	[1, 0, 0, 1],
+	[0, 0, 0, 0],
+	[0, 0, 0, 0],
+	[1, 0, 0, 1],
+];
+
+done_testing;
diff --git a/challenge-068/brtastic/perl/ch-2.pl b/challenge-068/brtastic/perl/ch-2.pl
new file mode 100644
index 0000000000..72800b0036
--- /dev/null
+++ b/challenge-068/brtastic/perl/ch-2.pl
@@ -0,0 +1,100 @@
+use v5.26;
+use warnings;
+
+package ListNode {
+	use Moo;
+
+	has "value" => (
+		is => "ro",
+	);
+
+	has "next_node" => (
+		is => "ro",
+		writer => "set_next_node",
+	);
+};
+
+sub reorder_list {
+	my ($list) = @_;
+
+	my sub make_linked_list {
+		my $last = undef;
+		foreach my $item (reverse $list->@*) {
+			my $node = ListNode->new(value => $item, next_node => $last);
+			$last = $node;
+		}
+
+		return $last;
+	}
+
+	my sub linked_list_to_array {
+		my ($head) = @_;
+
+		my @result;
+		while (defined $head) {
+			push @result, $head->value;
+			$head = $head->next_node;
+		}
+
+		return \@result;
+	}
+
+	my sub detach_tail {
+		my ($node) = @_;
+
+		my $last_node;
+		while (defined $node->next_node) {
+			$last_node = $node;
+			$node = $node->next_node;
+		}
+
+		return undef unless defined $last_node;
+
+		$last_node->set_next_node(undef);
+		return $node;
+	}
+
+	my $list_head = make_linked_list;
+	my $current = $list_head;
+
+	while (-reordering) {
+		my $tail = detach_tail $current;
+		if (!defined $current->next_node) {
+			if (defined $tail) {
+				$current->set_next_node($tail);
+			}
+			last;
+		}
+
+		my $next = $current->next_node;
+		$current->set_next_node($tail);
+		$tail->set_next_node($next);
+		$current = $next;
+	}
+
+	return linked_list_to_array($list_head);
+}
+
+use Test::More;
+
+is_deeply
+	reorder_list([1]),
+	[1];
+
+is_deeply
+	reorder_list([1, 2]),
+	[1, 2];
+
+is_deeply
+	reorder_list([1, 2, 3, 4]),
+	[1, 4, 2, 3];
+
+is_deeply
+	reorder_list([1, 2, 5, 3, 4]),
+	[1, 4, 2, 3, 5];
+
+is_deeply
+	reorder_list([1, 2, 3, 4, 5, 6]),
+	[1, 6, 2, 5, 3, 4];
+
+done_testing;