Как «сопоставить» между 3 значениями?

Question

У меня много таких данных, как это

type1, type2, type3
aax, ert, ddd
asx, eer, kkk
xkk, fff, lll
xxj, vtt, lle
...

, и я действительно хотел бы иметь возможность "сопоставить" их между собой, поэтому я могу перейти от

type1 -> type2
type1 -> type3
type2 -> type1
type3 -> type1

Пример:

type1_to_type2(aax) should return ert
type1_to_type3(asx) should return kkk
type2_to_type3(fff) should return lll
type3_to_type1(lle) should return xxj

Какую структуру данных следует использовать для данных?

И как бы выглядели такие функции?

Обновление : все данныеуникальный.

Answer 1

Версия, которая фактически реализует функции 'type1_to_type2' и т. Д. ...

#!/usr/bin/perl

use strict;
use warnings;

my $data;
while (<DATA>) {
  chomp;
  push @$data, [ split ];
}

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

  foreach (@$data) {
    if ($_->[$x - 1] eq $str) {
      return $_->[$y - 1];
    }
  }

  return;
}

sub type1_to_type2 { typeX_to_typeY(1, 2, @_) }
sub type1_to_type3 { typeX_to_typeY(1, 3, @_) }
sub type2_to_type1 { typeX_to_typeY(2, 1, @_) }
sub type2_to_type3 { typeX_to_typeY(2, 3, @_) }
sub type3_to_type1 { typeX_to_typeY(3, 1, @_) }
sub type3_to_type2 { typeX_to_typeY(3, 2, @_) }

# tests
use Test::More tests => 4;

is(type1_to_type2('aax'), 'ert');
is(type1_to_type3('asx'), 'kkk');
is(type2_to_type3('fff'), 'lll');
is(type3_to_type1('lle'), 'xxj');

__DATA__
aax ert ddd
asx eer kkk
xkk fff lll
xxj vtt lle

Answer 2

Один из подходов - использовать базу данных для такого рода вещей. Вот иллюстрация:

use strict;
use warnings;

use DBI;
my $dbh = DBI->connect("dbi:SQLite:dbname=demo_db","","");

# Initialize an SQLite DB with some content.
my @init_db = (
    'CREATE TABLE demo (ty1 VARCHAR(5), ty2 VARCHAR(5), ty3 VARCHAR(5));',
    'INSERT INTO demo (ty1, ty2, ty3) values ("aax", "ert", "ddd");',
    'INSERT INTO demo (ty1, ty2, ty3) values ("asx", "eer", "kkk");',
    'INSERT INTO demo (ty1, ty2, ty3) values ("xkk", "fff", "lll");',
    'INSERT INTO demo (ty1, ty2, ty3) values ("xxj", "vtt", "lle");',
);

for my $s (@init_db){
    $dbh->do($s) or die $!;
}

# Query the data by any field we like.
my $sth = $dbh->prepare('SELECT * FROM demo');
$sth->execute();
my $result = $sth->fetchall_hashref('ty1');

Результатом является ссылка на хэш хэшей, который определяется значением ty1, а затем именами полей в нашей таблице. Например:

$result->{xkk} = {
  'ty2' => 'fff',
  'ty3' => 'lll',
  'ty1' => 'xkk'
};

Если вас интересует только одно конкретное значение данного поля, вы можете использовать более конкретный запрос. При таком подходе очень просто написать служебные методы - например, взять имя поля и интересующее значение и вернуть результаты в любом удобном формате.

Answer 3

Если все строки уникальны, вы можете использовать их в качестве ключей в хэше:

my %data = (
    aax => ["aax", "ert", "ddd"],
    ert => ["aax", "ert", "ddd"],
    ddd => ["aax", "ert", "ddd"],
    asx => ["asx", "eer", "kkk"],
    ...
);

sub get_value {
    my ($s, $type) = @_;
    return $data{$s}[$type-1];
}

print get_value("aax", 2); # "ert"

Answer 4

Давайте начнем с воображения мира, которым мы хотели бы существовать.

#! /usr/bin/env perl

use strict;
use warnings;

use Convert q(
  type1, type2, type3
  aax,   ert,   ddd
  asx,   eer,   kkk
  xkk,   fff,   lll
  xxj,   vtt,   lle
);

С этим небольшим количеством фронта мы должны иметь возможность вызывать несколько удобных функций:

use Test::More;

diag type1_to_type2("aax");
diag type1_to_type3("asx");
diag type2_to_type3("fff");
diag type3_to_type1("lle");

Результаты должны соответствовать тому, что в таблице.

my @tests = (
  [ qw/ type1_to_type2 aax ert / ],
  [ qw/ type1_to_type3 asx kkk / ],
  [ qw/ type2_to_type3 fff lll / ],
  [ qw/ type3_to_type1 lle xxj / ],
  [ qw/ type2_to_type1 ert aax / ],
);

my %sub_ok;
for (@tests) {
  my($name,$from,$expect) = @$_;

  my $sub;
  { no strict 'refs';
    unless ($sub_ok{$name}++) {
      ok defined &$name, "$name defined"
        or next;
    }
    $sub = \&$name;
  }

  is $sub->($from), $expect, "$name($from)";
}

done_testing;

Чтобы это произошло, модуль Convert должен взять спецификацию и сгенерировать соответствующие подпрограммы.

Код в Convert.pm начинается со знакомого шаблона.

package Convert;

use strict;
use warnings;

Согласно документации perlfunc , use Module LIST эквивалентно

BEGIN { require Module; Module->import( LIST ); }

так что import Конверта нужно взять таблицу в качестве одного из аргументов. (Первая, которую мы игнорируем, это строка "Convert", потому что import вызывается как метод класса.)

sub import {
  my(undef,$spec) = @_;

  my %map;
  my @names;
  _populate(\%map, \@names, $spec);

  my $pkg = caller;
  foreach my $n1 (@names) {
    foreach my $n2 (@names) {
      next if $n1 eq $n2;

      my $sub = sub {
        my($preimage) = @_;
        return unless exists $map{$n1}{$n2}{$preimage};
        $map{$n1}{$n2}{$preimage};
      };

      my $name = $pkg . "::" . $n1 . "_to_" . $n2;
      { no strict 'refs'; *$name = $sub; }
    }
  }
}

С помощью _populate, объясненного ниже, мы создаем хеш, ключи которого

1. из-имя
2. к имени
3. прообраз

Например, первая строка данных в спецификации (aax, ert, ddd) соответствует шести (= ₃ P ₂ ) записей:

1. $map{type1}{type2}{aax} = "ert"
2. $map{type1}{type3}{aax} = "ddd"
3. $map{type2}{type1}{ert} = "aax"
4. $map{type2}{type3}{ert} = "ddd"
5. $map{type3}{type1}{ddd} = "aax"
6. $map{type3}{type2}{ddd} = "ert"

Имея хеш, мы затем устанавливаем подпрограммы ( например, , type1_to_type2) в пространство имен вызывающего, где каждый ищет свой аргумент в соответствующем слоте и возвращает отображенное изображение , если оно существует.

В _populate мы берем имена столбцов из первой непустой строки. Для оставшихся строк данных каждая пара значений входит в карту.

sub _populate {
  my($map,$names,$spec) = @_;

  my $line;
  for (split /\s*\n\s*/, $spec) {
    ++$line;
    my @fields = split /\s*,\s*/;
    next unless @fields;

    if (@$names) {
      my %f;
      @f{@$names} = @fields;
      unless (@fields == @$names) {
        warn "$0: line $line: number of fields and columns do not match!\n";
        next;
      }

      foreach my $n1 (@$names) {
        foreach my $n2 (@$names) {
          next if $n1 eq $n2;
          my($f1,$f2) = @f{$n1,$n2};

          my $slot = \$map->{$n1}{$n2}{$f1};
          warn "$0: line $line: discarding $$slot ($n1 -> $n2)\n"
            if defined $$slot;

          $$slot = $f2;
        }
      }
    }
    else {
      @$names = @fields;
    }
  }
}

Не забудьте, чтобы модуль возвращал истинное значение в конце.

1;

Наконец, вывод!

# ert
# kkk
# lll
# xxj
ok 1 - type1_to_type2 defined
ok 2 - type1_to_type2(aax)
ok 3 - type1_to_type3 defined
ok 4 - type1_to_type3(asx)
ok 5 - type2_to_type3 defined
ok 6 - type2_to_type3(fff)
ok 7 - type3_to_type1 defined
ok 8 - type3_to_type1(lle)
ok 9 - type2_to_type1 defined
ok 10 - type2_to_type1(ert)
1..10

Answer 5

Если все строки глобально уникальны, тогда решение 'eugene' будет работать нормально.

Если строки не являются глобально уникальными, то, по крайней мере, они должны быть позиционно уникальными, чтобы ваш вопрос имел смысл (если, конечно, допустимы множественные ответы); то есть значения должны быть уникальными по столбцу.

Если это так, то вы можете использовать решение eugene, но добавить номер столбца к хеш-ключу, как показано ниже:

my %data = (
    aax1 => ["aax", "ert", "ddd"],
    ert2 => ["aax", "ert", "ddd"],
    ddd3 => ["aax", "ert", "ddd"],
    asx1 => ["asx", "eer", "kkk"],
    ...
);

sub get_value {
    my ($string, $from_type, $to_type) = @_;
    return $data{$string . $from_type }[ $to_type - 1 ];
}

print get_value("aax", 1, 2); # "ert"

Answer 6

Используйте один массив, содержащий:

(
  ['aax', 'ert', 'ddd'],
  ['asx', 'eer', 'kkk'],
  ...,
)

и массив из трех хеш-ссылок, первый хеш-адрес содержит:

{
  aax => $array[0],
  asx => $array[1],
  ...,
}

второй хеш-адрес, содержащий:

{
  ert => $array[0],
  eer => $array[1],
  ...,
}

и т. Д. (Все три хеша указывают на записи в одном и том же исходном массиве).Затем, чтобы найти значение «столбец три», соответствующее «столбцу 1 =« asx »», поиск просто $table[0]{asx}[2], который даст «kkk».