TWC346

Challenge Link

Task1

We use a stack to find the maximum number of valid parentheses:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(max);

sub longest_parenthesis{
  my @s = split '',$_[0];
  my ($max,@stk) = (0,-1);
  foreach my $i(0..$#s) {
    if($s[$i] eq '(') {push @stk,$i}
    else {
      pop @stk;
      if(@stk == 0) {push @stk,$i}
      else {
	$max = max($max,$i - $stk[$#stk])
      }
    }
  }
  $max
}

printf "%d\n",longest_parenthesis('(()())');
printf "%d\n",longest_parenthesis(')()())');
printf "%d\n",longest_parenthesis('((()))()(((()');
printf "%d\n",longest_parenthesis('))))((()(');
printf "%d\n",longest_parenthesis('()(()');

Task2

We use Depth First Search to search for all the possible solutions:

#!/usr/bin/env perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(variations_with_repetition);
use List::Util qw(mesh);
use Data::Show;

sub magic_expression{
  my ($str,$target) = @_;
  my @ds = split '',$str;
  my $it = variations_with_repetition(['+','-',,'*',''],$#ds);
  my @res;
  while(my $ops = $it->next) {
    my $expr = join '',mesh(\@ds,[@$ops,'']);
    next if $expr =~ /\b0[0-9]/;
    my $eval = $expr =~ s/-/+-/gr;
    $eval =~ s/(\d+)\*(\d+)/$1*$2/ge while $eval =~ /\*/;
    $eval =~ s/(-?\d+)\+(-?\d+)/$1+$2/ge while $eval =~ /\+/;
    push @res,$expr if $eval == $target
  }
  @res
}

show magic_expression("123",6);
show magic_expression("105",5);
show magic_expression("232",8);
show magic_expression("1324",10);
show magic_expression("1001",2)

Read More

TWC345

Challenge Link

Task1

We traverse the array by steps of 3 elements each time and test for the peak element:

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Show;

sub peak_positions{
  my ($arr) = @_;
  my @res;
  foreach my $i(1..$#$arr) {
    if($arr->[$i-1] < $arr->[$i] && $arr->[$i+1] < $arr->[$i]) {
      push @res,$i
    }
  }
  @res
}

show peak_positions([1,3,2]);
show peak_positions([2,4,6,5,3]);
show peak_positions([1,2,3,2,4,1]);
show peak_positions([5,3,1]);
show peak_positions([1,5,1,5,1,5,1]);

Task2

We simulate the operations while traversing the array:

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Show;

sub last_visitor{
  my ($arr) = @_;
  my (@res,@seen);
  my $k = 0;
  foreach my $i(0..$#$arr) {
    if($arr->[$i] != -1) {
      push @seen,$arr->[$i];
      $k = @seen
    } elsif ($k == 0) {
      push @res,-1
    } else {
      push @res,$seen[--$k]
    }
  }
  @res
}

show last_visitor([5,-1,-1]);
show last_visitor([3,7,-1,-1,-1]);
show last_visitor([2,-1,4,-1,-1]);
show last_visitor([10,20,-1,30,-1,-1]);
show last_visitor([-1,-1,5,-1])

Read More

TWC344

Challenge Link

My Perl somehow got broken, and I didn't yet have the time to fix the issue, so this post will contain Java solutions.

Task1

We add the digit x to the array which contains the digits of a number:

import java.util.List;
import java.util.LinkedList;

public class Ch1 {
  public static void main(String[] args) {
    System.out.println(array_form_compute(new int[]{1,2,3,4},12));
    System.out.println(array_form_compute(new int[]{2,7,4},181));
    System.out.println(array_form_compute(new int[]{9,9,9},1));
    System.out.println(array_form_compute(new int[]{1,0,0,0,0},9999));
    System.out.println(array_form_compute(new int[]{0},1000));
  }

  private static List array_form_compute(int[] arr,int k) {
    int i = arr.length-1,carry = 0;
    List res = new LinkedList<>();
    while(i >= 0 || k > 0 || carry > 0) {
      carry += (i < 0 ? 0 : arr[i--]) + k % 10;
      res.addFirst(carry % 10);
      carry /= 10;
      k /= 10;
    }
    return res;
  }
}

Task2

We check if the array can be formed by combining the source elements:

public class Ch2 {
  public static void main(String[] args) {
    System.out.println(array_formation(new int[][]{{2,3},{1},{4}},
				       new int[]{1,2,3,4}));
    System.out.println(array_formation(new int[][]{{1,3},{2,4}},
				       new int[]{1,2,3,4}));
    System.out.println(array_formation(new int[][]{{9,1},{5,8},{2}},
				       new int[]{5,8,2,9,1}));
    System.out.println(array_formation(new int[][]{{1},{3}},
				       new int[]{1,2,3}));
    System.out.println(array_formation(new int[][]{{7,4,6}},
				       new int[]{7,4,6}));
  }

  private static boolean array_formation(int[][]source,
					 int[] target) {
    for(int i = 0; i < target.length;) {
      int k = 0;
      while(k < source.length && source[k][0] != target[i]) ++k;
      if(k == source.length) return false;
      int j = 0;
      while(j < source[k].length && target[i] == source[k][j]) {
	++i;
	++j;
      }
    }
    return true;
  }
}

Read More

TWC343

Challenge Link

Task1

We find the number with the smallest distance from zero:

#!/usr/bin/env perl
use strict;
use warnings;

sub zero_friend{
  my $zf = abs shift @{$_[0]};
  abs $_ < $zf and $zf = abs for @{$_[0]};
  $zf
}

printf "%d\n",zero_friend([4,2,-1,3,-2]);
printf "%d\n",zero_friend([-5,5,-3,3,-1,1]);
printf "%d\n",zero_friend([7,-3,0,2,-8]);
printf "%d\n",zero_friend([-2,-5,-1,-8]);
printf "%d\n",zero_friend([-2,2,-4,4,-1,1]);

Task2

We count the wins and find the champion team:

#!/usr/bin/env perl
use strict;
use warnings;

sub champion_team{
  my $m = 0;
  my %h;
  foreach my $y(0..$#{$_[0]}){
    foreach my $x(0..$#{$_[0]->[$y]}){
      my $w = $_[0]->[$y][$x] ? $y : $x;
      $m = $w if ++$h{$w} > $h{$m}
    }
  }
  $m
}

printf "%d\n",champion_team([[0, 1, 1],
			     [0, 0, 1],
			     [0, 0, 0]]);
printf "%d\n",champion_team([[0, 1, 0, 0],
			     [0, 0, 0, 0],
			     [1, 1, 0, 0],
			     [1, 1, 1, 0]]);
printf "%d\n",champion_team([[0, 1, 0, 1],
			     [0, 0, 1, 1],
			     [1, 0, 0, 0],
			     [0, 0, 1, 0]]);
printf "%d\n",champion_team([[0, 1, 1],
			     [0, 0, 0],
			     [0, 1, 0]]);
printf "%d\n",champion_team([[0, 0, 0, 0, 0],
			     [1, 0, 0, 0, 0],
			     [1, 1, 0, 1, 1],
			     [1, 1, 0, 0, 0],
			     [1, 1, 0, 1, 0]]);

Read More

TWC342

Challenge Link

Task1

We keep on alternating between digits and letters:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(min);

sub balance_string{
  my @chars = split '',$_[0];
  my @ds = grep{/\d/} @chars;
  my @ls = grep{/\D/} @chars;
  my ($m,$n) = (scalar @ds,scalar @ls);
  return '' if abs($m-$n) > 1;
  my $res;
  foreach my $i(0..min($m,$n)-1){
    if($m > $n) {
      $res .= $ds[$i] . $ls[$i]
    } else {
      $res .= $ds[$i] . $ls[$i]
    }
  }
  $res .= $ds[$m-1] if($m > $n);
  $res .= $ls[$n-1] if($m < $n);
  $res
}

printf "%s\n",balance_string('a0b1c2');
printf "%s\n",balance_string('abc12');
printf "%s\n",balance_string('0a2b1c3');
printf "%s\n",balance_string('1a23');
printf "%s\n",balance_string('ab123')

Task2

We find the max score by prefix sum:

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(max);

sub max_score{
  my $res = 0;
  foreach my $i(1..(length $_[0])-1) {
    my $temp = 0;
    foreach my $j(0..$i-1) {
      $temp++ if (substr $_[0],$j,1) eq '0'
    }
    foreach my $j($i..(length $_[0])-1) {
      $temp++ if (substr $_[0],$j,1) eq '1'
    }
    $res = max $res,$temp;
  }
  $res
}

printf "%d\n",max_score('0011');
printf "%d\n",max_score('0000');
printf "%d\n",max_score('1111');
printf "%d\n",max_score('0101');
printf "%d\n",max_score('011101')

Read More

TWC341

Challenge Link

Task1

We count the words that doesn't include given chars:

#!/usr/bin/env perl
use strict;
use warnings;

sub broken_keyboard{
  my $chars = join '',@{$_[1]};
  scalar grep {$chars eq '' || !/[$chars]/i} split /\W+/,$_[0];
}

printf "%d\n",broken_keyboard('Hello World',['d']);
printf "%d\n",broken_keyboard('apple banana cherry',['a','e']);
printf "%d\n",broken_keyboard('Coding is fun',['']);
printf "%d\n",broken_keyboard('The Weekly Challenge',['a','b']);
printf "%d\n",broken_keyboard('Perl and Python',['p'])

Task2

We reverse the prefix before and including the given char and append to the rest of the string:

#!/usr/bin/env perl
use strict;
use warnings;

sub reverse_prefix{
  my ($str) = @_;
  $str =~ s/^(.*?$_[1])/reverse $1/e;
  $str
}

printf "%s\n",reverse_prefix('programming','g');
printf "%s\n",reverse_prefix('hello','h');
printf "%s\n",reverse_prefix('abcdefghij','h');
printf "%s\n",reverse_prefix('reverse','s');
printf "%s\n",reverse_prefix('perl','r')

Read More

TWC340

Challenge Link

Task1

We repeatedly remove adjacent duplicate characters until there's none left:

#!/usr/bin/env perl
use strict;
use warnings;

sub duplicate_removals{
  my ($str) = @_;
  while(1) {
    my $c = 0;
    $str =~ s/(.)\1//g and $c = 1;
    last unless $c
  }
  $str
}

printf "%s\n",duplicate_removals('abbaca');
printf "%s\n",duplicate_removals('azxxzy');
printf "%s\n",duplicate_removals('aaaaaaaa');
printf "%s\n",duplicate_removals('aabccba');
printf "%s\n",duplicate_removals('abcddcba')

Task2

We extract the numbers into an array, and check if that array is ascending:

#!/usr/bin/env perl
use strict;
use warnings;

sub is_ascending{
  foreach my $i(1..$#{$_[0]}) {
    return 0 if $_[0]->[$i] <= $_[0]->[$i-1]
  }
  1
}

sub ascending_numbers{
  my @arr = grep {/\d+/} split /\s+/,$_[0];
  is_ascending(\@arr)
}

printf "%d\n",ascending_numbers('The cat has 3 kittens 7 toys 10 beds');
printf "%d\n",ascending_numbers('Alice bought 5 apples 2 oranges 9 bananas');
printf "%d\n",ascending_numbers('I ran 1 mile 2 days 3 weeks 4 months');
printf "%d\n",ascending_numbers('Bob has 10 cars 10 bikes');
printf "%d\n",ascending_numbers('Zero is 0 one is 1 two is 2');

Read More