perl logo Perl logo (Thanks to Olaf Alders)

The weekly challenge 344 - Task 2: Array Formation

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-344/#TASK2
 3 #
 4 # Task 2: Array Formation
 5 # =======================
 6 #
 7 # You are given two list: @source and @target.
 8 #
 9 # Write a script to see if you can build the exact @target by putting these
10 # smaller lists from @source together in some order. You cannot break apart or
11 # change the order inside any of the smaller lists in @source.
12 #
13 ## Example 1
14 ##
15 ## Input: @source = ([2,3], [1], [4])
16 ##        @target = (1, 2, 3, 4)
17 ## Output: true
18 ##
19 ## Use in the order: [1], [2,3], [4]
20 #
21 #
22 ## Example 2
23 ##
24 ## Input: @source = ([1,3], [2,4])
25 ##        @target = (1, 2, 3, 4)
26 ## Output: false
27 #
28 #
29 ## Example 3
30 ##
31 ## Input: @source = ([9,1], [5,8], [2])
32 ##        @target = (5, 8, 2, 9, 1)
33 ## Output: true
34 ##
35 ## Use in the order: [5,8], [2], [9,1]
36 #
37 #
38 ## Example 4
39 ##
40 ## Input: @source = ([1], [3])
41 ##        @target = (1, 2, 3)
42 ## Output: false
43 ##
44 ## Missing number: 2
45 #
46 #
47 ## Example 5
48 ##
49 ## Input: @source = ([7,4,6])
50 ##        @target = (7, 4, 6)
51 ## Output: true
52 ##
53 ## Use in the order: [7, 4, 6]
54 #
55 ############################################################
56 ##
57 ## discussion
58 ##
59 ############################################################
60 #
61 # We check all possible permutations of the source arrays. If
62 # any permutation has all numbers in the same order than the
63 # target array, we can return true since we found a solution.
64 # Otherwise, we return false.
65 
66 use v5.36;
67 use Algorithm::Permute;
68 
69 array_formation([[2,3], [1], [4]], [1, 2, 3, 4]);
70 array_formation([[1,3], [2,4]], [1, 2, 3, 4]);
71 array_formation([[9,1], [5,8], [2]], [5, 8, 2, 9, 1]);
72 array_formation([[1], [3]], [1, 2, 3]);
73 array_formation([[7,4,6]], [7, 4, 6]);
74 
75 sub array_formation($source, $target) {
76     say "Input: (" . join(", ", map { "[" . join(", ", @$_) .  "]" } @$source)
77             . "), (" . join(", ", @$target) . ")";
78     my $p_iterator = Algorithm::Permute->new ( $source );
79     while(my @perm = $p_iterator->next) {
80         my @tmp = ();
81         foreach my $list (@perm) {
82             push @tmp, @$list;
83         }
84         if(equals(\@tmp, $target)) {
85             return say "Output: true";
86         }
87     }
88     say "Output: false";
89 }
90 
91 sub equals($left, $right) {
92     return 0 unless scalar(@$left) == scalar(@$right);
93     foreach my $i (0..scalar(@$left)-1) {
94         return 0 if $left->[$i] != $right->[$i];
95     }
96     return 1;
97 }