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

When you are referring to your friend, about something that you both may know from the past experience, you are not describing the whole scene. You just tell couple of things and your friend would know easily, what you are talking about.

In the similar way, I like to teach computer. First I feed different bunch of things to computer. I call them sets. So now each set has several items. These sets could be of concepts, associative elements, etc.. Remember, that each set doesn't have to have the set name. I keep on adding the items to computer. I can add items to one or more sets. Example. I can add 'apple' where there is 'banana' or and also where there is 'ipod' etc..

Eventually, I like computer to understand what I am talking about. So when I talk about 'apple', computer will be slightly confused. If I talk about apple and orange, computer can refer to right set. Now for this process, I like to create Set-Key for each set. I give set-ID to each set. I want to make KEY consists of fewest number of element, by which I can uniquely identify the set. So when I tell Set-Key, computer can easily understand which set I am talking about.. 

use strict;
use warnings;
$| += 1;

my $X;
my $Y;
my $Z;
while(<DATA>){
    chomp;
    my ($id,@values) = split /:| /;
    foreach (@values){
        push @{$X->{$_}}, $id;
        $Y->{$id}{$_} = 1;
    }
}
foreach (keys %{$X}){
    $Z->{$_} = scalar @{$X->{$_}};
}

my $MAX = 3; # Max Number of elmenets in Set-Key
foreach my $id (sort { ($a <=> $b ) || ($a  cmp $b) } keys %{$Y}){
    print "$id =>";
    my @values = sort { $a <=> $b } keys %{$Y->{$id}};
    my $count = 0;
    my @pvalues;
    my $check = 0;
COUNT:    while($count <=$MAX){
        $check += 1;
        foreach my $value (@values){
            if($Z->{$value} == $check){
                push @pvalues,$value;
                $count++;
                last COUNT if $count == scalar @values;
                last COUNT if $count == $MAX;
            }
        }
    }
    my $string = join " " =>  @pvalues;
    print "$string ($count)\n";
}
__DATA__
0:25 11 85 83 75 57 7 20 38 69 34 45 24 65 55
1:35 33 64 57 17 48 22 88 49 72 37 76 65
2:27 40 97 58 48 47 20 59 34 77 13 86 55
3:21 39 53 75 91 26 51 2 92 38 88 93 72 43 23
4:3 40 71 80 12 78 79 22 42 93 34 24 43 44
5:84 25 11 32 90 21 95 2 12 14 20 87 18 10 55
6:6 67 53 71 61 17 41 48 98 88 93 73 86 44
7:27 6 21 75 94 80 68 78 15 79 99 72 24 73 65
8:36 80 78 79 14 38 1 76 96 5
9:84 57 94 26 51 12 17 58 47 69 37 13 96 44 31
10:25 67 11 90 40 38 77 30 76 16 65 44 54 82
11:84 50 85 3 97 92 87 1 98 4 88 46 73 30 31
12:33 75 26 68 58 8 98 60 93 13 19 10 5
13:40 17 78 48 14 69 38 98 4 93 24 45 66 76 55
14:84 75 61 58 48 14 20 81 89 16 19 31 96 55 82
15:35 11 21 90 39 80 58 78 48 92 93 77 37 66 29
16:27 85 57 75 61 9 68 41 14 59 99 77 93 29 54
17:9 51 26 68 58 15 98 60 56 89 45 23 96 54
18:84 71 70 68 9 12 52 92 87 46 66 19 29 31
19:35 33 32 21 64 59 69 38 87 18 24 43 96 65
20:35 6 50 90 95 71 17 15 69 98 0 66 16

__ANSWER__
0 =>7 83 25 34 45 (5)
1 =>49 22 64 33 37 (5)
2 =>47 86 97 13 27 (5)
3 =>91 2 23 39 53 (5)
4 =>42 3 22 34 43 (5)
5 =>2 10 18 32 95 (5)
6 =>41 53 67 86 6 (5)
7 =>94 99 6 15 27 (5)
8 =>36 1 5 79 76 (5)
9 =>47 94 13 37 51 (5)
10 =>30 67 82 16 25 (5)
11 =>1 3 4 30 46 (5)
12 =>8 5 10 60 13 (5)
13 =>4 45 40 66 76 (5)
14 =>81 82 89 16 19 (5)
15 =>39 29 37 11 35 (5)
16 =>41 99 9 27 29 (5)
17 =>56 23 60 89 9 (5)
18 =>52 70 46 9 19 (5)
19 =>18 32 64 33 43 (5)
20 =>0 50 95 6 15 (5)

[download]

Is this problem formed in other ways? Some standard solution exists that I may not have research earlier? I appreciate any flow in code or better algorithm.

Thanks.

Update: Changed the title.

Replies are listed 'Best First'.
Re: Defining Set-Key
by jZed (Prior) on Dec 21, 2004 at 21:44 UTC
    It sounds like prolog (a logic-based language). I've never used perl's implementation of prolog, but you might check it out: Language::Prolog.
[reply]
[reply]

Back to Seekers of Perl Wisdom