jo26 has asked for the wisdom of the Perl Monks concerning the following question:

Hi can you help please - i'm just having trouble mapping two group of entries.

My input file, has five teams with two group for each team (seperated by "/". I want to map if a member of a team, say Team1, from the first group (left side) is also present in any other team of the second group (right side), then i want to map the two teams. i.e. Joe is in Team1 and Team2, so map these together, but if a team member is found in only one side of the team is left unmaped. Please see input and the expect output below. 

INPUTFILE
Team1=Joe / Phil , Amenda
Team2=James / Pam, Joe
Team3=Carmen , Lisa / James
Team4=Don , Phil / Carmen
Team5=Uri , Kate / Don
------------------------
Expected OUTPUT
Don IS IN Team5 AND Team4
Phil IS IN Team4 AND Team1
Carmen IS IN Team4 AND Team3
James IS IN Team3 AND Team2
Joe IS IN Team2 AND Team1

[download]

Here is my code, as you can see i'm not getting the correct mapping. even if i add the 'if statment' i can't seem to get the correct mapping

use Data::Dumper;
open (my $infile, "<", "teamInput.txt") || die $!;

while (defined(my $line = <$infile>)) {
    chomp $line;
    my @team = split /=/, $line;

 my ($a, $b) = split /\//, $team[1]; #member in group 1 and 2 split by
+ '/'
    my @x = split /\,/, $a;
    my @y = split /\,/, $b;
     
    my @results; 
    for my $x1(@x) {
        for my $y1(@y){
            #if ($x1 eq $y1){
        push @results,  [$team[0],$x1, $y1];
            }
        }

    print join("\n", map { $_->[1] "$_->[0] AND $_->[0]" } @results), 
+"\n";
 #print Dumper(\@results);
    }
#}

[download]

Thank you for your time

Replies are listed 'Best First'.
Re: Matching problem
by choroba (Cardinal) on Sep 08, 2013 at 22:12 UTC
    Array is not going to help you much. The right data structure here is hash: 
    #!/usr/bin/perl
use warnings;
use strict;

my %players;
while (<DATA>) {
    my ($team, $left, $right) = m{(.+)=(.+?) */ *(.+)};
    my @lefts  = split / *, */, $left;
    my @rights = split / *, */, $right;
    $players{$_}{left}  = $team for @lefts;
    $players{$_}{right} = $team for @rights;
}

for my $player (keys %players) {
    if (2 == grep exists $players{$player}{$_}, qw/left right/) {
        print "$player IS IN $players{$player}{right} AND",
                           " $players{$player}{left}\n";
    }
}

__DATA__
Team1=Joe / Phil , Amenda
Team2=James / Pam, Joe
Team3=Carmen , Lisa / James
Team4=Don , Phil / Carmen
Team5=Uri , Kate / Don

    [download]

    As you can see, it assigns each player his/her left and right team, and only lists the players with both teams assigned. It does not check, though, whether a player is not assigned more than one team on the same side.

    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
[reply]
[d/l]
Re: Matching problem
by rjt (Curate) on Sep 09, 2013 at 01:14 UTC

    Edit: I misunderstood the left/right requirement in my first pass. (Are Mulligans permissible with these teams?) Here's a version that's hopefully much closer to what you want:

    my %players;
for (<DATA>) {
    chomp;
    my ($team) = m!^ (.+?) = (?<left>.+?) \s*/\s* (?<right>.+) $!x
        or die "Line `$_' doesn't match";

    for my $side (qw<left right>) {
        $players{$_}{$side} = $team for split m!\s*[,/]\s*!, $+{$side}
+;
    }
}

# Remove players only on one team
delete @players{ grep { keys %{$players{$_}} == 1 } keys %players };

local $" = ' AND ';
print "$_ IS IN @{$players{$_}}{qw<left right>}\n" for keys %players;

    [download]

    The logic is relatively straightforward. For each line, parse the team, left, and right strings or die trying, and then split the left and right chunks into left/right. We are then left with, for example, $players{Don} = { left => 'Team4', right => 'Team5' };. After that, we can delete any player who has only 1 key in their hash, as they are only on left or right, and not both.

    I'll leave my original misguided answer below the readmore tag.

    Read more... (1521 Bytes)
[reply]
[d/l]
[select]
Re: Matching problem
by Marshall (Canon) on Sep 09, 2013 at 10:31 UTC
    I didn't quite understand the format spec and the difference between the '/' and ','.

    However I figure that a hash table is the right idea. For your enjoyment and comments...

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

my %name2team; #eg Phil  => Team1, Team4
my %team2name; #eg Team1 => Joe Phil Amenda

my $line= "";
while ($line = <DATA> )
{
   next if $line =~ /^\s+$/;      #skip blank lines
   
   $line =~ s/[=,\/\s+]/ /g;      #make spaced based tokens
   
   my ($team, @names) = split /\s+/, $line;
   
   foreach my $name (@names)
   {      
       push @{$name2team{$team}},$name; 
       push @{$team2name{$name}},$team;
   }   
}

foreach my $team (sort keys %name2team)
{
   print "$team has: @{$name2team{$team}}\n";
}

print "\n"; #just a spacer line

foreach my $name (sort keys %team2name)
{
   print "$name is on: @{$team2name{$name}}\n";
}

=output of the above:

Team1 has: Joe Phil Amenda
Team2 has: James Pam Joe
Team3 has: Carmen Lisa James
Team4 has: Don Phil Carmen
Team5 has: Uri Kate Don

Amenda is on: Team1
Carmen is on: Team3 Team4
Don is on: Team4 Team5
James is on: Team2 Team3
Joe is on: Team1 Team2
Kate is on: Team5
Lisa is on: Team3
Pam is on: Team2
Phil is on: Team1 Team4
Uri is on: Team5
=cut

__DATA__

Team1=Joe / Phil , Amenda
Team2  =  James / Pam, Joe
Team3= Carmen , Lisa / James
Team4=Don , Phil / Carmen
Team5=Uri , Kate / Don

    [download]
[reply]
[d/l]

      Hi PerlMonks! Thank you for your help, its greatly appreciated

[reply]

Back to Seekers of Perl Wisdom