common questions

anagrams.pl

#!/usr/bin/env perl

use Modern::Perl;
use Data::Dumper;
use Test::More;

sub hash {
  my ($string) = shift;
  my $hash = {};
  for my $c (split(//, $string)) {
    ($hash->{$c})++;
  }
  return $hash;
}

sub size {
  my ($hash) = shift;
  my @keys = keys(%$hash);
  return $#keys + 1;
}

sub anagrams {
  my ($source, $target) = @_;
  return 0 if $source eq $target;
  my ($shash, $thash) = map { hash($_) } ($source, $target);
  for my $k (keys($shash)) {
    return 0 unless $shash->{$k} == $thash->{$k};
  }
  return (size($shash) == size($thash)) ? 1 : 0;
}


ok(!anagrams("hello", "hello"), "hello and hello are not anagrams");
ok(!anagrams("hello", "world"), "hello and world are not anagrams");
ok(anagrams("pluto", "toplu"), "pluto and toplu are anagrams");

done_testing;

binarysearch.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;
use feature 'current_sub';

package BinarySearch;
use POSIX;

sub iter {
  my ($data, $search) = @_;
  my ($low, $high) = (0, $#{$data});

  while ($low <= $high) {
    my $mid = floor(($low + $high) / 2);

    if ( $data->[$mid] == $search) {
      return [$mid, $data->[$mid]];
    } elsif ($data->[$mid] > $search) {
      $high = $mid - 1;
    } else {
      $low = $mid + 1;
    }
  }

  return -1;
}

sub rcur {
  my ($data, $search, $low, $high) = @_;
  $low  //= 0;
  $high //= $#{$data};
  return -1 if $low > $high;

  my $mid = floor(($low + $high) / 2);

  if ($data->[$mid] == $search) {
    return [$mid, $data->[$mid]];
  } elsif ($data->[$mid] > $search) {
    return __SUB__->($data, $search, $low, $mid - 1);
  } else {
    return __SUB__->($data, $search, $mid + 1, $high);
  }
}

package main;

my $input = [3, 7, 14, 20, 23, 32, 41, 44, 56, 57, 73, 89, 93];

say Dumper(BinarySearch::iter($input, 14));
say Dumper(BinarySearch::iter($input, 93));
say Dumper(BinarySearch::iter($input, 57));
say Dumper(BinarySearch::iter($input, 100));

say Dumper(BinarySearch::rcur($input, 14));
say Dumper(BinarySearch::rcur($input, 93));
say Dumper(BinarySearch::rcur($input, 57));
say Dumper(BinarySearch::rcur($input, 100));

bit-compress.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $image = [1,1,1,2,2,55,55,55,238,238,238,238,91,91,91,2,2,2,2,1,4,7,7,7,12,127];

sub compress {
  my ($image) = @_;
  push($image, undef);

  my $i = shift($image);
  my $c = 1;

  my $result = [];

  for (@$image) {
    if ($_ == $i) {
      $c++;
    } else {
      push($result, [$i, $c]);
      $i = $_;
      $c = 1;
    }
  }

  $result;
}

say Dumper($image);
say Dumper(compress($image));

find-seq.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $array = [1,3,4,2,6,7,4];

sub find_seq_with_sum {
  my ($n, $list) = @_;
  my ($result, $s) = ([], 0);

  for (@$list) {
    while ($s > $n) { $s -= shift($result); }

    last if $s == $n;

    # $s < $n
    push($result, $_);
    $s += $_;
  }

  return $result;
}

say Dumper(find_seq_with_sum(13, $array));
say Dumper(find_seq_with_sum(12, $array));
say Dumper(find_seq_with_sum(11, $array));
say Dumper(find_seq_with_sum(10, $array));
say Dumper(find_seq_with_sum(9, $array));

first-uniq.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $numbers = [1,1,2,3,56,4,7,4,3,2,56,1000];

my $index = {};

for (@$numbers) {
  $index->{$_}++
}

say Dumper($index);

for (@$numbers) {
  if ($index->{$_} == 1) {
    say $_;
    last;
  }
}

my $dups = [grep { $index->{$_} > 1 } keys($index)];
say Dumper($dups);

hex.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $string = "00FF2A354C";

say Dumper([map { hex($_) } ($string =~ m/../g)]);

hexnibles.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $str = "0F3A45JA";

say $str;

say Dumper [map {
  if ($_ =~ m/[0-9A-Fa-f]/) {
    my $nibble = sprintf("%b", hex($_));
    $nibble = 0 x (4 - length($nibble)) . $nibble;
  } else {
    $_
  }
} split(//, $str)];

multi-sets.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

sub intersection {
  my ($first, $second) = @_;
  my ($hash1, $hash2, $common) = ({}, {}, {});
  [map { ($_) x min($hash1->{$_}, $hash2->{$_}) } grep { ++$common->{$_} > 1 } (grep({ not $hash1->{$_}++ } @$first), grep({ not $hash2->{$_}++ } @$second))];
}

sub min {
  my $result = shift;
  for (@_) {
    $result = $_ if $_ < $result;
  }
  $result;
}

my $set1 = [1,1,2,2,2,3,3,4,4,4,4,4,5,7,7,9];
my $set2 = [2,2,2,2,2,3,3,3,7,9,9,9];

say Dumper(intersection($set1, $set2));

multi-sets.rb

#!/usr/bin/env ruby

def intersection(first, second)
  hash1, hash2, common = {}, {}, {}
  (first.reject { |i| (hash1[i] = hash1[i].to_i + 1) > 1 } + second.reject { |i| (hash2[i] = hash2[i].to_i + 1) > 1 })
    .select { |i| (common[i] = common[i].to_i + 1) > 1 }
    .each_with_object([]) { |i, result| result.concat([i] * [hash1[i], hash2[i]].min)}
end

set1 = [1,1,2,2,2,3,3,4,4,4,4,4,5,7,7,9];
set2 = [2,2,2,2,2,3,3,3,7,9,9,9];

puts intersection(set1, set2).inspect

remove-repeated.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $numbers = [3,9,3,1,4,5,1,4,7,2,4,2,4,2,4,7];

sub uniq {
  my $hash = {};
  [grep { not $hash->{$_}++ } @{shift()}];
}

say Dumper($numbers);
say Dumper(uniq($numbers));

set-theory.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $first = [3,1,2,4];
my $second = [1,4,5];

sub count {
  my ($first, $second) = @_;
  my $union = {};
  for (@$first, @$second) {
    $union->{$_}++;
  }
  $union;
}

sub union {
  [keys count(@_)];
}

sub intersection {
  my $count = count(@_);
  [grep { $count->{$_} > 1 } keys($count)];
}

sub difference {
  my $result = count(shift);
  delete @{$result}{keys count(shift)};
  [keys $result];
}

say Dumper(union($first, $second));
say Dumper(intersection($first, $second));
say Dumper(difference($first, $second));
say Dumper(difference($second, $first));

sort-hash.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $hash = {
  a => 1,
  b => 3,
  c => 2,
};

say Dumper $hash;
say Dumper [sort { $hash->{$a} <=> $hash->{$b} } keys $hash];

sort-user.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

my $users = [
  {
    name => 'John',
    score => 10,
  },
  {
    name => 'Bob',
    score => 1,
  },
  {
    name => 'Carlos',
    score => 5
  },
  {
    name => 'Alice',
    score => 5,
  },
  {
    name => 'Donald',
    score => 7
  },
];

sub compare {
  my ($first, $second, $attrs) = @_;
  return 0 if $#{$attrs} == -1; # $attrs is []
  my ($attr, @rest) = @{$attrs};

  no warnings 'numeric';
  my $result = ( $first->{$attr} <=> $second->{$attr} || $first->{$attr} cmp $second->{$attr} );
  return ( $result == 0 ) ?  compare($first, $second, [@rest]) : $result;
}

sub sort_object {
  my ($objects, $attrs) = @_;
  sort { compare($a, $b, $attrs) } @{$objects};
}

say Dumper(sort {compare($a, $b, [qw(score name)])} @{$users});
say Dumper(sort_object($users, [qw(score name)]));

# simpler version for only users
sub sort_user {
  my ($users) = shift;
  [sort {
    if ( (my $score = $b->{score} <=> $a->{score}) == 0 ) {
      $a->{name} cmp $b->{name};
    } else {
      $score;
    }
  } @$users];
}

say Dumper(sort_user($users));

# show length of names
say Dumper {map { $_->{name} => length($_->{name}) } @{sort_user($users)}};

# filter with length of names
say Dumper [map { $_->{name} } grep { length($_->{name}) <= 4 } @{sort_user($users)}];

wantarray.pl

#!/usr/bin/env perl
use Modern::Perl;
use Data::Dumper;

sub hello {
  wantarray() ? qw(hello world) : [qw(hello, world)];
}

say Dumper(my $hello = hello());
say Dumper(\(my @hello = hello()));
say Dumper(scalar(hello()));

say Dumper(hello());
say (hello());
say scalar hello();