#!/usr/bin/perl

use warnings;
use strict;

my $debug = 0;

$\ = $/;

<>;

MAIN:
while(<>){
	$debug and print '-' x 15;

	$_ = join '', map ~~<>, 1 .. $_;

	$debug and print "\$_:[$_]";

	if( 0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		){
		print 'YES';
		next;
		}

	my %h3;

	map $h3{ $_ } ++, m/\w\w\w/g;

	for my $key ( sort keys %h3 ){
		if( exists $h3{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	my %h2;
	my %h2L;
	my %h2R;

	m/\b\w\w\b(?{ push @{ $h2{ $& } }, $-[0] })(*FAIL)/gx;

	$debug and print "$_-->[@{ $h2{ $_ } }]" for sort keys %h2;

	m/\w(\w\w)(?{ $h2L{ scalar reverse $1 }   = $-[0] })(*FAIL)/gx;
	m!(\w\w)\w(?{ $h2R{ scalar reverse $1 } //= $-[0] })(*FAIL)!gx;

	$debug and print "L:$_-->$h2L{ $_ }" for sort keys %h2L;
	$debug and print "R:$_-->$h2R{ $_ }" for sort keys %h2R;

	for my $key ( sort keys %h2 ){

		if( exists $h2{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}

		for my $i ( 0 .. @{ $h2{ $key } } - 1 ){

			if( exists $h2L{ $key } and $h2{ $key }[ $i ] < $h2L{ $key } ){
				print 'YES';
				next MAIN;
				}

			if( exists $h2R{ $key } and $h2{ $key }[ $i ] > $h2R{ $key } ){
				print 'YES';
				next MAIN;
				}

			}
		}

	print 'NO';
	}

#!/usr/bin/perl

use warnings;
use strict;

my $debug = 0;

$\ = $/;

<>;

MAIN:
while(<>){
	$debug and print '-' x 15;

	$_ = join '', map ~~<>, 1 .. $_;

	$debug and print "\$_:[$_]";

	if( 0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		){
		print 'YES';
		next;
		}

	my %h3;

	map $h3{ $& } ++, m/\w\w\w/g;

	for my $key ( sort keys %h3 ){
		if( exists $h3{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	my %h2;
	my %h2L;
	my %h2R;

	m/\b\w\w\b(?{ push @{ $h2{ $& } }, $-[0] })(*FAIL)/gx;

	$debug and print "$_-->[@{ $h2{ $_ } }]" for sort keys %h2;

	m/\w(\w\w)(?{ $h2L{ scalar reverse $1 }   = $-[0] })(*FAIL)/gx;
	m!(\w\w)\w(?{ $h2R{ scalar reverse $1 } //= $-[0] })(*FAIL)!gx;

	$debug and print "L:$_-->$h2L{ $_ }" for sort keys %h2L;
	$debug and print "R:$_-->$h2R{ $_ }" for sort keys %h2R;

	for my $key ( sort keys %h2 ){

		if( exists $h2{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}

		for my $i ( 0 .. @{ $h2{ $key } } - 1 ){

			if( exists $h2L{ $key } and $h2{ $key }[ $i ] < $h2L{ $key } ){
				print 'YES';
				next MAIN;
				}

			if( exists $h2R{ $key } and $h2{ $key }[ $i ] > $h2R{ $key } ){
				print 'YES';
				next MAIN;
				}

			}
		}

	print 'NO';
	}

#!/usr/bin/perl

use warnings;
use strict;

my $debug = 0;

$\ = $/;

<>;

MAIN:
while(<>){
	$debug and print '-' x 15;

	$_ = join '', map ~~<>, 1 .. $_;

	$debug and print "\$_:[$_]";

	if( 0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		){
		print 'YES';
		next;
		}

	my %h3;

	map $h3{ $& } ++, m/\w\w\w/g;

	for my $key ( sort keys %h3 ){
		if( exists $h3{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	my %h2;
	my %h2L;
	my %h2R;

	m/\b\w\w\b(?{ push @{ $h2{ $& } }, $-[0] })(*FAIL)/gx;

	$debug and print "$_-->[@{ $h2{ $_ } }]" for sort keys %h2;

	m/\w(\w\w)(?{ $h2L{ scalar reverse $1 }   = $-[0] })(*FAIL)/gx;
	m!(\w\w)\w(?{ $h2R{ scalar reverse $1 } //= $-[0] })(*FAIL)!gx;

	$debug and print "L:$_-->$h2L{ $_ }" for sort keys %h2L;
	$debug and print "R:$_-->$h2R{ $_ }" for sort keys %h2R;

	for my $key ( sort keys %h2 ){
		for my $i ( 0 .. @{ $h2{ $key } } - 1 ){

			if( exists $h2L{ $key } and $h2{ $key }[ $i ] < $h2L{ $key } ){
				print 'YES';
				next MAIN;
				}

			if( exists $h2R{ $key } and $h2{ $key }[ $i ] > $h2R{ $key } ){
				print 'YES';
				next MAIN;
				}

			}
		}

	print 'NO';
	}

#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

MAIN:
while(<>){
	$_ = join '', map ~~<>, 1 .. $_;

	my %h;

	map $h{ $& } ++, m/\w\w\w/g;

	for my $key ( sort keys %h ){
		if( exists $h{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	my $_b;

	print qw( NO YES )[ 0 + (
		0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		|| m/   \b(\w)(\w)
				( \b )?
				.*
				( \b )?
				\2\1\b
				(??{ '-' x ( ( defined $3 ) * ( defined $4 ) ) })
				/sx
		) ];
	}

#!/usr/bin/perl

# WA

use warnings;
use strict;

$\ = $/;

<>;

MAIN:
while(<>){
	$_ = join '', map ~~<>, 1 .. $_;

	my %h;

	map $h{ $& } ++, m/\w\w\w/g;

	for my $key ( sort keys %h ){
		if( exists $h{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	print qw( NO YES )[ 0 + (
		0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		|| m/\b(\w)(\w)(.*+)?(.*+)?.*\2\1\b/s
		) ];
	}

#!/usr/bin/perl

# WA

use warnings;
use strict;

$\ = $/;

<>;

MAIN:
while(<>){
	$_ = join '', map ~~<>, 1 .. $_;

	my %h;

	map $h{ $& } ++, m/\w\w\w/g;

	for my $key ( sort keys %h ){
		if( exists $h{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	print qw( NO YES )[ 0 + (
		0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		|| m/\b(\w)(\w)(??{ ".*$2$1\\b" })/s
		) ];
	}

#!/usr/bin/perl

# WA

use warnings;
use strict;

$\ = $/;

<>;

MAIN:
while(<>){
	$_ = join '', map ~~<>, 1 .. $_;

	my %h;

	map $h{ $& } ++, m/\w\w\w/g;

	for my $key ( sort keys %h ){
		if( exists $h{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	print qw( NO YES )[ 0 + (
		0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		|| m/\b(\w)(\w).*.*\2\1\b/s
		) ];
	}

#!/usr/bin/perl

# WA

use warnings;
use strict;

$\ = $/;

<>;

MAIN:
while(<>){
	$_ = join '', map ~~<>, 1 .. $_;

	my %h;

	map $h{ $& } ++, m/\w\w\w/g;

	for my $key ( sort keys %h ){
		if( exists $h{ scalar reverse $key } ){
			print 'YES';
			next MAIN;
			}
		}

	print qw( NO YES )[ 0 + (
		0
		|| m/\b\w\b/
		|| m/\b(\w)\1\b/
		|| m/\b(\w)\w\1\b/
		|| m/\b(\w)(\w).*\2\1\b/s
		) ];
	}


#!/usr/bin/perl

## + https://www.perlmonks.org/?node_id=11118153

use warnings;
use strict;

$\ = $/;

my $debug = 0;

<>;

while(<>){
	$debug and print '-' x 15;

	chomp;
	my $character_bank = join '', reverse sort split //;

	<>;
	@_ = split ' ', <>;

	my @idx;
	my @groups;

	while( @idx != @_ ){

		my @idx_new;

		OUTER:
		for my $i ( 0 .. @_ - 1 ){
			my $sum = 0;
			for my $j ( @idx ){
				next OUTER if $i == $j;
				$sum += abs( $i - $j );
				}

			$_[ $i ] == $sum and push @idx_new, $i;
			}

		push @idx, @idx_new;
		push @groups, 0 + @idx_new;
		}

	$debug and print "idx:[@idx]";
	$debug and print "groups:[@groups]";

	my $re = join '', map { "(?=(.)) (\\g{-2}{$_}) \\g{-2}* .*? " } @groups;

	$debug and print "re:[$re]";
	$debug and print "[[$character_bank]]";

	$character_bank =~ /
		$re
		/x or print "FAIL!";

	my @chars_seq = ( $character_bank =~ /$re/x )[ map 2 * $_ + 1, 0 .. @groups - 1 ];

	$debug and print "[[@chars_seq]]";

	my $chars_seq = join '', @chars_seq;

	my @ans;

	for my $c ( split //, $chars_seq ){
		$ans[ shift @idx ] = $c;
		}

	print @ans;
	}

#!/usr/bin/perl

## + https://www.perlmonks.org/?node_id=11118153

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	chomp;
	$_ = join '', reverse sort split //;

	<>;
	@_ = split ' ', <>;

	my @idx;
	my @groups;

	while( @idx != @_ ){

		my @idx_new;

		OUTER:
		for my $i ( 0 .. @_ - 1 ){
			my $sum = 0;
			for my $j ( @idx ){
				next OUTER if $i == $j;
				$sum += abs( $i - $j );
				}

			$_[ $i ] == $sum and push @idx_new, $i;
			}

		push @idx, @idx_new;
		push @groups, 0 + @idx_new;
		}

	my $re = join '', map { "(?=(.)) (\\g{-2}{$_}) \\g{-2}* .*? " } @groups;

	my @ans;
	@ans[ @idx ] = map { split '' } ( /$re/x )[ map 2 * $_ + 1, 0 .. @groups - 1 ];

	print @ans;
	}

#!/usr/bin/perl

## + https://www.perlmonks.org/?node_id=11118153

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	chomp;
	$_ = join '', reverse sort split //;

	<>;
	@_ = split ' ', <>;

	my @idx;
	my @groups;

	while( @idx != @_ ){

		my @idx_new;

		OUTER:
		for my $i ( 0 .. @_ - 1 ){
			my $sum = 0;
			for my $j ( @idx ){
				next OUTER if $i == $j;
				$sum += abs( $i - $j );
				}

			$_[ $i ] == $sum and push @idx_new, $i;
			}

		push @idx, @idx_new;
		push @groups, 0 + @idx_new;
		}

	my $re = join '', map { "(?=(.)) (\\g{-2}{$_}) \\g{-2}* .*? " } @groups;

	my @ans;
	@ans[ @idx ] = map { split '' } ( /$re/x )[ map 2 * $_ + 1, 0 .. @groups - 1 ];

	print "@ans";
	}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	$_ = <>, chomp;

	print join '', sort split //;
	}


#!/usr/bin/perl
use v5.10;

sub getBits {
	my ($x, $ret) = (shift, 0);
	# say "x = $x";
	while ($x) {
		$ret += ($x & 1);
		$x >>= 1;
	}
	# say "ret = $ret";
	return $ret;
}

($n, $m, $k) = split / /, <>;
push @a, int(<>) foreach (0..$m);
getBits($_ ^ $a[$m])<=$k and ++$ans foreach (@a);
say $ans-1;

use strict;
use warnings;

sub dec2bin {
    my $str = unpack("B32", pack("N", shift));
    $str =~ s/^0+(?=\d)//;   # otherwise you'll get leading zeros
    return $str;
}

my @arr;
my ($n, $m, $k) = split / /, <>;
my ($count, $ans) = (0, 0);
for my $i(0..$m) {
    chomp($_ = <>);
    push @arr, $_;
}
for my $i(0..$m-1) {
    # $count = unpack("%32b*", $arr[$i] ^ $arr[-1]) - 2;
    $count = dec2bin(int$arr[$i] ^ int$arr[-1]) =~ tr/1/1/;
    # print unpack("%32b*", 4);
    # print $arr[$i] . " " . $arr[-1] . " " . $count . " " . dec2bin(int$arr[$i] ^ int$arr[-1]) ."\n";
    $ans++ if ($count <= $k);
}
print $ans . "\n";

use 5.016;
use strict;
use warnings;

sub popcount {
  my ($n) = @_;

  my $c = 0;
  while ($n) {
    $c++;
    $n = $n & ($n - 1);
  }
  $c;
}

sub hamming_distance {
  my ($x, $y) = @_;

  popcount((0+$x) ^ (0+$y));
}

my ($n, $m, $k) = split ' ', <>;

my @players;
for (1..$m) {
  push @players, scalar <>;
}
my $fedor = <>;

say scalar grep { hamming_distance($fedor, $_) <= $k } @players;

sub dec2bin {
    my $str = unpack("B32", pack("N", shift));
    $str =~ s/^0+(?=\d)//;   # otherwise you'll get leading zeros
    return $str;
}

my @arr;
my ($n, $m, $k) = split / /, <>;
my ($count, $ans) = (0, 0);
for my $i(0..$m) {
    chomp($_ = <>);
    push @arr, $_;
}
for my $i(0..$m-1) {
    $count = dec2bin(int$arr[$i] ^ int$arr[-1]) =~ tr/1/1/;
    $ans++ if ($count <= $k);
}
print $ans . "\n";

#!/perl -w

use strict ;

my($n,$m,$k) = split /\s+/s , <STDIN> ;

my @soldiertype = (0) ;
my $num = 1 ;
while($num <= $m+1 ){
    chomp ( $soldiertype[$num] = <STDIN> );
    $num++ ;
}

my $friend = 0 ;
foreach(1..($m)){
    my $cmp_soldier = $soldiertype[$m+1] ;
    my $diff = 0 ;
    while ( $cmp_soldier || $soldiertype[$_] ){
        if ( ( $soldiertype[$_] & 1 ) ^ ( $cmp_soldier & 1 )  ){
            $diff ++ ;
        }
        $cmp_soldier = $cmp_soldier >> 1 ;
        $soldiertype[$_] = $soldiertype[$_] >> 1 ;
    }
    $friend++ if ( $diff <= $k ) ;
}

print $friend, "\n" ;


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	my( $n, $m, $x ) = split;

	$x --;

	my $int = int $x / $n;
	my $mod = $x % $n;

	print 1 + $int + $mod * $m;
	}

use bigint;
<STDIN>;
while (<>)
{
    chomp;
    my ($n, $m, $x) = split;
    $x--;
    my ($r, $c) = ($x % $n, int($x / $n));
    my $res = $r * $m + $c + 1;
    print "$res\n";
}

use bigint;
<STDIN>;
while (<>)
{
    chomp;
    my ($n, $m, $x) = split;
    $x--;
    my ($r, $c) = ($x % $n, $x / $n);
    my $res = $r * $m + $c + 1;
    print "$res\n";
}

use bigint;
<STDIN>;
while (<>)
{
    my ($n, $mm, $x) = split / /, chomp;
    $x--;
    my ($r, $c) = ($x % $n, $x / $n);
    my $res = $r * $mm + $c + 1;
    print "$res\n";
}

use bigint;
<STDIN>;
while (<>)
{
    my ($n, $m, $x) = split / /, chomp;
    $x--;
    my ($r, $c) = ($x % $n, $x / $n);
    my $res = $r * $m + $c + 1;
    print "$res";
}


use strict;
our ($n, $m, @l, @r);

sub calc {
	my $p = shift;
	my ($left, $right) = ($l[$p - 1], $r[$p + 1]);
	if (!$left and !$right) {
		$l[$p] = $r[$p] = $p;
	} elsif ($left and $right) {
		$r[$left] = $right;
		$l[$right] = $left;
	} elsif ($left) {
		$l[$p] = $left;
		$r[$left] = $p;
	} elsif ($right) {
		$r[$p] = $right;
		$l[$right] = $p;
	}
	my $empty = ($l[$n] == undef);
	my $last = ($empty? 0: $n - $l[$n] + 1);
	++$m - $last + 1;
}

$n = <>;
print "1 ";
print calc($_), " " for split " ", <>;


#!/usr/bin/perl

use strict;
use warnings;

my $n = <>;
chomp $n;

my (@neg, @pos);

for (1..$n) {
  my $line = <>;
  chomp $line;
  my ($p, $apples) = split(/ /, $line);
  if ($p < 0) {
    $p *= -1;
    push(@neg, "$p:$apples");
  } else {
    push(@pos, "$p:$apples");
  }
}

@neg = sort {
  my @agh = split(/:/, $a);
  my @bgh = split(/:/, $b);
  my $na = $agh[0];
  my $nb = $bgh[0];
  $na <=> $nb
} @neg;

@pos = sort {
  my @agh = split(/:/, $a);
  my @bgh = split(/:/, $b);
  my $na = $agh[0];
  my $nb = $bgh[0];
  $na <=> $nb
} @pos;

map { my @tmp = split(/:/, $_); $_ = $tmp[1] } @pos;
map { my @tmp = split(/:/, $_); $_ = $tmp[1] } @neg;

my @origpos = @pos;
my @origneg = @neg;
my $res = 0;
my $tmp = 0;
while (scalar(@pos) > 0) {
  $tmp += shift @pos;
  if (scalar(@neg) > 0) {
    $tmp += shift @neg;
  } else {
    last;
  }
}
if ($tmp > $res) {
  $res = $tmp;
}
@pos = @origpos;
@neg = @origneg;
$tmp = 0;
while (scalar(@neg) > 0) {
  $tmp += shift @neg;
  if (scalar(@pos) > 0) {
    $tmp += shift @pos;
  } else {
    last;
  }
}
if ($tmp > $res) {
  $res = $tmp;
}
print "$res\n";

	<>, %h = map split, <>;

	++ ( /-/ ? $d : $u ) for keys %h;

	@d = sort {$b <=> $a} grep  /-/, keys %h;
	@u = sort {$a <=> $b} grep !/-/, keys %h;

	$sum += $h{shift @d} + $h{shift @u} while @d && @u;

	print $sum += 0 + $h{ 0 + "@d@u" }

$\ = $/;

while($n = <>){
	undef @h;
	for (1 .. $n){
		push @h, split " ", <>;
		}
	%h = @h;

	$u = $d = 0;
	/-/ ? $d++ : $u++ for keys %h;
	$min = $d > $u ? $u : $d;
	@d = sort sort {$b <=> $a} grep  /-/, keys %h;
	@u = sort sort {$a <=> $b} grep !/-/, keys %h;

	$sum = 0;
	for (1 .. $min){
		$dd = shift @d;
		$uu = shift @u;
		$sum += $h{$dd};
		$sum += $h{$uu};
		}

	$iu = $id = 0;
	@d and $id = shift @d;
	@u and $iu = shift @u;

	$max = $h{$iu} > $h{$id} ? $h{$iu} : $h{$id};

	$sum += $max;
	print $sum;
	}

	<>, %h = map split, <>;

	++ ( /-/ ? $d : $u ) for keys %h;

	@d = sort {$b <=> $a} grep  /-/, keys %h;
	@u = sort {$a <=> $b} grep !/-/, keys %h;

	$sum += $h{shift @d} + $h{shift @u} while @d && @u;

	print $sum += 0 + $h{+"@d@u0"}

	<>, %h = map split, <>;

	++ ( /-/ ? $d : $u ) for keys %h;

	@d = sort {$b <=> $a} grep  /-/, keys %h;
	@u = sort {$a <=> $b} grep !/-/, keys %h;

	$sum += $h{shift @d} + $h{shift @u} while @d && @u;

	print $sum += (@d, @u, 0)[0]


#!/usr/bin/perl

$PI=3.14159265358979323846;
$MOD=1000000007;

#    <>=~/ /;
#    <>=~/ (\d+) /;
#    <>=~/ (\d+) (\d+) /;

for $i(0..<>-1){s/$/$i%4==0?("a"):($i%4==1?("b"):($i%4==2?("c"):("d")))/e}
print;

#***********SUBS************

sub num {$a <=> $b}
sub num_rev {$b <=> $a}
sub rev {$b cmp $a}

sub p{print}
sub n{print "\n"}
sub pn{p,n}
sub pn_mas {pn for @_}

# Transpose "charbox"
sub transpose{
    $i=@m=@_;
    chomp @m;
    while ($i--){
        $t[$i]=~s/$/chop/e for @m
    }
return @t
}

# Transpose "value sets"
sub transpose_space{
    my @t;
    for (@_){
        my $j=0;
        s/\d+/($t[$j++].="$& ")?$&:$&/eg;
        }
    chop @t;
return @t
}

sub div{
    my ($n, $k)=@_;
return ($n - $n % $k) / $k
}

sub uniq{
    my @m=sort @_;
    push @u, my $i=shift @m;
    for (@m){
        $i eq $_ or push @u, $_;
        $i=$_;
        }
return @u
}

sub max{
    my $max=shift;
    $max<$_ and $max=$_ for @_;
return $max
}

sub min{
    my $min=shift;
    $min>$_ and $min=$_ for @_;
return $min
}

# count (kas_ieskoma, masyvas)
sub count{
    my $i=0;
    $_ eq $_[0] and $i++ for @_;
return --$i
}

#!/usr/bin/perl

$PI=3.14159265358979323846;
$MOD=1000000007;

#    <>=~/ /;
#    <>=~/ (\d+) /;
#    <>=~/ (\d+) (\d+) /;

chomp ($i=<>);
$_="abcd"x($i/4+1);
for $j(1..4-$i%4){chop}
print ;

#***********SUBS************

sub num {$a <=> $b}
sub num_rev {$b <=> $a}
sub rev {$b cmp $a}

sub p{print}
sub n{print "\n"}
sub pn{p,n}
sub pn_mas {pn for @_}

# Transpose "charbox"
sub transpose{
    $i=@m=@_;
    chomp @m;
    while ($i--){
        $t[$i]=~s/$/chop/e for @m
    }
return @t
}

# Transpose "value sets"
sub transpose_space{
    my @t;
    for (@_){
        my $j=0;
        s/\d+/($t[$j++].="$& ")?$&:$&/eg;
        }
    chop @t;
return @t
}

sub div{
    my ($n, $k)=@_;
return ($n - $n % $k) / $k
}

sub uniq{
    my @m=sort @_;
    push @u, my $i=shift @m;
    for (@m){
        $i eq $_ or push @u, $_;
        $i=$_;
        }
return @u
}

sub max{
    my $max=shift;
    $max<$_ and $max=$_ for @_;
return $max
}

sub min{
    my $min=shift;
    $min>$_ and $min=$_ for @_;
return $min
}

# count (kas_ieskoma, masyvas)
sub count{
    my $i=0;
    $_ eq $_[0] and $i++ for @_;
return --$i
}

#!/usr/bin/perl

$PI=3.14159265358979323846;
$MOD=1000000007;

#    <>=~/ /;
#    <>=~/ (\d+) /;
#    <>=~/ (\d+) (\d+) /;

$_="abcd"x25e3;
chomp ($i=<>);
print substr($_,0,$i);

#***********SUBS************

sub num {$a <=> $b}
sub num_rev {$b <=> $a}
sub rev {$b cmp $a}

sub p{print}
sub n{print "\n"}
sub pn{p,n}
sub pn_mas {pn for @_}

# Transpose "charbox"
sub transpose{
    $i=@m=@_;
    chomp @m;
    while ($i--){
        $t[$i]=~s/$/chop/e for @m
    }
return @t
}

# Transpose "value sets"
sub transpose_space{
    my @t;
    for (@_){
        my $j=0;
        s/\d+/($t[$j++].="$& ")?$&:$&/eg;
        }
    chop @t;
return @t
}

sub div{
    my ($n, $k)=@_;
return ($n - $n % $k) / $k
}

sub uniq{
    my @m=sort @_;
    push @u, my $i=shift @m;
    for (@m){
        $i eq $_ or push @u, $_;
        $i=$_;
        }
return @u
}

sub max{
    my $max=shift;
    $max<$_ and $max=$_ for @_;
return $max
}

sub min{
    my $min=shift;
    $min>$_ and $min=$_ for @_;
return $min
}

# count (kas_ieskoma, masyvas)
sub count{
    my $i=0;
    $_ eq $_[0] and $i++ for @_;
return --$i
}

#!/usr/bin/perl

$PI=3.14159265358979323846;
$MOD=1000000007;

#    <>=~/ /;
#    <>=~/ (\d+) /;
#    <>=~/ (\d+) (\d+) /;

$_="abcd"x25e3;
$i=<>;
s/.{$i}//;
print "$&\n";

#***********SUBS************

sub num {$a <=> $b}
sub num_rev {$b <=> $a}
sub rev {$b cmp $a}

sub p{print}
sub n{print "\n"}
sub pn{p,n}
sub pn_mas {pn for @_}

# Transpose "charbox"
sub transpose{
    $i=@m=@_;
    chomp @m;
    while ($i--){
        $t[$i]=~s/$/chop/e for @m
    }
return @t
}

# Transpose "value sets"
sub transpose_space{
    my @t;
    for (@_){
        my $j=0;
        s/\d+/($t[$j++].="$& ")?$&:$&/eg;
        }
    chop @t;
return @t
}

sub div{
    my ($n, $k)=@_;
return ($n - $n % $k) / $k
}

sub uniq{
    my @m=sort @_;
    push @u, my $i=shift @m;
    for (@m){
        $i eq $_ or push @u, $_;
        $i=$_;
        }
return @u
}

sub max{
    my $max=shift;
    $max<$_ and $max=$_ for @_;
return $max
}

sub min{
    my $min=shift;
    $min>$_ and $min=$_ for @_;
return $min
}

# count (kas_ieskoma, masyvas)
sub count{
    my $i=0;
    $_ eq $_[0] and $i++ for @_;
return --$i
}


$_=<>;
$a=<>;
$b=<>;
chomp($a,$b,$_);
$a1=join '',reverse split'',$a;
$b1=join '',reverse split'',$b;
print "both" and exit if /$a.*$b/ and /$b1.*$a1/;
print "forward" and exit if /$a.*$b/;
print "backward" and exit if /$b1.*$a1/;
print "fantasy";

$_=<>;
$a=<>;
$b=<>;
chomp($a,$b);
$a1 = reverse $a;
$b1 = reverse $b;
print "both" and exit if /$a.*$b/ and /$b1.*$a1/;
print "forward" and exit if /$a.*$b/;
print "backward" and exit if /$b1.*$a1/;
print "fantasy";

$ch=<>;
chomp$ch;
$str1=<>;
chomp$str1;
$str2=<>;
chomp$str2;
$ok1=0,$ok2=0;
if($ch=~m/$str1.*$str2/){
$ok1=1;
}
if(reverse($ch)=~m/$str1.*$str2/){
$ok2=1;
}
if($ok2+$ok1==2){
print "both";
}
elsif($ok1){
print"forward";
}
elsif($ok2){
print"backward"
}
else{
print "fantasy";
}

#!/bin/perl -w
use strict;
use warnings;

my $s = <>;
chomp $s;
my $s1 = <>;
chomp $s1;
my $s2 = <>;
chomp $s2;
my $fb = 0;

$fb += 1 if ($s =~ m/$s1.*$s2/);
$s = reverse $s;
$fb += 2 if ($s =~ m/$s1.*$s2/);
if ($fb == 3) {
    print "both\n";
} elsif ($fb == 2) {
    print "backward\n";
} elsif ($fb == 1) {
    print "forward\n";
} else {
    print "fantasy\n";
}

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

my $flags=<STDIN>;chomp($flags);my $one=<STDIN>;chomp($one);my $two=<STDIN>;chomp($two);
my $sgalf=reverse $flags;
if($flags=~/\A.*?$one.*?$two/&&$sgalf=~/\A.*?$one.*?$two/){print "both\n";}
elsif($flags=~/\A.*?$one.*?$two/){print "forward\n";}
elsif($sgalf=~/\A.*?$one.*?$two/){print "backward\n";}
else{print "fantasy\n";}

$_=<>;
$a=<>;
$b=<>;
chomp($a,$b,$_);
print "both" and exit if /$a.*$b/ and /$b.*$a/;
print "forward" and exit if /$a.*$b/;
print "backward" and exit if /$b.*$a/;
print "fantasy";

$_=<>;
$a=<>;
$b=<>;
chomp($a,$b);
print "both" and exit if /$a.*$b/ and /$b.*$a/;
print "forward" and exit if /$a.*$b/;
print "backward" and exit if /$b.*$a/;
print "fantasy";

$ch=<>;
chomp$ch;
$str1=<>;
chomp$str1;
$str2=<>;
chomp$str2;
$ok1=0,$ok2=0;
if($ch=~m/$str1.*$str2/){
$ok1=1;
}
if($ch=~m/$str2.*$str1/){
$ok2=1;
}
if($ok2+$ok1==2){
print "both";
}
elsif($ok1){
print"forward";
}
elsif($ok2){
print"backward"
}
else{
print "fantasy";
}

$ch=<>;
chomp$ch;
$str1=<>;
chomp$str1;
$str2=<>;
chomp$str2;
$ok1=0,$ok2=0;
if($ch=~m/$str1.*$str2/){
$ok1=1;
}
if(reverse($ch)=~m/$str2.*$str1/){
$ok2=1;
}
if($ok2+$ok1==2){
print "both";
}
elsif($ok1){
print"forward";
}
elsif($ok2){
print"backward"
}
else{
print "fantasy";
}

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

my $flags=<STDIN>;chomp($flags);my $one=<STDIN>;chomp($one);my $two=<STDIN>;chomp($two);
if($flags!~/$one/||$flags!~/$two/){print "fantasy\n";}
else{
    my $sgalf=reverse $flags;
    my $fone=$flags=~s/\A.*?$one//r;my $ftwo=$sgalf=~s/\A.*?$one//r;
    if($fone=~/$two/&&$ftwo=~/$two/){print "both\n";}
    elsif($fone!~/$two/&&$ftwo!~/$two/){print "fantasy\n";}
    else{
	my $ans=($fone=~/$two/)?"forward\n":"backward\n";
	print $ans;
    }
}

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

my $flags=<STDIN>;chomp($flags);my $one=<STDIN>;chomp($one);my $two=<STDIN>;chomp($two);
my $fone=$flags=~s/\A.*$one//r;my $ftwo=$flags=~s/$fone//r;
if($flags!~/$one/||$flags!~/$two/){print "fantasy\n";}
else{
    if($fone=~/$two/&&$ftwo=~/$two/) {print "both\n";}
    else{
	if($fone!~/$two/&&$ftwo!~/$two/){print "fantasy\n";}
	else{
	    if($fone=~/$two/){print "forward\n";}
	    else{ print "backward\n";}
	}
    }
}

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

my $flags=<STDIN>;chomp($flags);my $one=<STDIN>;chomp($one);my $two=<STDIN>;chomp($two);
my $fone=$flags=~s/\A.*$one//r;my $ftwo=$flags=~s/$fone//r;
if($fone=~/$two/&&$ftwo=~/$two/) {print "both\n";}
else{
    if($fone!~/$two/&&$ftwo!~/$two/){print "fantasy\n";}
    else{
	if($fone=~/$two/){print "forward\n";}
	else{ print "backward\n";}
    }
}

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

my $flags=<STDIN>;chomp($flags);my $one=<STDIN>;chomp($one);my $two=<STDIN>;chomp($two);
my $fone=$flags=~s/\A.*?$one//r;my $ftwo=$flags=~s/$fone//r;
if($flags!~/$one/||$flags!~/$two/){print "fantasy\n";}
else{
    if($fone=~/$two/&&$ftwo=~/$two/) {print "both\n";}
    else{
	if($fone!~/$two/&&$ftwo!~/$two/){print "fantasy\n";}
	else{
	    if($fone=~/$two/){print "forward\n";}
	    else{ print "backward\n";}
	}
    }
}


print substr 'aabb' x ($_ / 4 + 1), 0, $_ for <>


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	my( $n, $k1, $k2 ) = split;

	chomp( my $s1 = <> );
	chomp( my $s2 = <> );

	print $s1 =~ /\b$n\b/ ? "YES" : "NO";
	}


($n, $d) = split ' ', <>;
$d1 = '1' x $n;
for (<>) {
	chomp;
	$period .= ($_ eq $d1? '1': '0');
}
$maxlen = 0;
while ($period =~ /0+/g) {
	$len = length($&);
	$maxlen = $len > $maxlen? $len: $maxlen;
}
print $maxlen, "\n";


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	chomp;
	my $A = <>;
	chomp $A;
	my $B = <>;
	chomp $B;

	my $invA = $A =~ y/10/01/r;

	if( $A ne $B and $invA ne $B ){
		print 'NO';
		next;
		}

	print 'YES';

	my $cA = () = $A =~ m/1/g;

	my @ans;

	while( $A =~ m/1/g ){
		push @ans, join ' ', map $_ + 1, $-[0], $+[0] - 1;
		}

	if( $A eq $B ){
		if( $cA % 2 == 1 ){
			push @ans, "1 $_", "1 1", "2 $_";
			}
		else{
			;
			}
		}
	else{
		if( $cA % 2 == 1 ){
			;
			}
		else{
			push @ans, "1 $_", "1 1", "2 $_";
			}
		}

	print for @ans;
	}


my $t=readline STDIN;
chomp $t;
while ($t) {
    my $line= readline STDIN; chomp $line;
    my ($a,$b)=split / /,$line;

    if ($a<$b) { ($b,$a)=($a,$b); }
    if ($a==$b) { print (($a<<1)**2)}
    elsif ($b==1) { print (($a)**2); }
    elsif (($a/2) >= $b) {  print ($a**2); }
    else {
        print (($b<<1)**2);
    }
    print "\n";
    $t--;
}

#perl 5.26.1

$n = <STDIN>;
chomp $n;
@ip = <STDIN>;
chomp @ip;
foreach (@ip) {
    @test = split(' ', $_);
    if ($test[0] > $test[1]) {
        $dummy = 2*$test[1];
        if ($dummy > $test[0] || $dummy == $test[0]) {
            $ans = $dummy*$dummy;
            print "$ans\n";
        }else {
            $ans = $test[0]*$test[0];
            print "$ans\n";
        }
    }elsif ($test[0] < $test[1]) {
        $dummy = 2*$test[0];
        if ($dummy > $test[1] || $dummy == $test[1]) {
            $ans = $dummy*$dummy;
            print "$ans\n";
        }else {
            $ans = $test[1]*$test[1];
            print "$ans \n";
        }
    }else {
        $ans = (2*$test[0])*(2*$test[0]);
        print "$ans \n";
    }
}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

my $debug = 0;

while(<>){
	chomp;

	my $len = length;

	$debug and print $len;

	my $part = 1;

	while( $len / $part > 20 ){
		$part ++;
		}

	$debug and print $part;

	my $chunk = $len / $part;
	$debug and print $chunk;

	if( $chunk !~ /\./ ){
		;
		}
	else{
		my $plus = ( 1 + int $chunk ) * $part - $len;

		$debug and print $plus;

		my $int = int $chunk;

		s/.{$int}\K/ $plus -- > 0 ? '*' : '' /eg;
		$chunk = 1 + int $chunk;
		}

	$debug and print;

	@_ = /.{$chunk}/g;

	print join ' ', ~~ @_, $chunk;

	print for @_;
	}

#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

my $debug = 0;

while(<>){
	chomp;

	my $len = length;

	$debug and print $len;

	my $part = 1;

	while( $len / $part > 20 ){
		$part ++;
		}

	$debug and print $part;

	my $chunk = $len / $part;
	$debug and print $chunk;

	if( $chunk !~ /\./ ){
		;
		}
	else{
		my $plus = ( 1 + int $chunk ) * $part - $len;

		$debug and print $plus;

		my $int = int $chunk;

		$plus --, s/.{$int}\K/\*/ while $plus;
		$chunk = 1 + int $chunk;
		}

	$debug and print;

	@_ = /.{$chunk}/g;

	print join ' ', ~~ @_, $chunk;

	print for @_;
	}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	chomp;
	print for $_, join ' ', ( 1 ) x $_;
	}

use 5.20.1;
use strict;
my $n = <STDIN>;
say $n;
say "1" until ($n-- < 1);

#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	@_ = sort { $a <=> $b } split ' ', <>;

	my @cand;

	for my $cand ( 1 .. 100 ){
		my $sum = 0;
		for( @_ ){
			my $x = abs( $cand - $_ ) - 1;
			$x < 0 and $x = 0;
			$sum += $x;
			}
		push @cand, [ $cand, $sum ];
		}

	print "@{ ( sort { $a->[ 1 ] <=> $b->[ 1 ] } @cand )[ 0 ] }";
	}


#!/usr/bin/env perl

use strict;
use warnings;
no warnings 'uninitialized';

my $N = <>+0;

my $line = <>;
chomp $line;
my @A = split ' ', $line;
my %S = ();
foreach my $x (@A) {
   ++$S{ int($x) };
}

$line = <>;
chomp $line;
my @B = split ' ', $line;
foreach my $x (@B) {
   --$S{ int($x) };
   delete $S{ int($x) } unless $S{ int($x) }
}
foreach my $k (keys(%S)) {
   print $k, "\n"
}

%S = ();
foreach my $x (@B) {
   ++$S{ int($x) };
}

$line = <>;
chomp $line;
my @C = split ' ', $line;
foreach my $x (@C) {
   --$S{ int($x) };
   delete $S{ int($x) } unless $S{ int($x) }
}
foreach my $k (keys(%S)) {
   print $k, "\n"
}

<>;
my %hash;
my %hash2;
$hash{int$_}++ for(split / /, <>);
$hash2{int$_}++, $hash{int$_}-- for(split / /, <>);
$hash2{int$_}-- for(split / /, <>);
print grep{$hash{$_} == 1} keys %hash;
print "\n";
print grep{$hash2{$_} == 1} keys %hash2;

chomp (my @s = split /\s+/, <STDIN>);
chomp (my @i = sort {$a <=> $b} split /\s+/, <STDIN>);
chomp (my @j = sort {$a <=> $b} split /\s+/, <STDIN>);
chomp (my @k = sort {$a <=> $b} split /\s+/, <STDIN>);

my $x;
for ($x = 0; $x < @j; $x++) {
  if ($i[$x] != $j[$x]) {
    printf "$i[$x]\n";
    last;
  }
}
printf "$i[$x]\n" if ($x == @j);
for ($x = 0; $x < @k; $x++) {
  if ($j[$x] != $k[$x]) {
    printf "$j[$x]\n";
    last;
  }
}
printf "$j[$x]\n" if ($x == @k);

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

sub get_missing{
    my ($total, $cur) = ($_[0], $_[1]);
    my %hash1; my %hash2;
    foreach(@{$total}){
        $hash1{$_} = 0 unless exists $hash1{$_};
        $hash2{$_} = 0 unless exists $hash2{$_};
        $hash1{$_}++;
    }
    foreach(@{$cur}){
        $hash2{$_}++;
    }
    foreach(keys %hash1){
        return $_ if $hash2{$_} < $hash1{$_};
    }
    return -1;
}
###############################

my $n = <>;
my @total = split ' ',<>;
my @cur = split ' ' , <>;
my $res1 = get_missing(\@total,\@cur);

@total = @cur;
@cur = split ' ' , <>;
my $res2 = get_missing(\@total,\@cur);

print "$res1\n$res2";

<>;
print join $/, map eval, (join '-', map {eval join '+', split} <>) =~ /(?=(\d+-\d+))/g

<>;
my $n = <>;
my %hash;
$hash{int$_}++ for(split / /, <>);
$hash{int$_}++ for(split / /, <>);
$hash{int$_}++ for(split / /, <>);
print grep{$hash{$_} == 1} keys %hash;
print "\n";
print grep{$hash{$_} == 2} keys %hash;


#!/usr/bin/perl

use strict;

my ($n, $m) = split (" ",<STDIN>);
my (%rows,%cols,@result);
for (my $i=0;$i<$m;$i++){
    my ($row, $col) = split(" ",<STDIN>);
    $rows{$row} = 1;
    $cols{$col} = 1;
    push @result,(($n - keys(%rows))*($n - keys(%cols)));
}
print join " ", @result;


#!/bin/perl

use strict;

my $cases = +<>;

while ($cases--) {
  my $line = <>;

  my ($a, $b, $found1) = (0, 0, 0);
  for (my $i = 0; $i < length($line) - 1; $i++) {
    if (substr($line, $i, 1) eq '1') {
      $found1 = 1;
      $b = $a;
    } elsif ($found1) {
      $a++;
    }
  }
  print "$b\n";
}

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/ say /;

use Carp;

# essential
my @tokens = ();

sub ceil {
    my $n = shift;
    my $in = int($n);
    return $n if $in == $n;
    return $in + 1;
}

sub read_line {
    chomp (my $line = <STDIN>);
    return $line;
}

sub read_token {
    @tokens = split q{ }, read_line() if @tokens == 0;
    return shift @tokens;
}

sub min {
    my @numbers = @_;
    my $min = shift @numbers;
    for ( @numbers ) {
        $min = $min<$_ ? $min : $_;
    }
    return $min;
}

sub max {
    my @numbers = @_;
    my $max = shift @numbers;
    for ( @numbers ) {
        $max = $max > $_ ? $max : $_;
    }
    return $max;
}

sub sum {
    my @numbers = @_;
    my $sum = 0;
    for (@numbers) {
        $sum += $_;
    }
    return $sum;
}

sub ref_ref_scalar {
    my $ref = shift;
    return 1 if ref($ref) eq 'SCALAR';
}

sub toggle {
    my $ref = shift;
    croak "$ref does not reference to scalar" if !ref_ref_scalar($ref);

    $$ref = !$$ref;
}

sub odd {
    my $num = shift;
    return $num % 2 == 1;
}

sub even {
    my $num = shift;
    return $num % 2 == 0;
}

sub sum_of_digits {
    my $n = shift;
    my @numbers = split q{}, $n;

    my $sum = 0;

    for (@numbers) {
        $sum += $_;
    }

    return $sum;
}

# solution

sub count_zero {
    my $str = shift;
    my @chars = split q{}, $str;
    my $count = 0;
    for (@chars) {
        $count++ if $_ eq '0';
    }
    return $count;
}

my $n = read_token;

for (1..$n) {
    my $s = read_line;
    while ($s and substr($s, 0, 1) eq '0') {
        $s = substr($s, 1);
    }
    if (!$s) {
        say 0;
        next;
    }

    while ($s and substr($s, length($s)-1, 1) eq '0') {
        $s = substr($s, 0, length($s)-1);
    }

    say count_zero($s);
}

#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	chomp;

	s/^0+//;
	s/0+$//;

	print length y/1//dr;
	}


#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/ say /;

chomp (my $line = <STDIN>);
my $t = $line;

for ( 1..$t ) {
    chomp ($line = <STDIN>);
    my ($a, $b, $n) = split q{ }, $line;
    my $c = int($a) ^ int($b);
    my $mod = $n % 3;
    if ( $mod == 0 ) {
        say $a;
    }
    elsif ( $mod == 1 ) {
        say $b;
    }
    else {
        say $c;
    }
}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;
my $debug = 0;

while(<>){

	my %h;

	map {
		my( $u, $v ) = split ' ', <>;
		$h{ $u }{ $v } = 1;
		$h{ $v }{ $u } = 1;
		} 1 .. $_ - 1;

	my $color = 'C';
	my @keys;
	( $keys[ 0 ] ) = sort keys %h;
	push @keys, $color;

	my @color;
	my $i = 0;
	while( @keys ){
		$debug and print "keys:[@keys]";
		my $key = shift @keys;
		$key eq $color and do {
			push @keys, $color if @keys and $keys[ -1 ] ne $color;
			$i ++;
			next;
			};
		$color[ $i % 2 ] ++;
		my @new_keys = keys %{ $h{ $key } };
		delete $h{ $_ }{ $key } for @new_keys;
		push @keys, @new_keys;
		}

	$debug and print "color:[@color]";
	print 1 - $_ + eval join ' * ', @color;
	}


$n = <>;
$line = <>;
@list = split(/\s/, $line);
$total = 0;
foreach $x (@list) {
    $total += $x;
}
$i = 0;
$len = $n - 1;
$dir = 1;
while ($total) {
    if ($list[$i]) {
        $list[$i] -= 1;
        $total -= 1;
        print 'P';
    }
    if ($i == 0) {
        $dir = 1;
    }
    elsif ($i == $len) {
        $dir = -1;
    }
    $i += $dir;
    if ($dir > 0) {print 'R';}
    else {print 'L';}
}


use warnings;
use strict;

my $n = <>;
print join " ", $n..$n*2-1;

use warnings;

my $n = <STDIN>;

for (my $i = 1e+6; $i < 1e+6 + $n; $i++) {
    print $i . " ";
}

#!/usr/bin/perl

use strict;

my $n = <>;

print join " ", $n .. $n * 2 - 1;

use warnings;

my $n = <STDIN>;

for (my $i = 1e+7; $i < 1e+7 + $n; $i++) {
    print $i . " ";
}


#!usr/bin/perl

use strict;
use warnings;

<> =~ m/(d+)/;
my $n = $1;

my @inputlog = ();
my @flaglog = ();
my @log = ();

my @pairrefs = (["", ""]);
while (<>) {
	chomp;
	push @inputlog, $_;
	unless (defined $pairrefs[length]) {
		$pairrefs[length] = [$_];
		push @flaglog, "first-in-its-length";
	} else {
		push @{$pairrefs[length]}, $_;
		push @flaglog, "second-in-its-length";
	}
}

#print "- @{$pairrefs[0]}\n";
#print "- @{$pairrefs[1]}\n";
#print "- @{$pairrefs[2]}\n";
#print "- @{$pairrefs[3]}\n";

#my @pairrefs2 = (["e", "k"], ["te", "ko"], ["kor", "rte"], ["orte", "kort"]);

my @prefs = ("");
my @suffs = ("");

my $flag = "prefix-suffox-order";

if ($flag eq "prefix-suffox-order") {
	my $length = 0;
	@log = ("-");
	foreach my $pairref (@pairrefs) {
		my ($string1, $string2) = @$pairref; #print "$string1 | $string2\n";

		if ($length > 0) {
			my $previously = $length - 1;
			if (is_prefix_of($prefs[$previously], $string1) && is_suffix_of($suffs[$previously], $string2)) {
				$prefs[$length] = $string1;
				$suffs[$length] = $string2;
				$log[$length] = "PS";
			} elsif (is_prefix_of($prefs[$previously], $string2) && is_suffix_of($suffs[$previously], $string1)) {
				$prefs[$length] = $string2;
				$suffs[$length] = $string1;
				$log[$length] = "SP";
			} else {
				$flag = "suffix-prefix-order";
				last;
			}
		}
		$length++;
	}
}

if ($flag eq "suffix-prefix-order") {
	my $length = 0;
	@log = ("-");
	foreach my $pairref (@pairrefs) {
		my ($string1, $string2) = @$pairref; #print "$string1 | $string2\n";

		if ($length > 0) {
			my $previously = $length - 1;
			if (is_prefix_of($prefs[$previously], $string2) && is_suffix_of($suffs[$previously], $string1)) {
				$prefs[$length] = $string2;
				$suffs[$length] = $string1;
				push @log, "SP";
			} elsif (is_prefix_of($prefs[$previously], $string1) && is_suffix_of($suffs[$previously], $string2)) {
				$prefs[$length] = $string1;
				$suffs[$length] = $string2;
				push @log, "PS";
			} else {
				$flag = "prefix-suffix-order";
				last;
			}
		}
		$length++;
	}
}

#print "Prefs: "; print join ", ", @prefs; print "\n";
#print "Suffs: "; print join ", ", @suffs; print "\n";
#print "Order: $flag\n";
#print "Log: @log\n";

#print "Result: ";
foreach my $i (keys @inputlog) {
	my $length = length $inputlog[$i];
	if ($flaglog[$i] eq 'first-in-its-length') {
		print substr($log[$length], 0, 1);
	} else {
		print substr($log[$length], 1, 1);
	}
}
print "\n";

sub is_prefix_of {
	my ($part, $whole) = @_;
	return (substr $whole, 0, length $part) eq $part;
}

sub is_suffix_of {
	my ($part, $whole) = @_;
	return 1 if $part eq "";
	return (substr $whole, -length $part) eq $part;
}

#!usr/bin/perl

use strict;
use warnings;

<> =~ m/(d+)/;
my $n = $1;

my @inputlog = ();
my @flaglog = ();
my @log = ();

my @pairrefs = (["", ""]);
while (<>) {
	chomp;
	push @inputlog, $_;
	unless (defined $pairrefs[length]) {
		$pairrefs[length] = [$_];
		push @flaglog, "first-in-its-length";
	} else {
		push @{$pairrefs[length]}, $_;
		push @flaglog, "second-in-its-length";
	}
}

#print "- @{$pairrefs[0]}\n";
#print "- @{$pairrefs[1]}\n";
#print "- @{$pairrefs[2]}\n";
#print "- @{$pairrefs[3]}\n";

#my @pairrefs2 = (["e", "k"], ["te", "ko"], ["kor", "rte"], ["orte", "kort"]);

my @prefs = ("");
my @suffs = ("");

my $flag = "prefix-suffox-order";

if ($flag eq "prefix-suffox-order") {
	my $length = 0;
	@log = ("-");
	foreach my $pairref (@pairrefs) {
		my ($string1, $string2) = @$pairref; #print "$string1 | $string2\n";

		if ($length > 0) {
			my $previously = $length - 1;
			if (is_prefix_of($prefs[$previously], $string1) && is_suffix_of($suffs[$previously], $string2)) {
				$prefs[$length] = $string1;
				$suffs[$length] = $string2;
				$log[$length] = "PS";
			} elsif (is_prefix_of($prefs[$previously], $string2) && is_suffix_of($suffs[$previously], $string1)) {
				$prefs[$length] = $string2;
				$suffs[$length] = $string1;
				$log[$length] = "SP";
			} else {
				$flag = "suffix-prefix-order";
				last;
			}
		}
		$length++;
	}
}

if ($flag eq "suffix-prefix-order") {
	my $length = 0;
	@log = ("-");
	foreach my $pairref (@pairrefs) {
		my ($string1, $string2) = @$pairref; print "$string1 | $string2\n";

		if ($length > 0) {
			my $previously = $length - 1;
			if (is_prefix_of($prefs[$previously], $string2) && is_suffix_of($suffs[$previously], $string1)) {
				$prefs[$length] = $string2;
				$suffs[$length] = $string1;
				push @log, "SP";
			} elsif (is_prefix_of($prefs[$previously], $string1) && is_suffix_of($suffs[$previously], $string2)) {
				$prefs[$length] = $string1;
				$suffs[$length] = $string2;
				push @log, "PS";
			} else {
				$flag = "prefix-suffix-order";
				last;
			}
		}
		$length++;
	}
}

#print "Prefs: "; print join ", ", @prefs; print "\n";
#print "Suffs: "; print join ", ", @suffs; print "\n";
#print "Order: $flag\n";
#print "Log: @log\n";

#print "Result: ";
foreach my $i (keys @inputlog) {
	my $length = length $inputlog[$i];
	if ($flaglog[$i] eq 'first-in-its-length') {
		print substr($log[$length], 0, 1);
	} else {
		print substr($log[$length], 1, 1);
	}
}
print "\n";

sub is_prefix_of {
	my ($part, $whole) = @_;
	return (substr $whole, 0, length $part) eq $part;
}

sub is_suffix_of {
	my ($part, $whole) = @_;
	return 1 if $part eq "";
	return (substr $whole, -length $part) eq $part;
}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	my( $A, $B, $k ) = split;

	my @A = split ' ', <>;
	my @B = split ' ', <>;

	my %h;
	my %g;

	while( @A ){
		my $A = shift @A;
		my $B = shift @B;

		$h{ $A }{ $B } ++;
		$g{ $B }{ $A } ++;
		}

	my $cnt = 0;

	for my $key ( sort { $a <=> $b } keys %h ){
		my $k1 = $k - keys %{ $h{ $key } };

		for my $key_back ( sort { $a <=> $b } keys %{ $h{ $key } } ){
			$cnt += $k1 - ( keys %{ $g{ $key_back } } ) + 1;
			}
		}

	print $cnt / 2;
	}


#!/usr/bin/perl -w

use strict;
use List::Util qw(max min);

chomp($_ = <>);
my ($max, $min, $count) = (0, 0, 0);
for my $i (split //) {
    if ($i eq '+') {
        ++$count;
    } else {
        --$count;
    }
    $max = max($max, $count);
    $min = min($min, $count);
}
print $max - $min, "\n";


use 5.016;
use strict;
use warnings;

<>;
my @boys = sort { $a <=> $b } split ' ', <>;
<>;
my @girls = sort { $a <=> $b } split ' ', <>;

my $c = 0;

while (@boys && @girls) {
  if (abs($boys[0] - $girls[0]) <= 1) {
    shift @boys;
    shift @girls;
    $c++;
  } elsif ($boys[0] < $girls[0]) {
    shift @boys;
  } else {
    shift @girls;
  }
}

say $c;


# Find out how many Bulbasaurs we can catch
# Solution:
use strict;
use warnings;
my $newspaper = <>;
my %letter;
my $bulbies = 0;
foreach(split//,$newspaper)
{
	if(exists($letter{$_}))
	{
		$letter{$_} += 1;
		if($bulbies < $letter{$_})
		{
			$bulbies = $letter{$_};
		}
	}
	else
	{
		$letter{$_} = 1;
		if($bulbies == 0)
		{
			$bulbies = 1;
		}
	}
}
if(exists($letter{"a"}))
{
	$letter{"a"} = int($letter{"a"}/2);
}
if(exists($letter{"u"}))
{
	$letter{"u"} = int($letter{"u"}/2);
}
foreach(split//,"Bulbasr")
{
	if(exists($letter{$_}))
	{
		if($bulbies > $letter{$_})
		{
			$bulbies = $letter{$_}
		}
	}
	else
	{
		$bulbies = 0;
	}
}
print int($bulbies);

use v5.20;
use warnings;

sub min {
	my $ret = $_[0];
	foreach my $it (@_) {
		if ($ret > $it) {
			$ret = $it;
		}
	}
	return $ret;
}

my @fr = (0) x 300;

$_ = <>;

foreach my $it (split '') {
	$fr[ord $it] += 1;
}

say min($fr[ord 'B'],int ($fr[ord 'a']/2),$fr[ord 'b'],$fr[ord 's'],$fr[ord 'l'],$fr[ord 'r'],int ($fr[ord 'u']/2));

use v5.20;

sub minn {
	my ($a, $b) = @_;
	if ($a < $b) {
		return $a;
	}
	return $b;
}

my $target = "uaBlbsr";
my %ap = map { $_ => 0 } (0..length($target));

my $text = <>;
for (my $i = 0; $i < length $text; $i++) {
	my $ind = index($target, substr($text, $i, 1));
	if ($ind != -1) {
		$ap{$ind}++;
	}
}

my $mn = int(minn($ap{0} / 2, $ap{1} / 2));
for (my $i = 2; $i < length $target; $i++) {
	$mn = minn($mn, $ap{$i});
}

say $mn;

use warnings;

sub min {
	my $ans = $_[0];

	foreach my $i (@_) {
		if ($ans > $i) {
			$ans = $i;
		}
	}

	return $ans;
}

my @fr = (0) x 128;

my $text = <STDIN>;
chomp($text);

for (my $i = 0; $i < length $text; ++$i) {
	++$fr[ord(substr($text, $i, 1))];
#	print substr($text, $i, 1);
}

printf("%d", min($fr[ord('B')], $fr[ord 'a']/2, $fr[ord 'b'], $fr[ord 's'], $fr[ord 'l'], $fr[ord 'r'], $fr[ord 'u']/2));

#use v5.24;
use warnings;
my %fr;

my $line=<stdin>;
chomp($line);
my @word=split(//,$line);
for (my $i=ord("A");$i<=ord("z");$i++){
	$fr{chr($i)}=0;
}
foreach my $lit (@word){
	$fr{$lit}++;
}
$fr{"u"}=int $fr{"u"}/2;
$fr{"a"}=int $fr{"a"}/2;
my @key=("B","u","l","b","a","s","a","u","r");
my $min=100006;
foreach my $lit (@key){
	if ($min>$fr{$lit}) {$min=$fr{$lit}};
}
print $min;
<stdin>;
exit(0);

#Bulbasaur

use v5.20.1;
use warnings;

=pod
my $filename = "date.in";
open(my $fh, '<:encoding(UTF-8)', $filename)
	or die "Could not open the file";
=cut

my $line = <STDIN>;
chomp($line);

my @input = split('', $line);

my %letters = (

	'B' => 0,
	'u' => 0,
	'l' => 0,
	'b' => 0,
	'a' => 0,
	's' => 0,
	'r' => 0,

);

for(my $i = 0; $i < @input; $i++){

	if( index("Bulbasr", $input[$i]) != -1 ){

		$letters{$input[$i]}++;

	}

}

my $mini = 100002;

while(my ($key, $value) = each(%letters)){

	if( ($key eq 'a' || $key eq 'u') && int($value/2) < $mini ){

		$mini = int($value/2);

	}elsif($key ne 'a' && $key ne 'u' && $value < $mini){

		$mini = $value;

	}

}

say $mini;

use warnings;

use v5.20;

my @frecv;
my @word = ('B','u','l','b','a','s','a','u','r');
my $solution = 1000000;

my $input = <STDIN>;
chomp $input;
my @chars = split("", $input);

for(my $i = 0; $i < length $input; $i += 1){
    my $c = ord($chars[$i]);
    $frecv[$c]++;
}

for(my $i = 0; $i < 9; $i += 1){
    my $c = $word[$i];
    my $poz = ord($word[$i]);
    unless(defined $frecv[$poz]) {
        $solution = 0;
        last;
    }
    if($c eq 'a' || $c eq 'u'){
        if(int($frecv[$poz] / 2) < $solution){
            $solution = int($frecv[$poz] / 2);
        }
    }
    elsif($frecv[$poz] < $solution){
        $solution = $frecv[$poz];
    }

}
print("$solution\n");

use feature "say";

$text = <>;
@matches;
@target = ( "B", "u", "l", "b", "a", "s", "r" );
for ($i = 0; $i < scalar ( @target ); ++$i) {
	$matches[$i] = () = $text =~ /$target[$i]/g;
}
$matches[1] /= 2;
$matches[4] /= 2;
@matches = sort( { $a <=> $b } @matches );
say int $matches[0];

#!/usr/bin/perl

use strict;
use warnings;

my $string = <>;
chomp($string);

my %validLetters = ('B' => 0, 'u' => 0, 'l' => 0, 'b' => 0, 'a' => 0, 's' => 0, 'r' => 0);
for (my $i = 0; $i < length($string); $i++) {
  my $char = substr($string, $i, 1);
  if (exists($validLetters{$char})) {
    $validLetters{$char} += 1;
  }
}

my $count = 0;

my $possible = 1;
while ($possible) {
  foreach my $key (keys(%validLetters)) {
    if ($key eq 'a' || $key eq 'u') {
      if ($validLetters{$key} < 2) {
        $possible = 0;
      } else {
        $validLetters{$key} -= 2;
      }
    } else {
      if ($validLetters{$key} < 1) {
        $possible = 0;
      } else {
        $validLetters{$key} -= 1;
      }
    }
  }

  if ($possible) {
    $count++;
  }
}

print $count, "\n";

#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	chomp;
	my %h;

	map { ++$h{ $_ } } split //;

	my @occ;

	push @occ, 2 * $h{ $_ } for split //, 'Blbsr';
	push @occ, $h{ $_ } for split //, 'au';

	my $min = ( sort { $a <=> $b } @occ )[ 0 ];
	print int $min / 2;

	}

$w = "Bulbbasaur";
$h{$_} = 0 for split //, $w;
while ( sysread(STDIN, $c, 1) ) {
	$n = () = $w =~ /$c/g;
	if ($n) {
		$h{$c} += 1/$n;
	}
}
@ans = sort {$a <=> $b} values %h;
$ans = $ans[0] || 0;
print $ans;

while ( sysread(STDIN, $c, 1) ) {
	$n = () = "Bulbasaur" =~ /$c/g;
	if ($n) {
		$h{$c} += 1/$n;
	}
}
@ans = sort {$a <=> $b} values %h;
$ans = $ans[0] || 0;
print $ans;

# Find the biggest subarray with GCD higher than 1
# Solution: http://codeforces.com/problemset/submission/757/55701579
my $poke_nr = <>;
my %pokemons;
my @numbers = split(" ", <>);
my $biggest_poke = 0;
my $max_poke = 0;
my $current_max = 0;
foreach(@numbers)
{
	if(exists($pokemons{$_}))
	{
		$pokemons{$_} = $pokemons{$_} + 1;
	}
	else
	{
		$pokemons{$_} = 1;
		if($_ > $biggest_poke)
		{
			$biggest_poke = $_;
		}
	}
}
foreach my $i(2 .. $biggest_poke)
{
	$current_max = 0;
	for(my $j = $i; $j <= $biggest_poke; $j += $i)
	{
		if(exists($pokemons{$j}))
		{
			$current_max += $pokemons{$j};
		}
	}
	if($current_max > $max_poke)
	{
		$max_poke = $current_max;
	}
}
if($max_poke > 0)
{
	print $max_poke;
}
else
{
	if(exists($pokemons{1}))
	{
		print 1;
	}
	else
	{
		print 0;
	}

}

# Find out how many Bulbasaurs we can catch
# Solution:
use strict;
use warnings;
my $newspaper = <>;
my %letter;
my $bulbies = 0;
foreach(split//,$newspaper)
{
	if(exists($letter{$_}))
	{
		$letter{$_} = $letter{$_} + 1;
		if($bulbies < $letter{$_})
		{
			$bulbies = $letter{$_};
		}
	}
	else
	{
		$letter{$_} = 1;
		if($bulbies == 0)
		{
			$bulbies = 1;
		}
	}
}
foreach(split//,"Bulbasr")
{
	if(exists($letter{$_}))
	{
		if($_ eq "a" or $_ eq "b"){
			if($bulbies > $letter{$_} / 2)
			{
				$bulbies = $letter{$_} / 2;
			}
		}
		else
		{
			if($bulbies > $letter{$_})
			{
				$bulbies = $letter{$_}
			}
		}
	}
	else
	{
		$bulbies = 0;
	}
}
print $bulbies;

$,=" ";

my %c;
map {$c{$_}++ }split //, "Bulbasaur";
my %d;

my $w=<>;
chomp($w);
map {$d{$_}++ }split //, $w;
for my $t (keys %c)
{
$d{$t}=int($d{$t}/$c{$t});
}

print min(values %d) , "\n";

sub min
{
my $ans=shift;
while(@_)
{
my $temp=shift;
$ans=$temp if($ans>$temp);
}
return $ans;
}

$_ = <>;
$B = 'Bulbasaur' x 2e1;
$i += $c eq 'B' while ($c = chop $B) && s/$c//;
print 0 + $i

$B = 'Bulbasaur' x 2e4;
$i += $c eq 'B' while ($c = chop $B) && s/$c//;
print 0 + $i

use v5.20;
my $buffer = <>;
chomp( $buffer );
my @arr = split //, $buffer;
my @fv = ();
for( my $i = 0 ; $i < length $buffer ; $i++ ) {
	$fv [$arr[ $i ]] ++;
}
my $ans = @fv[ ord('B') ];
$ans = $ans <= $fv[ ord('u') ] / 2 ? $ans : $fv[ ord('u') ] / 2;
$ans = $ans <= $fv[ ord('l') ] ? $ans : $fv[ ord('l') ];
$ans = $ans <= $fv[ ord('b') ] ? $ans : $fv[ ord('b') ];
$ans = $ans <= $fv[ ord('a') ] / 2 ? $ans : $fv[ ord('a') ] / 2;
$ans = $ans <= $fv[ ord('s') ] ? $ans : $fv[ ord('s') ];
$ans = $ans <= $fv[ ord('r') ] ? $ans : $fv[ ord('r') ];
say int($ans);

use v5.20;
use warnings;

sub min {
	my $ret = shift @_;
	foreach my $it (@_) {
		if ($ret > $it) {
			$ret = $it;
		}
	}
	return $ret;
}

my @fr = (0) x 300;

$_ = <>;

foreach my $it (split '') {
	$fr[ord $it] += 1;
}

say min($fr[ord 'B'],int ($fr[ord 'a']/2),$fr[ord 'b'],$fr[ord 's'],$fr[ord 'l'],$fr[ord 'r'],int ($fr[ord 'u']));

use v5.20;

sub minn {
	my ($a, $b) = @_;
	if ($a < $b) {
		return $a;
	}
	return $b;
}

my $target = "uaBlbsr";
my %ap = map { $_ => 0 } (0..length($target));

my $text = <>;
for (my $i = 0; $i < length $text; $i++) {
	my $ind = index($target, substr($text, $i, 1));
	if ($ind != -1) {
		$ap{$ind}++;
	}
}

my $mn = minn($ap{0} / 2, $ap{1} / 2);
for (my $i = 2; $i < length $target; $i++) {
	$mn = minn($mn, $ap{$i});
}

say $mn;

#use v5.24;
use warnings;
my %fr;

my $line=<stdin>;
chomp($line);
my @word=split(//,$line);
for (my $i=ord("A");$i<=ord("z");$i++){
	$fr{chr($i)}=0;
}
foreach my $lit (@word){
	$fr{$lit}++;
}
my @key=("B","u","l","b","a","s","a","u","r");
my $min=100006;
foreach my $lit (@key){
	if ($min>$fr{$lit}) {$min=$fr{$lit}};
}
print $min;
<stdin>;
exit(0);

#Bulbasaur

use v5.20.1;
use warnings;

=pod
my $filename = "date.in";
open(my $fh, '<:encoding(UTF-8)', $filename)
	or die "Could not open the file";
=cut

my $line = <STDIN>;
chomp($line);

my @input = split('', $line);

my %letters = (

	'B' => 0,
	'u' => 0,
	'l' => 0,
	'b' => 0,
	'a' => 0,
	's' => 0,
	'r' => 0,

);

for(my $i = 0; $i < @input; $i++){

	if( index("Bulbasr", $input[$i]) != -1 ){

		$letters{$input[$i]}++;

	}

}

my $mini = 100002;

while(my ($key, $value) = each(%letters)){

	if( ($key eq 'a' || $key eq 'u') && $value/2 < $mini ){

		$mini = $value/2;

	}elsif($key ne 'a' && $key ne 'u' && $value < $mini){

		$mini = $value;

	}

}

say $mini;


use strict;
use warnings;

my $n = <>;
my @a = sort {$b <=> $a} split ' ', <>;
my $sum = 0;
for (@a) {
    $sum += $_;
}

my $res = 0;
my $curr = 0;

for (@a) {
    $res++;
    $curr += $_;
    last if (2*$curr > $sum);
}

print "$res\n";

<STDIN>;
@num = sort { $b <=> $a } split(/ +/, <STDIN>);

$s = $sum = $count = 0;
foreach(@num) { $sum += $_ }

foreach(@num)
{
	$s += $_;
	++$count;
	last if ($s > $sum / 2);
}

print $count;

#!/bin/perl

$n = <STDIN>;

$inpt = <STDIN>;
chomp $inpt;

@nums = split / +/, $inpt;
@nums = sort {$b <=> $a} @nums;

$s = 0;

for($i=0;$i<@nums;$i++)
{

  $s += @nums[$i];

}

$s /= 2;

$s2 = 0;
$it = 0;

while( $s2 <= $s )
{

  $s2 += @nums[$it];
  $it++;

}

print $it;

sub TakeInput
{
    $n = <STDIN>;
    $values = <STDIN>;
    @values = split(" ",$values);
    return @values;
}

sub sortArray
{
    @Array = @_;
    $l = @Array;
    for($i=0;$i<$l;$i++)
    {
        for($j=0;$j<($l-$i);$j++)
        {
            if(@Array[$j+1]>@Array[$j])
            {

                $tmp = @Array[$j];
                @Array[$j] = @Array[$j+1];
                @Array[$j+1] = $tmp;
            }
        }
    }
    return @Array;
}
sub sum
{
    my @Array = @_;
    my $l = @Array;
    $sm = 0;
    for($i=0;$i<$l;$i++)
    {

        $sm = $sm+@Array[$i];

    }
    return $sm;
}

@values = TakeInput();
@sorted = sortArray(@values);
$l = @sorted;
$flag = 0;
while($flag==0)
{

    for($counter=0;$counter<$l-1;$counter++)
    {

        @list1 = @sorted[0..$counter];
        @list2 = @sorted[$counter+1..$l-1];
        $s1 = sum(@list1);
        $s2 = sum(@list2);
        if($s1>$s2)
        {
            $v =  scalar @list1;
            print $v;
            $flag = 1;
            last;
        }

    }

    if($flag == 0)
    {
        print scalar @sorted;
        $flag = 1;
    }
}

my $num = <>;
my $coin = <>;
chomp $coin;
my @coin = sort {$b<=>$a} split / /, $coin;
my $sum=0;
$sum += $_ foreach @coin;
my $count;
my $val=0;
until ($val > $sum/2) {
    $count++;
    $val += shift @coin;
}
print $count;

#!/usr/bin/perl
# your code goes here
use v5.10;

chomp($n = <>);
@a = sort { $b<=>$a } split / /, <>;
$tot += $_ foreach (@a);
$ans = 0;
$tmp = 0;
foreach (@a) {
	$tmp += $_;
	++$ans;
	$tmp>$tot-$tmp and last;
}
say $ans;

#!/usr/bin/perl

use 5.012;
use warnings;

my $n = <>;
chomp(my $s = <>);
my @c = split / /, $s;
@c = sort { $b <=> $a } @c;

sub sum {
	my $ref = shift;
	my $sum;
	$sum += $_ for @$ref;
	return $sum;
}

my $cnt = 0;
my $sum = 0;
while ($sum <= sum \@c) {
	$sum += shift @c;
	$cnt++;
	last unless @c;
}
print $cnt;

my $n = <>;
my @arr = reverse sort { $a <=> $b } split " ", <>;
my ($mid, $ans, $sum) = (0, 0, 0);
$mid += $_ foreach(@arr);
$mid = int($mid / 2);

foreach(@arr) {
    $sum += $_;
    $ans++;
    last if ($sum > $mid);
}
print "$ans\n";

$n=<>;
chomp($n);
$c=<>;
chomp($c);

#print $c;

@c=split ' ',$c;

#print @c;

@c = reverse (sort {$a <=> $b} @c);

foreach (@c)
{
    $sum+=$_;
}
$mid=$sum/2;

#print $mid;
#print @c;
$myC=1;

foreach(@c)
{
    $me+=$_;
    if ($me>$mid)
    {
        print $myC;
        exit;
    }
    $myC++;
}

#!/usr/bin/perl
# Codeforces Practice - 160A Twins
use warnings;
use strict;

my $num = <STDIN>;
chomp $num;

my @coins = split(" ",<STDIN>);
my $sum = 0;
$sum += $_ for @coins;

@coins = sort {$b<=>$a} @coins;

my $sum2 = 0;
for(my $i = 1; @coins > 0; $i++){
    my $temp = shift @coins;
    $sum2 += $temp;
    $sum -= $temp;
    if($sum2>$sum){
        print $i;
        last;
    }
}

#!/usr/bin/perl -w

use strict;

my $n = <>;
my @x = sort { $a <=> $b } split ' ', <>;
my $s = 0;
$s += $_ for @x;
my $t = 0;
$t += pop @x while $t * 2 <= $s;
print $n - @x, "\n";

chomp($n = <STDIN>);
chomp($l = <STDIN>);

@coins = split /\s+/, $l;
@coins = sort { $b <=> $a } @coins;

$total = 0;
map { $total += $_; } @coins;
$taken_sum = 0;
$taken = 0;
while($taken_sum <= ($total - $taken_sum)) {
	$taken_sum += shift @coins;
	$taken++;
#	print "after taking $taken coins we have ".$taken_sum." and there's ".($total-$taken_sum)." left\n";
}

print "$taken\n";

#!/usr/bin/perl

use 5.012;
use warnings;

chomp(my $n = <>);
chomp(my $s = <>);

$s =~ /((.)\1)/;
say $2;

my $n = <>;
my @arr = reverse sort split " ", <>;
my ($mid, $ans, $sum) = (0, 0, 0);
$mid += $_ foreach(@arr);
$mid = int($mid / 2);

foreach(@arr) {
    $sum += $_;
    $ans++;
    last if ($sum > $mid);
}
print $ans . "\n";

#!/usr/bin/perl
# Codeforces Practice - 160A Twins
use warnings;
use strict;

my $num = <STDIN>;
chomp $num;

my @coins = split(" ",<STDIN>);
my $sum = 0;
$sum += $_ for @coins;

@coins = sort {$b<=>$a} @coins;

print "@coins\n";

my $sum2 = 0;
for(my $i = 1; @coins > 0; $i++){
    my $temp = shift @coins;
    $sum2 += $temp;
    $sum -= $temp;
    if($sum2>$sum){
        print $i;
        last;
    }
}

#!/usr/bin/perl -w

use strict;

my $n = <>;
my @x = sort split ' ', <>;
my $s = 0;
$s += $_ for @x;
my $t = 0;
$t += pop @x while $t * 2 <= $s;
print $n - @x, "\n";

chomp($n = <STDIN>);
chomp($l = <STDIN>);

@coins = split /\s+/, $l;
sort { $b <=> $a } @coins;

$total = 0;
map { $total += $_; } @coins;
$taken_sum = 0;
$taken = 0;
while($taken_sum <= ($total - $taken_sum)) {
	$taken_sum += shift @coins;
	$taken++;
}

print "$taken\n";

use strict;
use warnings;

my $n = <>;
my @a = split ' ', <>;
my $sum = 0;
for (@a) {
    $sum += $_;
}

my $res = 0;
my $curr = 0;

for (@a) {
    last if (2*$curr > $sum);
    $res++;
    $curr += $_;
}

print "$res\n";

use strict;
use warnings;

my $n = <>;
my @a = reverse sort split ' ', <>;
my $sum = 0;
for (@a) {
    $sum += $_;
}

my $res = 0;
my $curr = 0;

for (@a) {
    last if (2*$curr > $sum);
    $res++;
    $curr += $_;
}

print "$res\n";

<STDIN>;
@num = reverse sort split(/ +/, <STDIN>);
$s = $sum = $count = 0;
foreach(@num) { $sum += $_ }

foreach(@num)
{
    $s += $_;
    ++$count;
    if ($s < $sum / 2) { last; }
}

print STDOUT $count;

<STDIN>;
@num = reverse sort split(/ +/, <STDIN>);
$s = $sum = $count = 0;
foreach(@num) { $sum += $_ }

foreach(@num)
{
    $s += $_;
    ++$count;
    if ($s > $sum / 2) { last; }
}

print STDOUT $count;

sub TakeInput
{
    $n = <STDIN>;
    $values = <STDIN>;
    @values = split(" ",$values);
    return @values;
}

sub sortArray
{
    @Array = @_;
    $l = @Array;
    for($i=0;$i<$l;$i++)
    {
        for($j=0;$j<($l-$i);$j++)
        {
            if(@Array[$j+1]>@Array[$j])
            {

                $tmp = @Array[$j];
                @Array[$j] = @Array[$j+1];
                @Array[$j+1] = $tmp;
            }
        }
    }
    return @Array;
}
sub sum
{
    @Array = @_;
    my $l = @Array;
    $sum = 0;
    for($i=0;$i<$l;$i++)
    {
        $sum = $sum+@Array[i];
    }
    return $sum;
}
@values = TakeInput();
@sorted = sortArray(@values);
$l = @sorted;
$flag = 0;
while($flag==0)
{

    for($counter=0;$counter<$l-1;$counter++)
    {

        @list1 = @sorted[0..$counter];
        @list2 = @sorted[$counter+1..$l-1];
        $s1 = sum(@list1);
        $s2 = sum(@list2);
        if($s1>$s2)
        {
            print scalar @list1;
            $flag = 1;
        }

    }

    if($flag == 0)
    {
        print scalar @sorted;
        $flag = 1;
    }
}

sub TakeInput
{
    $n = <STDIN>;
    $values = <STDIN>;
    @values = split(" ",$values);
    return @values;
}

sub sortArray
{
    @Array = @_;
    $l = @Array;
    for($i=0;$i<$l;$i++)
    {
        for($j=0;$j<($l-$i);$j++)
        {
            if(@Array[$j+1]>@Array[$j])
            {

                $tmp = @Array[$j];
                @Array[$j] = @Array[$j+1];
                @Array[$j+1] = $tmp;
            }
        }
    }
    return @Array;
}
sub sum
{
    @Array = @_;
    my $l = @Array;
    $sum = 0;
    for($i=0;$i<$l;$i++)
    {
        $sum = $sum+@Array[i];
    }
    return $sum;
}
@values = TakeInput();
@sorted = sortArray(@values);
$l = @sorted;
$flag = 0;
while($flag==0)
{

    for($counter=0;$counter<$l-1;$counter++)
    {

        @list1 = @sorted[0..$counter];
        @list2 = @sorted[$counter+1..$l-1];
        $s1 = sum(@list1);
        $s2 = sum(@list2);
        if($s1>$s2)
        {

            $v =  scalar @list1;
            print $v + 1;
            $flag = 1;
            last;
        }

    }

    if($flag == 0)
    {
        print scalar @sorted;
        $flag = 1;
    }
}

my $num = <>;
my $coin = <>;
chomp $coin;
my @coin = reverse sort split / /, $coin;
my $sum;
$sum += $_ foreach @coin;
my $count;
my $val=0;
until ($val > $sum/2) {
    $count++;
    $val += shift @coin;
}
print $count;


#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/ say /;

# send argument as array, not reference, to function requiring list

# essential
my @tokens = ();

sub ceil {
    my $n = shift;
    my $in = int($n);
    return $n if $in == $n;
    return $in + 1;
}

sub read_line {
    chomp (my $line = <STDIN>);
    return $line;
}

sub read_token {
    @tokens = split q{ }, read_line() if @tokens == 0;
    return shift @tokens;
}

sub min {
    my @numbers = @_;
    my $min = shift @numbers;
    for ( @numbers ) {
        $min = $min<$_ ? $min : $_;
    }
    return $min;
}

sub max {
    my @numbers = @_;
    my $max = shift @numbers;
    for ( @numbers ) {
        $max = $max > $_ ? $max : $_;
    }
    return $max;
}

sub sum {
    my @numbers = @_;
    my $sum = 0;
    for (@numbers) {
        $sum += $_;
    }
    return $sum;
}

# solve

my $n = read_token;

my $answer = 'NO';

my $lines = [];

for (1..$n) {
    my $line = read_line;
    my ($left, $right) = split q/\|/, $line;
    $left = '++', $answer = 'YES' if $answer eq 'NO' and $left eq 'OO';
    $right = '++', $answer = 'YES' if $answer eq 'NO' and $right eq 'OO';
    push @$lines, join q{|}, ($left, $right);
}

say $answer;

exit(0) if $answer eq 'NO';

for (@$lines) {
    say $_;
}

$sum = "";
foreach $s (<STDIN>) {
  if ($s =~ /\|/) {
    $sum = $sum . $s;
  }
}
if ($sum =~ /OO/) {
  print "YES\n";
  $sum =~ s/OO/\+\+/;
  print $sum;
} else {
  print "NO\n";
}

use warnings;
#use FileHandle;

#my $in = FileHandle->new("input.txt", "r");
#my $out = FileHandle->new("output.txt", "w");

sub solve {
	my $in = shift;
	my $out = shift;
	my $n = <$in>;
	my ($str, $str1, $str2, $yes);
	my @mas;
	$yes = 0;

	for my $i (0..$n - 1){
		$str = <$in>;
		$str1 = substr($str, 0, 2);
		if (($yes == 0) and ($str1 eq 'OO')){
			$yes = 1;
			$str1 = '++';
		}
		$str2 = substr($str, 3, 2);
		if (($yes == 0) and ($str2 eq 'OO')){
			$yes = 1;
			$str2 = '++';
		}

		push(@mas, $str1 . '|' . $str2 . "\n");
	}

	if ($yes == 1){
		print $out "YES\n";
	} else {
		print $out "NO\n";
		return 1;
	}

	for (@mas){
		print $out $_;
	}
	return 1;
}

solve(STDIN, STDOUT);

1;

use 5.020;
use warnings;
<>;
undef $/;
$_ = <>;
if (s/OO/++/) {
  say 'YES';
  say;
}
else { say 'NO' }

my $n = <>;
my @pairs;
for (1..$n) {
    my $line = <>;
    chomp $line;
    push @pairs, [split /\|/, $line];
}
my $ok = 0;

OUTER: for my $pair (@pairs) {
    for my $seats (@$pair) {
        if ($seats eq 'OO') {
            $seats = '++';
            $ok = 1;
            last OUTER;
        }
    }
}

if (!$ok) {
    print "NO\n";
    exit;
}

print "YES\n";
$, = "\n";
$\ = "\n";
print map { join "|", @$_ } @pairs;

use strict;
use warnings;

use Data::Dumper;

my $in = <>;
chomp $in;

my $n = $in;
die('invalid size') unless $n>=1 and $n<=1000;
my $bus = [];
foreach my $row (0..$in-1) {
  $in = <>;
  chomp $in;
  push(@$bus, $in);
}

my $can_sit_together = find_seats($bus);
if ($can_sit_together) {
  print "YES\n";
  print_bus($bus);
} else {
  print "NO\n";
}

sub find_seats {
  my $bus = shift;
  foreach my $bus_row (@$bus) {
    my @row = split(//, $bus_row);
    if ($row[0] eq 'O' and $row[1] eq 'O') {
      $row[0] = $row[1] = '+';
      $bus_row = join('', @row);
      return 1;
    } elsif ($row[3] eq 'O' and $row[4] eq 'O') {
      $row[3] = $row[4] = '+';
      $bus_row = join('', @row);
      return 1;
    }
  }
  return 0;
}

sub print_bus {
  my $bus = shift;
  foreach my $row (@$bus) {
    print "$row\n";
  }
}

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/ say /;

use Carp;

# essential
my @tokens = ();

sub ceil {
    my $n = shift;
    my $in = int($n);
    return $n if $in == $n;
    return $in + 1;
}

sub read_line {
    chomp (my $line = <STDIN>);
    return $line;
}

sub read_token {
    @tokens = split q{ }, read_line() if @tokens == 0;
    return shift @tokens;
}

sub min {
    my @numbers = @_;
    my $min = shift @numbers;
    for ( @numbers ) {
        $min = $min<$_ ? $min : $_;
    }
    return $min;
}

sub max {
    my @numbers = @_;
    my $max = shift @numbers;
    for ( @numbers ) {
        $max = $max > $_ ? $max : $_;
    }
    return $max;
}

sub sum {
    my @numbers = @_;
    my $sum = 0;
    for (@numbers) {
        $sum += $_;
    }
    return $sum;
}

sub ref_ref_scalar {
    my $ref = shift;
    return 1 if ref($ref) eq 'SCALAR';
}

sub toggle {
    my $ref = shift;
    croak '$ref does not reference to scalar' if !ref_ref_scalar($ref);

    $$ref = !$$ref;
}

# solve

my $n = read_token;

my $answer = 0;

my $lines = [];

for (1..$n) {
    my $line = read_line;
    my ($left, $right) = split q/\|/, $line;
    $left = '++', toggle(\$answer) if !$answer and $left eq 'OO';
    $right = '++', toggle(\$answer) if !$answer and $right eq 'OO';
    push @$lines, join q{|}, ($left, $right);
}

say 'NO' and exit(0) if !$answer;

say 'YES';
for (@$lines) {
    say $_;
}

use strict;
# cf711a # solution courtesy 20253198 rsFalse
<>;
$/='';
$_ = <>;
print s/OO/++/ ? "YES\n$_" : "NO";

use strict;

# cf711a
=item

A. Bus to Udayland
time limit per test
2 seconds
memory limit per test
256 megabytes
input
standard input
output
standard output

ZS the Coder and Chris the Baboon are travelling to Udayland! To get there, they have to get on the special IOI bus. The IOI bus has n rows of seats. There are 4 seats in each row, and the seats are separated into pairs by a walkway. When ZS and Chris came, some places in the bus was already occupied.

ZS and Chris are good friends. They insist to get a pair of neighbouring empty seats. Two seats are considered neighbouring if they are in the same row and in the same pair. Given the configuration of the bus, can you help ZS and Chris determine where they should sit?
Input

The first line of the input contains a single integer n (1 ≤ n ≤ 1000) — the number of rows of seats in the bus.

Then, n lines follow. Each line contains exactly 5 characters, the first two of them denote the first pair of seats in the row, the third character denotes the walkway (it always equals '|') and the last two of them denote the second pair of seats in the row.

Each character, except the walkway, equals to 'O' or to 'X'. 'O' denotes an empty seat, 'X' denotes an occupied seat. See the sample cases for more details.
Output

If it is possible for Chris and ZS to sit at neighbouring empty seats, print "YES" (without quotes) in the first line. In the next n lines print the bus configuration, where the characters in the pair of seats for Chris and ZS is changed with characters '+'. Thus the configuration should differ from the input one by exactly two charaters (they should be equal to 'O' in the input and to '+' in the output).

If there is no pair of seats for Chris and ZS, print "NO" (without quotes) in a single line.

If there are multiple solutions, you may print any of them.
Examples
Input

6
OO|OX
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX

Output

YES
++|OX
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX

Input

4
XO|OX
XO|XX
OX|OX
XX|OX

Output

NO

Input

5
XX|XX
XX|XX
XO|OX
XO|OO
OX|XO
Output
YES
XX|XX
XX|XX
XO|OX
XO|++
OX|XO
Note
Note that the following is an incorrect configuration for the first sample case because the seats must be in the same pair.
O+|+X
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX
=cut

my $n=<>;
my @ls=<>;

my @rs;
my $qFound=0;
foreach my $l (@ls) {
  chomp $l;
  my @vs=split('',$l);
  if((!$qFound) && ($vs[0] eq 'O') && ($vs[1] eq 'O')) {
    $vs[0]=$vs[1]='+';
    $qFound=1;
  }
  if((!$qFound) && ($vs[3] eq 'O') && ($vs[4] eq 'O')) {
    $vs[3]=$vs[4]='+';
    $qFound=1;
  }
  push @rs,join('',@vs);
}
if($qFound) {
  print "YES\n";
  foreach my $r (@rs) {
    print $r,"\n";
  }
} else {
  print "NO\n";
}

use strict;
use warnings;

use Data::Dumper;

# rows 10
# per row: 2x2
# find to seats next to each other...

my $n = <>;
chomp($n);

die('wrong number or rows') unless $n >=0 && $n <= 100;

# store input as array with length n * 2
# loop array, find first seat with OO.
# found: change 00 to ++
# exit and print result

my @buss;
my @left;
my @right;
for (0..$n-1) {
    my $in = <>;
    chomp($in);
    my @seats = split('\|', $in);
#    print Dumper \@seats;
    push @left, $seats[0];
    push @right, $seats[1];
}
@buss = (@left, @right);

for (@buss) {
    if ($_ eq 'OO') {
        print "YES\n";
        print_bus(\@buss, $n);
        exit;
    }
}
print "NO\n";

sub print_bus {
    my ($buss, $n) = @_;

    for (my $i=0; $i<$n; $i++) {
        my $row = $buss->[$i] . '|' . $buss->[$n + $i];
        print $row . "\n";
    }
}

use 5.020;
use warnings;
undef $/;
$_ = <>;
if (s/OO/++/) {
  say 'YES';
  say;
}
else { say 'NO' }

use strict;

# cf711a
=item

A. Bus to Udayland
time limit per test
2 seconds
memory limit per test
256 megabytes
input
standard input
output
standard output

ZS the Coder and Chris the Baboon are travelling to Udayland! To get there, they have to get on the special IOI bus. The IOI bus has n rows of seats. There are 4 seats in each row, and the seats are separated into pairs by a walkway. When ZS and Chris came, some places in the bus was already occupied.

ZS and Chris are good friends. They insist to get a pair of neighbouring empty seats. Two seats are considered neighbouring if they are in the same row and in the same pair. Given the configuration of the bus, can you help ZS and Chris determine where they should sit?
Input

The first line of the input contains a single integer n (1 ≤ n ≤ 1000) — the number of rows of seats in the bus.

Then, n lines follow. Each line contains exactly 5 characters, the first two of them denote the first pair of seats in the row, the third character denotes the walkway (it always equals '|') and the last two of them denote the second pair of seats in the row.

Each character, except the walkway, equals to 'O' or to 'X'. 'O' denotes an empty seat, 'X' denotes an occupied seat. See the sample cases for more details.
Output

If it is possible for Chris and ZS to sit at neighbouring empty seats, print "YES" (without quotes) in the first line. In the next n lines print the bus configuration, where the characters in the pair of seats for Chris and ZS is changed with characters '+'. Thus the configuration should differ from the input one by exactly two charaters (they should be equal to 'O' in the input and to '+' in the output).

If there is no pair of seats for Chris and ZS, print "NO" (without quotes) in a single line.

If there are multiple solutions, you may print any of them.
Examples
Input

6
OO|OX
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX

Output

YES
++|OX
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX

Input

4
XO|OX
XO|XX
OX|OX
XX|OX

Output

NO

Input

5
XX|XX
XX|XX
XO|OX
XO|OO
OX|XO
Output
YES
XX|XX
XX|XX
XO|OX
XO|++
OX|XO
Note
Note that the following is an incorrect configuration for the first sample case because the seats must be in the same pair.
O+|+X
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX
=cut

my $n=<>;
my @ls=<>;

my @rs;
my $qFound=0;
foreach my $l (@ls) {
  chomp $l;
  my @vs=split('',$l);
  if((!$qFound) && ($vs[0] eq 'O') && ($vs[1] eq 'O')) {
    $vs[0]=$vs[1]='+';
    $qFound=1;
  }
  if((!$qFound) && ($vs[3] eq 'O') && ($vs[4] eq 'O')) {
    $vs[3]=$vs[4]='+';
    $qFound=1;
  }
  push @rs,join('',@vs);
}
print ($qFound ? "YES" : "NO");
print "\n";
foreach my $r (@rs) {
  print $r,"\n";
}

use strict;

# cf711a
=item

A. Bus to Udayland
time limit per test
2 seconds
memory limit per test
256 megabytes
input
standard input
output
standard output

ZS the Coder and Chris the Baboon are travelling to Udayland! To get there, they have to get on the special IOI bus. The IOI bus has n rows of seats. There are 4 seats in each row, and the seats are separated into pairs by a walkway. When ZS and Chris came, some places in the bus was already occupied.

ZS and Chris are good friends. They insist to get a pair of neighbouring empty seats. Two seats are considered neighbouring if they are in the same row and in the same pair. Given the configuration of the bus, can you help ZS and Chris determine where they should sit?
Input

The first line of the input contains a single integer n (1 ≤ n ≤ 1000) — the number of rows of seats in the bus.

Then, n lines follow. Each line contains exactly 5 characters, the first two of them denote the first pair of seats in the row, the third character denotes the walkway (it always equals '|') and the last two of them denote the second pair of seats in the row.

Each character, except the walkway, equals to 'O' or to 'X'. 'O' denotes an empty seat, 'X' denotes an occupied seat. See the sample cases for more details.
Output

If it is possible for Chris and ZS to sit at neighbouring empty seats, print "YES" (without quotes) in the first line. In the next n lines print the bus configuration, where the characters in the pair of seats for Chris and ZS is changed with characters '+'. Thus the configuration should differ from the input one by exactly two charaters (they should be equal to 'O' in the input and to '+' in the output).

If there is no pair of seats for Chris and ZS, print "NO" (without quotes) in a single line.

If there are multiple solutions, you may print any of them.
Examples
Input

6
OO|OX
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX

Output

YES
++|OX
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX

Input

4
XO|OX
XO|XX
OX|OX
XX|OX

Output

NO

Input

5
XX|XX
XX|XX
XO|OX
XO|OO
OX|XO
Output
YES
XX|XX
XX|XX
XO|OX
XO|++
OX|XO
Note
Note that the following is an incorrect configuration for the first sample case because the seats must be in the same pair.
O+|+X
XO|XX
OX|OO
XX|OX
OO|OO
OO|XX
=cut

my $n=<>;
my @ls=<>;

my @rs;
my $qFound=0;
foreach my $l (@ls) {
  chomp $l;
  my @vs=split('',$l);
  if((!$qFound) && ($vs[0] eq 'O') && ($vs[1] eq 'O')) {
    $vs[0]=$vs[1]='X';
    $qFound=1;
  }
  if((!$qFound) && ($vs[3] eq 'O') && ($vs[4] eq 'O')) {
    $vs[3]=$vs[4]='X';
    $qFound=1;
  }
  push @rs,join('',@vs);
}
print ($qFound ? "YES" : "NO");
print "\n";
foreach my $r (@rs) {
  print $r,"\n";
}


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

chomp(my $n = <STDIN>);
my @scores = split / /,<STDIN>;

my $min = $scores[0];
my $max = $scores[0];
my $count = 0;
foreach my $score (@scores) {
    if($score > $max){
        $max = $score;
        $count++;
    } elsif($score <$min){
        $min = $score;
        $count++;
    }
}
print $count;

#!/usr/bin/perl -w

use strict;

<>;
my @a = split ' ', <>;
my $max = shift @a;
my $min = $max;
my $amaze = 0;

for (@a) {
    if ($_ > $max) {
        $amaze++;
        $max = $_;
    } elsif ($_ < $min) {
        $amaze++;
        $min = $_;
    }
}

print $amaze, "\n";

$n=<>;
@array=split(' ',<>);
$maxi=$array[0];
$mini=$array[0];
$score=0;
for($i=1;$i<$n;$i++){
if($array[$i]>$maxi){
$maxi=$array[$i];
$score++;
}
elsif($array[$i]<$mini){
$mini=$array[$i];
$score++;
}
}
print $score;

#!perl

$n = <>;
@arr = split /\D/, <>;
$result = 0;
$min = $max = $arr[0];
for $i (1..$n-1) {
	if ($arr[$i] > $max) {
		$max = $arr[$i];
		$result++;
	} elsif ($arr[$i] < $min) {
		$min = $arr[$i];
		$result++;
	}
}
print $result;

$line = <>;
$line = <>;
chomp $line;
my $max, $min;
$ans = 0;
foreach my $num (split(/ /, $line)) {
    if (!defined($max)) {
        $max = $num;
        $min = $num;
    }
    if ($num > $max) {
        $ans++;
        $max = $num;
    }
    if ($num < $min) {
        $ans++;
        $min = $num;
    }
}
print "$ans\n";

<>;
my @score = grep /\w/, split ' ', <>;
my $count = 0;
my ($max, $min) = (0, 0);
foreach (1..$#score) {
    if ($score[$_] > $score[$max]) {
        $count++;
        $max = $_;
    } elsif ($score[$_] < $score[$min]) {
        $count++;
        $min = $_;
    }
}
print $count;

#!perl

$n = <>;
@arr = <>;
$result = 0;
$max = $min = $arr[0];
for $i (1..$n-1) {
	if ($arr[$i] > $max) {
		$max = $arr[$i];
		$result++;
	} elsif ($arr[$i] < $min) {
		$min = $arr[$i];
		$result++;
	}
}
print $result;

<>;
my @score = grep /\w/, split ' ', <>;
my $count;
my ($max, $min) = (0, 0);
foreach (1..$#score) {
    if ($score[$_] > $score[$max]) {
        $count++;
        $max = $_;
    } elsif ($score[$_] < $score[$min]) {
        $count++;
        $min = $_;
    }
}
print $count;


$|=1; ($p,@p)=qw(2 3 5 7);
while (@p) {
	print "$p\n";
	$a=<>; chomp($a);
	if ($a eq "yes") {
		if (++$c==2) {
			print "composite\n";
			exit;
		}
		$p*=$p;
	} else {
		$p=shift(@p);
	}
}
print "prime\n";


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	@_ = split ' ', <>;

	my $twos = 0;

	for( @_ ){
		$_ /= 2, ++ $twos while $_ % 2 == 0;
		}

	my @idxs = 1 .. @_;

	for( @idxs ){
		my $cnt = 0;
		$_ /= 2, ++ $cnt while $_ % 2 == 0;
		$_ = $cnt;
		}

	@idxs = sort { $b <=> $a } grep $_, @idxs;

	my $ops = 0;

	while( $twos < @_ and @idxs ){
		$twos += shift @idxs;
		$ops ++;
		}

	print $twos >= @_ ? $ops : -1;
	}


use List::Util qw(first max maxstr min minstr reduce shuffle sum);
chomp (my ($n, $k) = split /\s+/, <>);
chomp (my @targets = sort {$b <=> $a} split /\s+/, <>);

my $cnt = 0;
while (scalar @targets) {
    $cnt += ((&max(splice(@targets, 0, $k))) - 1) << 1;
}
printf "$cnt\n";

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

my ($n, $k) = split ' ', <>;
my @arr = sort { $a <=> $b } split (' ', <>);
my ($res, $idx) = (0,$n-1);

while($idx >= 0){
    $res += 2*($arr[$idx]-1);
    $idx -= $k;
}
print $res;

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

my ($n, $k) = split ' ', <>;
my @arr = sort { $b <=> $a } split (' ', <>);
my ($res, $idx) = (0,0);

while($idx < $n){
    $res += 2*($arr[$idx]-1);
    $idx += $k;
}
print $res;

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

my ($n, $k) = split ' ', <>;
my @arr = sort { $b <=> $a } split (' ', <>);
my ($res, $idx) = (0,$n-1);
while($idx >= 0){
    $res += 2*($arr[$idx]-1);
    $idx -= $k;
}
print $res;


#!/usr/bin/perl -w
use strict;

my %goals = ();
for (1..<>) {
	$goals{<>}++;
}
my ($winner) = sort {$goals{$b}<=>$goals{$a}} keys %goals;
print $winner;


my ($n, $t) = split " ", <>;
my @arr = split " ", <>;
unshift @arr, 0;
my $pos = 1;
$pos += $arr[$pos] while ($pos < $t);
print ($pos == $t ? "YES\n" : "NO\n");

#!/usr/bin/perl
# your code goes here
use v5.10;

our $flag = 0;
our ($n, $t) = split / /, <>;
our @adj = ([()]) x $n+1;
our @visit = (0) x $n+1;

sub dfs {
	my $u = shift;

	# say $u;
	$visit[$u] = 1;
	$u==$t and return 1;
	foreach my $v (@{$adj[$u]}) {
		$visit[$v]==0 and dfs($v) and return 1;
	}
	return 0;
}

my $i = 1;
foreach (split / /, <>) {
	push @{$adj[$i]}, $_+$i;
	++$i;
}

dfs(1) and say "YES" or say "NO";

#!/usr/bin/perl
# your code goes here
use v5.10;

our $flag = 0;
our ($n, $t) = split / /, <>;
our @adj = ([]) x $n+1;
our @visit = (0) x $n+1;

sub dfs {
	my $u = shift;

	# say $u;
	$visit[$u] = 1;
	$u==$t and return 1;
	foreach my $v (@{$adj[$u]}) {
		$visit[$v]==0 and dfs($v) and return 1;
	}
	return 0;
}

my $i = 1;
foreach (split / /, <>) {
	push @{$adj[$i]}, $_+$i;
	++$i;
}

dfs(1) and say "YES" or say "NO";

use Data::Dumper;
my ($n, $t) = split ' ', <>;
my @indices = split ' ', <>;
my @a = ();
push @a, 0 for (1 .. $n);

$a[0] = 1;

for my $i (0 .. $n - 2) {
    my $j = shift @indices;
    $a[$i + $j] = 1 if $a[$i];
}

print $a[$t - 1] == 1 ? "YES\n" : "NO\n";

my ($n, $t) = split ' ', scalar <>;
my @a = split ' ', scalar <>;
my @used = (0) x scalar @a;
my $i;
for($i=0; $i<$t-1; $i += $a[$i]){}
print (($i == $t-1) ? "YES\n" : "NO\n");

my ($n, $t) = split " ", <>;
my @arr = split " ", <>;
my $pos = 1;
$pos += $arr[$pos] while ($pos < $t);
print ($pos == $t ? "YES\n" : "NO\n");

my ($n, $t) = split " ", <>;
my @arr = split " ", <>;
my @mark = (0) x $n+1;
$mark[1] = 1;
for (my $pos = 1; $pos != $t; $pos++) {
    $pos += int $arr[$pos];
    if ($pos >= $n-1 || $mark[$pos]) {
        print "NO\n";
        exit;
    }
    $mark[$pos] = 1;
}
print "YES\n";

use Data::Dumper;
my ($n, $t) = split ' ', <>;
my @indices = split ' ', <>;
my @a = ();
push @a, 0 for (1 .. $n);

for my $i (0 .. $n - 2) {
    my $j = shift @indices;
    $a[$i + $j] = 1 if $a[$i];
}

print $a[$t - 1] == 1 ? "YES\n" : "NO\n";


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

my $debug = 0;

<>;

while(<>){
	$debug and print '-' x 15;
	$_ = <>, chomp;

	$debug and print "\$_:[$_]";

	my @A = ( 1 ) x ( 1 + length );

	fill_array_with_counts_of_forward_nodes(
		$_, \@A
		);

	$debug and print "\@A:[@A]";

	$_ = reverse;
	$_ =~ y/RL/LR/;
	@A = reverse @A;

	fill_array_with_counts_of_forward_nodes(
		$_, \@A
		);

	@A = reverse @A;

	$debug and print "\@A:[@A]";

	print "@A";
	}

sub fill_array_with_counts_of_forward_nodes {
	my( $line, $ref_array ) = @_;

	my $len = 0;

	$line =~ /
		(?{
			$debug and print ">[$-[0]][$`][$&][$'][@{ $ref_array }][$len]";
			})
		(?=R)
		(?{ $len > 0 and $len -= 2; })
		(?(?{ $len <= 0; })
			(?: (?:RL)*+ ){0,10}+
			R?+
			(?{ $len = length $&; })
			)
		(?{
			$debug and print "[$-[ 0 ]], len:[$len]";
			${ $ref_array }[ $-[ 0 ] ] += $len;
			})
		(*FAIL)
		/x;
	}

#!/usr/bin/perl

use warnings;

$\ = $/;

<>;

while(<>){
	$_ = <>, chomp;

	@A = ( 1 ) x ( 1 + length );

	&add_forward_cities;
	&add_forward_cities;

	print "@A";
	}

sub add_forward_cities {
	$_ = reverse;
	y/RL/LR/;
	@A = reverse @A;

	$length = 0;

	/
		(?=R)
		(?{ $length > 0 and $length -= 2 })
		(?(?{ $length <= 0 })
			(?: (?:RL)*+ ){0,10}+
			R?+
			(?{ $length = length $& })
			)
		(?{
			$A[ $-[ 0 ] ] += $length
			})
		(*F)
		/x;
	}


use strict;
#use warnings;
<>;
my @matrix;
push @matrix, [];
for(<>)
{
	chomp;
	push @matrix, [0,split(//,$_ ),0];
}
push @matrix, [];

for my $x (1..$#matrix-1)
{
	for my $y (1..$#{$matrix[$x]}-1)
	{
		if($matrix[$x][$y])
		{
			my $toDel = [[]];
			func($x,$y,0,$toDel);
			Del($toDel);
		}
	}
}
print "No";
sub Del
{
	my $toDel = shift;
	for my $x (0..$#matrix)
	{
		for my $y (0..$#{$matrix[$x]})
		{
			$matrix[$x][$y] = 0 if($toDel->[$x][$y]);

		}
	}
}
sub func
{
	my ($x,$y, $dir,$path) = @_;

	if(!defined $path->[$x][$y])
	{
		my $color = $matrix[$x][$y];
		$path->[$x][$y] = 1;
		checkWin($x,$y,$dir,$path);
		if($dir ne 'r' and $color eq $matrix[$x-1][$y])
		{
			func($x-1, $y, 'l', $path);
		}
		if($dir ne 'l' and $color eq $matrix[$x+1][$y])
		{
			func($x+1, $y, 'r', $path);
		}
		if($dir ne 'd' and $color eq $matrix[$x][$y+1])
		{
			func($x, $y+1, 'u', $path);
		}
		if($dir ne 'u' and $color eq $matrix[$x][$y-1])
		{
			func($x, $y-1, 'd', $path);
		}
	}
}
sub checkWin
{
	my ($x,$y, $dir,$path) = @_;
	if($matrix[$x][$y] eq $matrix[$x+1][$y] and $path->[$x+1][$y] and $dir ne 'l' ){ print "Yes" and exit 0;}
	if($matrix[$x][$y] eq $matrix[$x-1][$y] and $path->[$x-1][$y] and  $dir ne 'r' ){ print "Yes" and exit 0;}
	if($matrix[$x][$y] eq $matrix[$x][$y+1] and $path->[$x][$y+1] and $dir ne 'd' ){ print "Yes" and exit 0;}
	if($matrix[$x][$y] eq $matrix[$x][$y-1] and $path->[$x][$y-1] and $dir ne 'u' ){ print "Yes" and exit 0;}
	return 0;
}


my @input;
while(<>) {chomp; push(@input, $_);}
my @list = map{ {}; } (1..20);
shift(@input);
my ($l, $c, $i);
my $regexp = qr//o;
for $l (@input) {
	$i = 0;
  foreach $c (split($regexp, $l)) {
    $list[$i++]{$c} = 1;
  }
}
$i = 0;
$i++ while( scalar(keys(%{$list[$i]}) == 1 ) );
print $i;

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

my @phones;
my $n;
sub isvalid{
    my $start = shift;
    my $len = shift;
    my $cmp = substr $phones[0], $start, $len-$start;
    for my $i(1..$n-1){
        return 0 if $cmp ne substr $phones[$i], $start, $len-$start;
    }
    return 1;
}
#==================================

$n = <>;
for(1..$n){
    chomp (my $val = <>);
    push @phones, $val;
}

my ($low, $high) = (0,40000);
while($low < $high){
    my $mid = int(($low + $high + 1) / 2);
    if(isvalid($low, $mid)){$low = $mid;}
    else {$high = $mid-1;}
}
print $low;

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

my @phones;
my $n;
$n = <>;
for(1..$n){
    my @val = (<> =~ /\w/g);
    push @phones, \@val;
}
for my $j(0..40000){
    my $char = $phones[0][$j];
    for my $i(0..$n-1){
        if($char ne $phones[$i][$j]){
            print $j;
            exit 0;
        }
    }
}

@_=<>;
shift @_;
chomp @_;
$a = shift @_;
for $j(1..length $_[0]){
    $i=0;
    for (@_){
        $a eq $_ or $i=1;
        chop;
        }
    chop $a;
    $i or last
    }
print 1 - $i + length $a

#!/usr/bin/perl
chomp($n = <STDIN>);
$nums;
for ($i = 0; $i < $n; $i++)
{
    chomp($num = <STDIN>);
    push(@nums, $num);
    #print $num . "\n";
}

$numlen = length $nums[0];
#$res = 0;
for ($i = $numlen - 1; $i >= 0; $i--)
{
    #print $i . "\n";
    #print $nums[$i] . "\n";
    $head = substr($nums[0], 0, $i + 1);
    #print $head . "\n";
    $isok = 1;
    for ($j = 1; $j < $n; $j++)
    {
        #print "tmp: " . substr($nums[j], 0, $i + 1) . "\n";
        if (substr($nums[$j], 0, $i + 1) ne $head)
        {
            $isok = 0;
            last;
        }
    }

    if ($isok)
    {
        print $i + 1;
        exit;
    }
    elsif (!$isok && $i == 0)
    {
        print 0;
        exit;
    }
}

my $n = <STDIN>;
my @a;
for (my $i = 0; $i < $n; $i++) {
    my $q = <STDIN>;
    push(@a, $q);
}

my $l = length $a[0];
my $ans = 0;

for (my $i = $l; $i > 0; $i--) {
    my $substr = substr $a[0], 0, $i;
    my $flag = 1;
    for my $t (@a) {
        if (!($t =~ /^$substr/)) {
            $flag = 0;
            last;
        }
    }
    if ($flag) {
        $ans = $i;
        last;
    }
}

print "$ans\n";

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

######z1

my $count = <STDIN>;
my $pref = <STDIN>;
my $len = length($pref);
foreach (my $i=1;$i<$count;$i++) {
    my $num = <STDIN>;
    while ($pref ne substr($num, 0, $len)) {
        $len--;
        $pref = substr($pref, 0, $len);
    }
}
print $len."\n";
1;

#!/usr/bin/perl
chomp($n = <STDIN>);
$nums;
for ($i = 0; $i < $n; $i++)
{
    chomp($num = <STDIN>);
    push(@nums, $num);
    #print $num . "\n";
}

$numlen = length $nums[0];
#$res = 0;
for ($i = $numlen - 1; $i >= 0; $i--)
{
    #print $i . "\n";
    #print $nums[$i] . "\n";
    $head = substr($nums[0], 0, $i + 1);
    #print $head . "\n";
    #$isok = 1;
    for ($j = 1; $j < $n; $j++)
    {
        #print "tmp: " . substr($nums[j], 0, $i + 1) . "\n";
        if (substr($nums[$j], 0, $i + 1) ne $head)
        {
            last;
        }

        if ($j == $n - 1)
        {
            print $i + 1;
            exit;
        }
    }
}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	$_ = <>, chomp;

	print m/^(1|0|10|01)$/ ? 'YES' : 'NO';
	}

for (1..<>) {
      chomp(my $n = <>);
      chomp(my $in = <>);
      my @a = split //, $in;
      scalar(@a) == 1 and print "YES\n" and next;
      scalar(@a) > 2 and print "NO\n" and next;
      my $a = shift @a;
      my $b = shift @a;
      $a != $b and print "YES\n";
      $a == $b and print "NO\n";
}


chomp( (undef, $_, undef, @words) = <> );

%restore_case = map { lc, $_ } @words;

$list = join '|', map { scalar reverse lc } @words;

m/^ (?: ($list | $ | (?{ pop @submatches }) (?!) ) (?{ push @submatches, $^N }) )+ $/x;

pop @submatches;

print join ' ', map { $restore_case{ scalar reverse } } @submatches

# Eily+

chomp( (undef, $_, undef, @words) = <> );

%restore_case = map { lc reverse, $_ } @words;

$list = join '|', keys %restore_case;

m/^ (?: ($list | $ | (?{ pop @submatches }) (?!) ) (?{ push @submatches, $^N }) )+ $ (?{ pop @submatches })/x;

print join ' ', map { $restore_case{ $_ } } @submatches

$\ = $/;

while(<>){
	$_ = <>, chomp;
	@w = @ww = @ans = @ANS = ();

	for (1 .. <>){
		push @w, scalar <>;
		}
	chomp @w;

	%h = map { (scalar reverse lc) => 1 } @w;
	%H = map { lc, $_ } @w;

	$re = join '|', keys %h;

	/^(?:($re)(?{push @ww, $^N}))+$/;

	for $st (@ww){
		s/^$st/ (push @ans, scalar reverse $&) , ''/e;
		}

	for (@ans){
		push @ANS, $H{ $_ };
		}

	print "@ANS";
	}

chomp( (undef, $_, undef, @words) = <> );

%restore_case = map { lc, $_ } @words;

$list = join '|', map { scalar reverse lc } sort { length $a <=> length $b } @words;

m/^ (?: ($list) (?{ unshift @sub_matches, $^N }) )+ $/x;

for $sub_match (@sub_matches){
	s/$sub_match$// and unshift @ans, $restore_case{ reverse $& }
	}

print "[$_]" if $_;
print "@ans"

chomp( (undef, $_, undef, @words) = <> );

%restore_case = map { lc, $_ } @words;

$list = join '|', map { scalar reverse lc } @words;

m/^ (?: ($list) (?{ unshift @sub_matches, $^N }) )+ $/x;

for $sub_match (@sub_matches){
	s/$sub_match$// and unshift @ans, $restore_case{ reverse $& }
	}

print "[$_]" if $_;
print "@ans"

chomp( (undef, $_, undef, @words) = <> );

%restore_case = map { lc, $_ } @words;

$list = join '|', map { scalar reverse lc } @words;

m/^ (?: ($list) (?{ push @sub_matches, $^N }) )+ $/x;

for $sub_match (reverse @sub_matches){
	s/$sub_match$// and unshift @ans, $restore_case{ reverse $& }
	}

print "@ans"

chomp( (undef, $_, undef, @words) = <> );

%restore_case = map { lc, $_ } @words;

$list = join '|', map { scalar reverse lc } @words;

m/^ (?: ($list) (?{ push @sub_matches, $^N }) )+ $/x;

for $sub_match (@sub_matches){
	s/^$sub_match// and push @ans, $restore_case{ reverse $& }
	}

print "@ans";


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

<>;

while(<>){
	@_ = split ' ', <>;
	$_ = <>, chomp;

	my %h;
	my $f = 0;

	while( @_ ){
		my $i = pop @_;
		my $j = chop;

		if( exists $h{ $i } ){
			if( $h{ $i } ne $j ){
				$f = 1;
				last;
				}
			}
		else{
			$h{ $i } = $j;
			}
		}

	print $f ? 'NO' : 'YES';
	}


$\ = $/;

<>;
$c = 0;
$max = 0;
while(<>){
	chomp;
	($n, $m) = split;
	$n eq '+' and ++ $h{$m} and ++ $c; # and $c > $max and $max = $c;
	$n eq '-' and do {
		$h{$m} // $max ++;
		defined $h{$m} and $c --;
		$h{$m} and delete $h{$m};
	};
	$c > $max and $max = $c;
#	print $_,' ',$max;
#	print qw(NO YES)[]
	}
print $max;


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

my $n = <>;
chomp $n;

my $moves_s = <>;
chomp $moves_s;
my @moves = split(//, $moves_s);

my $res = 0;

for (my $i = 0; $i <= $#moves; $i += $n) {
  if ($i >= 4) {
    if ($moves[$i-3] eq $moves[$i-2]
      && $moves[$i-2] eq $moves[$i-1]) {
      $res++;
    }
  }
}

print "$res\n";


#!/usr/bin/perl -w
use strict;
use warnings;

my $n = <STDIN>; chomp $n;
my $rB = [];
for my $j ( 1 .. $n ) {
   my $a = <STDIN>; chomp $a;
   my $str = <STDIN>; my @r = split(/\s+/, $str);
   pop @r unless ( $#r+1 eq $a );
   $rB->[$j] = \@r;
}
for my $j ( 1 .. $n ) {
    my @q = sort { $a <=> $b } @{ $rB->[$j] };
    my $change = 1; my $flag = 0;
    while ( $change eq 1 ) {
     @q = sort { $a <=> $b } @q;
     $change = 0;
     $flag = 1 if ( $q[$#q] eq "2048" );
     if ( $flag eq 0 ) {
     for my $t ( 0 .. $#q - 1 ) {
        if ( $q[$t] eq "2048" ) {
            $flag = 1; last;
        }
        if ( $q[$t] eq $q[$t+1] ) {
            $change = 1;
            $q[$t] = 2*$q[$t];
            for my $p ( $t + 1 .. $#q - 1 ) {
               $q[$p] = $q[$p+1];
            }
            pop @q;
            if ( $q[$t] eq "2048" ) {
                $flag = 1; last;
            }
            last;
        }
     }
     }
     last if ( $flag eq 1 );
    }
    if ( $flag eq 1 ) { print "YES\n";
    } else { print "NO\n"; }
}

my $n = <STDIN>; chomp $n;
my $rB = [];
for my $j ( 1 .. $n ) {
   my $a = <STDIN>; chomp $a;
   my $str = <STDIN>; my @r = split(/\s+/, $str);
   pop @r unless ( $#r+1 eq $a );
   $rB->[$j] = \@r;
}
for my $j ( 1 .. $n ) {
    my @q = sort { $a <=> $b } @{ $rB->[$j] };
    my $change = 1; my $flag = 0;
    while ( $change eq 1 ) {
     $change = 0;
     $flag = 1 if ( $q[$#q] eq "2048" );
     if ( $flag eq 0 ) {
     for my $t ( 0 .. $#q - 1 ) {
        if ( $q[$t] eq "2048" ) {
            $flag = 1; last;
        }
        if ( $q[$t] eq $q[$t+1] ) {
            $change = 1;
            $q[$t] = 2*$q[$t];
            for my $p ( $t + 1 .. $#q - 1 ) {
               $q[$p] = $q[$p+1];
            }
            pop @q;
            if ( $q[$t] eq "2048" ) {
                $flag = 1; last;
            }
            last;
        }
     }
     }
     last if ( $flag eq 1 );
    }
    if ( $flag eq 1 ) { print "YES\n";
    } else { print "NO\n"; }
}

#!/usr/bin/perl -w
use strict;
use warnings;

my $n = <STDIN>; chomp $n;
my $rB = [];
for my $j ( 1 .. $n ) {
   my $a = <STDIN>; chomp $a;
   my $str = <STDIN>; my @r = split(/\s+/, $str);
   pop @r unless ( $#r+1 eq $a );
   $rB->[$j] = \@r;
}
for my $j ( 1 .. $n ) {
    my @q = sort { $a <=> $b } @{ $rB->[$j] };
    my $change = 1; my $flag = 0;
    while ( $change eq 1 ) {
     $change = 0;
     $flag = 1 if ( $q[$#q] eq "2048" );
     for my $t ( 0 .. $#q - 1 ) {
        if ( $q[$t] eq "2048" ) {
            $flag = 1; last;
        }
        if ( $q[$t] eq $q[$t+1] ) {
            $change = 1;
            $q[$t] = 2*$q[$t];
            for my $p ( $t + 1 .. $#q - 1 ) {
               $q[$p] = $q[$p+1];
            }
            pop @q;
            if ( $q[$t] eq "2048" ) {
                $flag = 1; last;
            }
            last;
        }
     }
     last if ( $flag eq 1 );
    }
    if ( $flag eq 1 ) { print "YES\n";
    } else { print "NO\n"; }
}

#!/usr/bin/perl -w
use strict;
use warnings;

my $n = <STDIN>; chomp $n;
my $rA = []; my $rB = [];
for my $j ( 1 .. $n ) {
   $rA->[$j] = <STDIN>;
   my $str = <STDIN>; my @r = split(/\s+/, $str);
   $rB->[$j] = \@r;
}
for my $j ( 1 .. $n ) {
    my @q = sort { $a <=> $b } @{ $rB->[$j] };
    my $change = 1; my $flag = 0;
    while ( $change eq 1 ) {
     $change = 0;
     $flag = 1 if ( $q[$#q] eq "2048" );
     for my $t ( 0 .. $#q - 1 ) {
        if ( $q[$t] eq "2048" ) {
            $flag = 1; last;
        }
        if ( $q[$t] eq $q[$t+1] ) {
            $change = 1;
            $q[$t] = 2*$q[$t];
            for my $p ( $t + 1 .. $#q - 1 ) {
               $q[$p] = $q[$p+1];
            }
            pop @q;
            if ( $q[$t] eq "2048" ) {
                $flag = 1; last;
            }
            last;
        }
     }
     last if ( $flag eq 1 );
    }
    if ( $flag eq 1 ) { print "YES\n";
    } else { print "NO\n"; }
}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	my( $X, $Y ) = split ' ', <>;

	my $check = 0;

	my @top = (~0) x 5;
	my @bot = (-~0) x 5;
	my @topF;
	my @botF;

	for (1 .. $_){
		my( $fig, $x, $y ) = split ' ', <>;

		my $D = $x == $X ? 1 :
			$y == $Y ? 2 :
			$x + $y == $X + $Y ? 3 :
			$x - $X == $y - $Y ? 4 : 0;

		$D or next;
		my $M = $X;
		$D == 1 and do { $x = $y ; $M = $Y };

		if( $x > $M and $x < $top[$D]){
			$top[$D] = $x;
			$topF[$D] = $fig;
			}
		if( $x < $M and $x > $bot[$D]){
			$bot[$D] = $x;
			$botF[$D] = $fig;
			}
		}

	$check += grep /[QR]/, grep defined, @topF[1,2], @botF[1,2];
	$check += grep /[QB]/, grep defined, @topF[3,4], @botF[3,4];

	print $check ? "YES" : "NO";
}

#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	my( $X, $Y ) = split ' ', <>;

	my( @X, @Y, @a8h1, @a1h8 );

	for (1 .. $_){
		my( $fig, $x, $y ) = split ' ', <>;

		if( $x == $X ){
			push @X, [$fig, $x, $y];
			}
		if( $y == $Y ){
			push @Y, [$fig, $x, $y];
			}
		if( $x + $y == $X + $Y ){
			push @a8h1, [$fig, $x, $y];
			}
		if( $x - $X == $y - $Y ){
			push @a1h8, [$fig, $x, $y];
			}
		}

	my $check = 0;

	my $top = ~0;
	my $bottom = -~0;
	my $topFig;
	my $bottomFig;

	for( @X ){
		if( $_->[2] > $Y and $_->[2] < $top){
			$top = $_->[2];
			$topFig = $_->[0];
			}
		if( $_->[2] < $Y and $_->[2] > $bottom){
			$bottom = $_->[2];
			$bottomFig = $_->[0];
			}
		}

	$check += grep /[QR]/, grep defined, $topFig, $bottomFig;

#	print "check X: $check";

	my $top = ~0;
	my $bottom = -~0;
	my $topFig;
	my $bottomFig;

	for( @Y ){
		if( $_->[1] > $X and $_->[1] < $top){
			$top = $_->[1];
			$topFig = $_->[0];
			}
		if( $_->[1] < $X and $_->[1] > $bottom){
			$bottom = $_->[1];
			$bottomFig = $_->[0];
			}
		}

	$check += grep /[QR]/, grep defined, $topFig, $bottomFig;

#	print "check Y: $check";

	my $top = ~0;
	my $bottom = -~0;
	my $topFig;
	my $bottomFig;

	for( @a8h1 ){
		if( $_->[1] > $X and $_->[1] < $top){
			$top = $_->[1];
			$topFig = $_->[0];
			}
		if( $_->[1] < $X and $_->[1] > $bottom){
			$bottom = $_->[1];
			$bottomFig = $_->[0];
			}
		}

	$check += grep /[QB]/, grep defined, $topFig, $bottomFig;

#	print "check a8h1: $check";

	my $top = ~0;
	my $bottom = -~0;
	my $topFig;
	my $bottomFig;

	for( @a1h8 ){
		if( $_->[1] > $X and $_->[1] < $top){
			$top = $_->[1];
			$topFig = $_->[0];
			}
		if( $_->[1] < $X and $_->[1] > $bottom){
			$bottom = $_->[1];
			$bottomFig = $_->[0];
			}
		}

	$check += grep /[QB]/, grep defined, $topFig, $bottomFig;

#	print "check a1h8: $check";

	print $check ? "YES" : "NO";
}


$n=<STDIN>;
$_ = <STDIN>; @a=split;
$prvval=-1;
$cur=0;
$curv=$a[0];
$isok=1;
foreach $x (@a)
{
    if($curv!=$x) {
        if($prvval!=-1){
            if($cur!=$prvval) {
                $isok = 0;
            }
        }
        $prvval = $cur;
        $cur = 0;
        $curv = $x;

    }
    $cur=$cur+1;
}

if($prvval!=-1){
    if($cur!=$prvval) {
        $isok = 0;
    }
}

if($isok==1){
    print "YES";
}
else
{
    print "NO";
}

#!/usr/bin/env perl

use strict;
use warnings;
no warnings 'uninitialized';

my $N = <>+0;
my $line = <>;
chomp $line;
$line =~ s/ +//g;
$line =~ s/01/0#1/g;
$line =~ s/10/1#0/g;

#print $line, "\n";

my @A = split '#', $line;

my $M = scalar(@A);
for (my $i = 1; $i < $M; ++$i) {
   if (length($A[$i]) != length($A[0])) {
      print "NO\n";
      exit(0);
   }
}

print "YES\n";

$n = <STDIN>;
@bits = split / /, <STDIN>;

$first = @bits[0];
$mb_len = 1;
$mb_len_done = 0;

for ($curr = 1; $curr < $n; $curr++) {
	if (@bits[$curr] != @bits[$curr-1]) {
		$mb_len_done = 1;
	}
	if (!$mb_len_done) {
		$mb_len += 1;
	}
}

if ($mb_len == $n) {
	print "Yes";
	exit();
}

$result = 1; # true
$curr_color = $first;
$last = 0;

for ($i = 0; $i < $n;) {
	$last = 0;
	for ($j = 0; $j < $mb_len && $i < $n; $j++) {
		$last += 1;
		if ($curr_color != @bits[$i]) {
			$result = 0;
		}
		$i += 1;
	}
	$curr_color = ($curr_color + 1) % 2;
}

if ($result && $last == $mb_len) {
	print "Yes";
} else {
	print "No";
}


#!/usr/bin/perl

my ($t) = map { $_ - 0 } split(/\s+/,<STDIN>);

for( my $t_loop=0; $t_loop<$t; $t_loop++ ){

  my @x = map { $_ - 0 } split(/\s+/,<STDIN>);
  $#x = 2;
  my @sx = sort { $b <=> $a } @x;

  if( $sx[0] != $sx[1] ){
    print "NO\n";
    next;
  }

  my $a = $sx[0];
  my $b = $sx[2];
  print "YES\n";
  print "$a $b $b\n";

}

exit(0);

chomp(my $t = <STDIN>);
print $t;
foreach (1..$t)
{
    my @a = split /\s+/, <STDIN>;
    my @x = sort { $b <=> $a } @a;
    if ($x[0] != $x[1])
    {
        print "NO\n";
    }
    else
    {
        my ($a, $b) = ($x[0], $x[2]);
        print "YES\n$a $b $b\n";
    }
}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	my( $n, $k ) = split;

	@_ = split ' ', <>;

	my %h;
	my @q;

	for( @_ ){
		next if exists $h{ $_ };

		if( $k == @q ){
			my $del = shift @q;
			delete $h{ $del };
			}

		push @q, $_;
		$h{ $_ } = 1;
		}

	print ~~ @q;
	print join ' ', reverse @q;
	}

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/ say /;

chomp (my $line = <STDIN>);

my ($n, $k) = split q{ }, $line;

my @inputs = split q{ }, <STDIN>;

my $set = {};
my @answer = ();

for my $input ( @inputs ) {
    if ( defined $set->{$input} ) {
        next;
    }
    else {
        if ( @answer == $k ) {
            my $id = shift @answer;
            delete $set->{$id};
        }
        push @answer, $input;
        $set->{$input} = 1;
    }
}

say scalar @answer;
@answer = reverse @answer;
say "@answer";

#!/usr/bin/env perl

my ($messages, $limit) = split /\s/, <>;
my @IDs   = split /\s/, <>;
my @shown = ();

for my $id (@IDs) {
    unless (grep { $_ == $id } @shown ) {
        pop @shown unless @shown < $limit;
        unshift @shown, $id;
    }
}

$\ = "\n";
print scalar @shown;
print join(" ", @shown);


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	my $max = ~0;
	my $f = 0;

	for( 1 .. $_ ){
		my( $A, $B ) = sort { $b <=> $a } split ' ', <>;
		if( $A > $max ){ $A = $B; }
		if( $A > $max ){ $f ++; }
		$max = $A;
		}

	print $f ? "NO" : "YES";
	}


#!/usr/bin/perl

use warnings;
use strict;

$\ = $/;

while(<>){
	@_ = split ' ', <>;

	my %h;

	$h{ $_ } ++ for @_;

	my %ones;
	my %twos;
	my %mores;

	for( keys %h ){
		if( $h{ $_ } == 1 ){
			$ones{ $_ } = 1;
			}
		elsif( $h{ $_ } == 2 ){
			$twos{ $_ } = 1;
			}
		else{
			$mores{ $_ } = 1;
			}
		}

	my %convert;

	for( keys %twos ){
		$convert{ $_ } = 'A';
		}

	for( keys %mores ){
		$convert{ $_ } = 'A';
		}

	if( ( keys %ones ) % 2 == 1 and 0 == keys %mores ){
		print "NO";
		}
	else{
		if( ( keys %ones ) % 2 == 1 ){
			my $to_split = ( sort { $a <=> $b } keys %mores )[ 0 ];

			for( @_ ){
				$_ == $to_split and do { $_ = 0 ; last; };
				}
			$ones{ 0 } = 1;
			}

		my @ones = ( sort { $a <=> $b } keys %ones );

		for my $i ( 0 .. @ones - 1 ){
			$convert{ $ones[ $i ] } = $i % 2 ? 'A' : 'B';
			}

		my $ans = '';

		for( @_ ){
			$ans .= $convert{ $_ };
			}

		print "YES";
		print $ans;
		}

	}


#!/usr/bin/perl

$ans = 0;

@str1 = split(' ', <STDIN>);

$n = @str1[0];
$k = @str1[1];

@str2 = split(' ', <STDIN>);

for my $now (@str2) {
    $counter = 0;
    while($now > 0) {
        $digit = $now % 10;
        if($digit == 4 || $digit == 7) {
            $counter += 1;
        }
        $now /= 10;
    }
    if($counter <= $k) {
        $ans += 1;
    }
}

print $ans;

#!/bin/perl -w
use strict;
use warnings;

my ($n, $k) = map int, split '\D', <>;
my @numbers = map int, split '\D', <>;

my $answer = 0;

for (@numbers) {
    if ($_ =~ tr/[47]/L/ <= $k) {
	$answer++;
    }
}

print "$answer\n";