TASK #2 › Flip Array
Submitted by: Mohammad S Anwar
You are given an array @A of positive numbers.
Write a script to flip the sign of some members of the given array so that the sum of the all members is minimum non-negative.
Given an array of positive elements, you have to flip the sign of some of its elements such that the resultant sum of the elements of array should be minimum non-negative(as close to zero as possible). Return the minimum no. of elements whose sign needs to be flipped such that the resultant sum is minimum non-negative.
Example 1:
Input: @A = (3, 10, 8)
Output: 1
Explanation:
Flipping the sign of just one element 10 gives the result 1
i.e. (3) + (-10) + (8) = 1
Example 2:
Input: @A = (12, 2, 10)
Output: 1
Explanation:
Flipping the sign of just one element 12 gives the result 0
i.e. (-12) + (2) + (10) = 0
👍 Flipping 👎
What I imagine at first is an image of histogram and -- as the name of task suggests -- flip the numbers in every combinations
Okay. why not?
Flipping a series of numbers can be written as below
> (1,2,3).map( -> $n { $n, -$n } )
((1 -1) (2 -2) (3 -3))
And we can create permutations by using X
> [X] (1,2,3).map( -> $n { $n, -$n } )
((1 2 3) (1 2 -3) (1 -2 3) (1 -2 -3) (-1 2 3) (-1 2 -3) (-1 -2 3) (-1 -2 -3))
And I'd like to mention that how powerful this is!!!
Almost done. HOWEVER... TMTOWTDI
As you can see we are almost done. but wait.. something ran across my head.. We need two groups of numbers...
A Tale of Two towers (♜Positive|♖Negative)
We we have three numbers we can divide then in to two groups, for example:
(12) (2 10)
(12 2) (10)
(2) (10 12)
and difference between two groups in summation can has the answer.
I found that this approach involves totally different two concepts ...
- Combinations
- Bag and (-)
Combinations
Combinations in Raku is built-in. No worries. No need to load extra library.
> my @n = 12, 2, 10;
[12 2 10]
> @n.combinations(1..2) # we can use a Range
((12) (2) (10) (12 2) (12 10) (2 10))
We would better skip the last number of selection(@n.elems) because it's not meaningful if we have only positive numbers.
> @n.combinations( 1 .. @n.end )
((12) (2) (10) (12 2) (12 10) (2 10))
📖 .end
And making a bag is easy as below
> @n.combinations( 1.. @n.end ).map( *.Bag )
(Bag(12) Bag(12) Bag(2) Bag(12(2)) Bag(12 2) Bag(12 2))
or by using hyper operator >>
@n.combinations( 1.. @n.end )>>.Bag
(Bag(12) Bag(12) Bag(2) Bag(12(2)) Bag(12 2) Bag(12 2))
Bag
We need the other one, let's make pairs
shell> cat g.raku
my @n = 12, 2, 10;
my $b = @n.Bag;
@n.combinations( 1.. @n.end )>>.Bag.
map( -> $NegBag {
($b (-) $NegBag), $NegBag
} ).
# `-> we made a list of two groups
map( { say "{.first} <=> {.tail}" } );
shell> raku g.raku
2 10 <=> 12
10 12 <=> 2
2 12 <=> 10
10 <=> 12 2
2 <=> 10 12
12 <=> 10 2
We can now create a meaningful data from the list given by .classify-ing, here is full code up to here.
my @n = 12, 2, 10;
my $b = @n.Bag;
@n.combinations( 1.. @n.end )>>.Bag.
map( -> $NegBag {
($b (-) $NegBag), $NegBag
} ).
# `-> we made a list of two groups
classify(
{
with [-] .map( *.kxxv.sum ) {
$_ < 0 ?? Inf !! $_ # 👉 see note, please
}
},
:as{ .[1].elems } ).
say
{0 => [1 2], 4 => [1], 20 => [1], Inf => [2 2]}
📖 *.kxxv
"0 => [1 2]" means that we can make sum of zero by filiping 1 or 2 numbers.
👉 note: I classify negative sum as Inf so when we are sorting negative groups are listed in last.
Or Another TMTOWTDI!. .map is very powerful tool in Perl and Raku, and calculating sum of groups can be done by .sum, filtering negative result of subtraction done by next in map control flow (Raku has control flow in .map; Not in Perl though)
... snip ...
# `-> we made a list of two groups
map( -> $TwoGroups {
with ([-] $TwoGroups.map( *.kxxv.sum )) {
next if $_ < 0; # filtering
$_ => $TwoGroups[1].total # interested in counts
}
} ).
say;
Sort and Take
Last step will be sort the result (by both .key and .value) to get mimimum sum which is zero in above case, take first one.
... snip ...
# `-> we made a list of two groups
map( -> $TwoGroups {
with ([-] $TwoGroups.map( *.kxxv.sum )) {
next if $_ < 0; # filtering
$_ => $TwoGroups[1].total # interested in counts
}
} ).
sort. # automatically sort by .key and .value
first. # take first one
value. # only interested in value
say
Final Code
After long explanation, I realised that makeing two group by Bag isn't necessary. Please take it as another exercise :-)
multi MAIN ($n where * > 0) { say 0 }
multi MAIN (*@n where { @n.all ~~ Int and @n.all > 0 }) {
my $s = @n.sum;
@n.combinations( 1..^ @n ).
map(
-> \n {
with $s - 2 * n.sum { # same as ( $s- n.sum ) - n.sum
next if $_ < 0;
$_ => n.elems
}
} ).
sort.
first.value.
say
}
Furthermore, If sort() is working as I expected. min() will do the same.
multi MAIN ($n where * > 0) { say 0 }
multi MAIN (*@n where { @n.all ~~ Int and @n.all > 0 }) {
my $s = @n.sum;
@n.combinations( 1..^ @n ).
map(
-> \n {
with $s - 2 * n.sum { # same as ( $s- n.sum ) - n.sum
next if $_ < 0;
$_ => n.elems
}
} ).
min.
value.
say
}
One more thing ... Race
I recalled that Colin Crain's code at 077 Task #1 and try with some numbers.
When your given more than 15 numbers we will feel the difference.
multi MAIN ($n where * > 0) { say 0 }
multi MAIN (*@n where { @n.all ~~ Int and @n.all > 0 }) {
my $s = @n.sum;
@n.combinations( 1..^ @n ).
race( :8degree:500batch ). # 👈 here
map(
-> \n {
with $s - 2 * n.sum { # same as ( $s- n.sum ) - n.sum
next if $_ < 0;
$_ => n.elems
}
} ).
race( :8degree:500batch ). # 👈 and here
min.
value.
say
}
This is not precise benchmark but we can taste the difference :-)
time raku ch-2.with-race.raku 12 7 4 5 6 9 20 12 7 4 5 6 9 20 9 4 2 1 13
5
________________________________________________________
Executed in 3.59 secs fish external
usr time 9.28 secs 568.00 micros 9.28 secs
sys time 0.13 secs 137.00 micros 0.13 secs
time raku ch-2.raku 12 7 4 5 6 9 20 12 7 4 5 6 9 20 9 4 2 1 13
5
________________________________________________________
Executed in 5.60 secs fish external
usr time 5.70 secs 0.00 micros 5.70 secs
sys time 0.03 secs 710.00 micros 0.03 secs
Thank you for reading ~!!, If you are interested in.
please check out https://perlweeklychallenge.org/challenges
See next one. 👋
Latest comments (1)
I updated this article too a lot today. I regret that post it too earlier.
I removed '==>' because not very useful with race
and also added race for my curiosity.
I guess that it should be alright, now no more edit. 😄