Как я могу реализовать алгоритм стабильного брака Гейла-Шепли в Perl?

Question

Постановка задачи:

У нас одинаковое количество мужчин и женщин. У каждого мужчины есть предпочтение по отношению к каждой женщине. Так же и женщина для каждого мужчины. У каждого из мужчин и женщин есть определенные интересы. На основе процентов, мы рассчитываем баллы предпочтений.

Итак, изначально у нас есть вход в файл с x столбцами. Первый столбец - это идентификатор человека (мужчина / женщина). Идентификаторы - это только цифры от 0 ... n. (Первая половина - мужчины, а вторая половина - женщины). Остальные x-1 столбцы будут иметь свои интересы. Это тоже целые числа.

Теперь, используя эту матрицу n by x-1, мы придумали матрицу n by n/2. В новой матрице в столбцах указаны все мужчины и женщины, а для противоположного пола - столбцы.

Мы должны отсортировать оценки в порядке убывания, а также нам нужно знать идентификатор лица, связанного с оценками после сортировки.

Итак, я хотел использовать хеш-таблицу.

Как только мы получим оценки, нам нужно составить пары, для которых нам нужно следовать некоторым правилам.

Моя проблема со второй матрицей n by n/2, которая должна дать информацию о том, какой мужчина / женщина имеет предпочтения относительно женщины / мужчины. Мне нужно, чтобы эти оценки были отсортированы так, чтобы я знал, кто является первой предпочтительной женщиной / мужчиной, вторым предпочтительным и так далее для мужчины / женщины.

Я надеюсь получить хорошие предложения по структурам данных, которые я использую. Я предпочитаю PHP или Perl.

Примечание:

Это не домашняя работа. Это немного модифицированная версия алгоритма стабильного брака. У меня есть рабочее решение. Я работаю только над оптимизацией моего кода.

Это очень похоже на проблему стабильного брака, но здесь нам нужно рассчитать баллы на основе интересов, которые они разделяют. Итак, я реализовал это так, как вы видите на вики-странице http://en.wikipedia.org/wiki/Stable_marriage_problem.

Моя проблема не решает проблему. Я решил и могу запустить. Я просто пытаюсь найти лучшее решение. Поэтому я прошу предложения о типе структуры данных для использования.

Концептуально я попытался использовать массив хэшей. где индекс массива дает идентификатор человека, а хэш в нем дает ids <=> scores в отсортированном виде. Я изначально начинаю с массива хэшей. Теперь я сортирую хэши по значениям, но я не могу сохранить отсортированные хэши обратно в массив. Так что просто сохранили ключи после сортировки и использовали их для получения значений из моих первоначальных несортированных хешей.

Можем ли мы сохранить хеши после сортировки? Можете ли вы предложить лучшую структуру?

Answer 1

Я думаю, что в следующем реализован алгоритм Гейла-Шепли , где порядок предпочтений каждого человека задается в виде массива баллов по отношению к представителям противоположного пола.

Кстати, я только что узнал, что Дэвид Гейл скончался (см. Его статью в Википедии - его будет не хватать).

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

Я не собираюсь пытаться решать конкретные проблемы вашей проблемы. В частности, вы не в полной мере реализовали идею вычисления результатов матчей на основе интересов, и попытка угадать обречена на провал.

#!/usr/bin/perl

use strict; use warnings;
use YAML;

my (%pref, %people, %proposed_by);

while ( my $line = <DATA> ) {
    my ($sex, $id, @pref) = split ' ', $line;
    last unless $sex and ($sex) =~ /^(m|w)\z/;
    $pref{$sex}{$id} = [ map 0 + $_, @pref ];
    $people{$sex}{$id} = undef;
}

while ( defined( my $man = bachelor($people{m}) ) ) {
    my @women = eligible_women($people{w}, $proposed_by{$man});
    next unless @women;

    my $woman = argmax($pref{m}{$man}, \@women);
    $proposed_by{$man}{$woman} = 1;

    if ( defined ( my $jilted = $people{w}{$woman}{m} ) ) {
        my $proposal_score =  $pref{w}{$woman}[$man];
        my $jilted_score = $pref{w}{$woman}[$jilted];
        next if $proposal_score < $jilted_score;
        $people{m}{$jilted}{w} = undef;
    }
    $people{m}{$man}{w} = $woman;
    $people{w}{$woman}{m} = $man;
}

print Dump \%people;

sub argmax {
    my ($pref, $candidates) = @_;
    my ($ret) = sort { $pref->[$b] <=> $pref->[$a] } @$candidates;
    return $ret;
}

sub bachelor {
    my ($men) = @_;
    my ($bachelor) = grep { not defined $men->{$_}{w} } keys %$men;
    return $bachelor;
}

sub eligible_women {
    my ($women, $proposed_to) = @_;
    return grep { not defined $proposed_to->{$_} } keys %$women;
}

__DATA__
m 0 10 20 30 40 50
m 1 50 30 40 20 10
m 2 30 40 50 10 20
m 3 10 10 10 10 10
m 4 50 40 30 20 10
w 0 50 40 30 20 10
w 1 40 30 20 10 50
w 2 30 20 10 50 40
w 3 20 10 50 40 30
w 4 10 50 40 30 20