Algorithm-Bertsekas
view release on metacpan or search on metacpan
1. Some changes and improvements.
Version 0.60 (Algorithm::Bertsekas-0.60 Released on 13th Abr 2018)
1. Substantial improvements.
2. Lock or unlock the old list after reviewing the quality of the list objects.
3. Delete objects of little benefit from the old list.
4. In the complementary subset (new list), search only one object,
if ( $epsilon_scaling >= 7 ).
Version 0.50 (Algorithm::Bertsekas-0.50 Released on 11th Abr 2018)
1. The @objects_with_greater_benefits list are updated dynamically by
$objects_desired_by_this{$person} by considering the current price
(or current value) of objects.
2. For each person, the Current Value $current_value{$object} of the
most desired objects contained in the @objects_with_greater_benefits
list tends to converge to a specific value.
Version 0.46 (Algorithm::Bertsekas-0.46 Released on 06th Abr 2018)
1. Little changes and improvements.
Version 0.45 (Algorithm::Bertsekas-0.45 Released on 05th Abr 2018)
1. Little changes and improvements.
Version 0.40 (Algorithm::Bertsekas-0.40 Released on 03th Abr 2018)
1. The @objects_with_greater_benefits are updated dynamically by
$objects_desired_by_this{$person} considering the price update of objects.
Version 0.35 (Algorithm::Bertsekas-0.31 Released on 25th Mar 2018)
1. Calculate $bid02ForPersonI to try to predict the values of the next round.
2. Bug fixes.
Version 0.31 (Algorithm::Bertsekas-0.31 Released on 25th Mar 2018)
1. Added $ThdOptValForPersonI and $FthOptValForPersonI.
2. Updated README.
Version 0.30 (Algorithm::Bertsekas-0.30 Released on 21th Mar 2018)
1. Improvements with the use of @objects_with_greater_benefits
working sets that are updated dynamically by %most_wanted_object hash.
Version 0.25 (Algorithm::Bertsekas-0.25 Released on 03th Mar 2018)
1. Little changes and improvements.
Version 0.23 (Algorithm::Bertsekas-0.23 Released on 27th Feb 2018)
1. Added the 'delete_multiple_columns' subroutine.
2. Some improvements.
Version 0.21 (Algorithm::Bertsekas-0.21 Released on 22th Feb 2018)
1. Modified the 'auction' subroutine.
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
my ( $Opt01ObjForPersonI, $Opt02ObjForPersonI, $Opt03ObjForPersonI );
my ( $Opt01ValForPersonI, $Opt02ValForPersonI, $Opt03ValForPersonI ) = ( -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value) );
my ( $Opt01ObjForPersonI_new_list, $Opt02ObjForPersonI_new_list, $Opt03ObjForPersonI_new_list );
my ( $Opt01ValForPersonI_new_list, $Opt02ValForPersonI_new_list, $Opt03ValForPersonI_new_list ) = ( -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value), -10 * exp ($max_matrix_value) );
my $Opt01ValForPersonI_old_list;
my $bidForPersonI;
my %current_value;
my @updated_price;
$seen_ghost++ if ( not defined $matrix[$person] and $min_size < $max_size );
# The @objects_with_greater_benefits list are updated dynamically by $objects_desired_by_this{$person} by considering the current price (or current value) of objects.
# For each person, the Current Value $current_value{$object} of the most desired objects contained in the @objects_with_greater_benefits list tends to converge to a specific value.
my @objects_with_greater_benefits = keys %{$objects_desired_by_this{$person}}; # sort { $a <=> $b }
# There is at least one object in the @objects_with_greater_benefits list whose price is updated ? use old list : generate new list;
for my $object ( @objects_with_greater_benefits ) # use old list
{
my $matrix_value = $seen_ghost ? 0 : $matrix[$person]->[$object];
$current_value{$object} = $matrix_value - $price_object{$object};
push @updated_price, $object if ( $objects_desired_by_this{$person}{$object} == $current_value{$object} );
if ( $current_value{$object} > $Opt01ValForPersonI ) # search for the best 3 objects
{
$Opt03ValForPersonI = $Opt02ValForPersonI;
$Opt03ObjForPersonI = $Opt02ObjForPersonI;
$Opt02ValForPersonI = $Opt01ValForPersonI;
$Opt02ObjForPersonI = $Opt01ObjForPersonI;
$Opt01ValForPersonI = $current_value{$object};
$Opt01ObjForPersonI = $object;
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
if ( $verbose >= 8 ){
printf $output " personI = %3s ; objectJ = %3s ; Current Value %20.5f = \$matrix[%3s][%3s] %12.0f - \$price_object{%3s} %20.5f <old list> Max01_CurVal = %12.5f (%3s), Max02_CurVal = %12.5f (%3s), Max03_CurVal = %12.5f (%3s)\n",
$person, $object, $current_value{$object}, $person, $object, $matrix_value, $object, $price_object{$object},
$Opt01ValForPersonI, defined $Opt01ObjForPersonI ? $Opt01ObjForPersonI : '',
$Opt02ValForPersonI, defined $Opt02ObjForPersonI ? $Opt02ObjForPersonI : '',
$Opt03ValForPersonI, defined $Opt03ObjForPersonI ? $Opt03ObjForPersonI : '';
}
}
if ( not @updated_price and not $locked_list{$person} ) # if all prices are outdated
{
for my $object ( 0 .. $max_size - 1 ) # generate new list
{
next if ( defined $current_value{$object} );
my $matrix_value = $seen_ghost ? 0 : $matrix[$person]->[$object];
$current_value{$object} = $matrix_value - $price_object{$object};
if ( $current_value{$object} > $Opt01ValForPersonI_new_list ) # to find the best 3 objects in the complementary subset <new list>
{
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
$bidForPersonI = $Opt01ValForPersonI - $Opt02ValForPersonI + $epsilon;
my @objects_with_same_values;
if ( $Opt01ValForPersonI == $Opt02ValForPersonI ) # this person can choose different objects that have the same values = $Opt01ValForPersonI
{
@objects_with_same_values = grep { $current_value{$_} == $Opt01ValForPersonI } keys %current_value;
$objects_with_the_same_values{$_}{$person} = $Opt01ValForPersonI for (@objects_with_same_values);
$count_object{$_}++ for (@objects_with_same_values);
if ( not @updated_price and defined $Opt01ValForPersonI_old_list ){
for my $object ( @objects_with_same_values ){
next unless ( $current_value{$object} > $Opt01ValForPersonI_old_list ); # objects in the new list that have values greater than the objects in the old list
$objects_desired_by_this{$person}{$object} = $current_value{$object}; # add information about the most desired objects
}
}
} else
{
$choose_object{$Opt01ObjForPersonI}++;
lib/Algorithm/Bertsekas.pm view on Meta::CPAN
if ( $epsilon_scaling >= 6 and $epsilon_scaling % 2 == 0 and not $seen_person{$person}++ ) # filter the old list
{
for my $object ( @objects_with_greater_benefits ){ # frequently check the quality of objects in the old list
next if ( $current_value{$object} >= $Opt03ValForPersonI );
next unless ( ($Opt03ValForPersonI - $current_value{$object}) > $min_size * $epsilon ); # critical value ($min_size * $epsilon)
delete $objects_desired_by_this{$person}{$object}; # delete objects of little benefit from the old list
printf $output "<> PersonI = %3s ; *** delete the object %3s from the old list *** \n", $person, $object if ( $verbose >= 8 );
}
}
if ( not @updated_price ) # if all prices are outdated
{
for my $object ( @objects_with_greater_benefits ){
next unless ( defined $objects_desired_by_this{$person}{$object} );
$objects_desired_by_this{$person}{$object} = $current_value{$object}; # update current values for all objects in the old list
}
$objects_desired_by_this{$person}{$Opt01ObjForPersonI} = $current_value{$Opt01ObjForPersonI}; # add information about the most desired objects
$objects_desired_by_this{$person}{$Opt02ObjForPersonI} = $current_value{$Opt02ObjForPersonI} if (defined $Opt02ObjForPersonI);
$objects_desired_by_this{$person}{$Opt03ObjForPersonI} = $current_value{$Opt03ObjForPersonI} if (defined $Opt03ObjForPersonI);
$locked_list{$person} = 1 if ( $epsilon_scaling > (1/10) * $max_epsilon_scaling and ($Opt03ValForPersonI - $Opt01ValForPersonI_new_list) > $min_size * $epsilon );
$locked_list{$person} = 1 if ( $epsilon_scaling > (3/10) * $max_epsilon_scaling ); # Lock the old list. Is this the minimum value to find a possible solution?
delete $locked_list{$person} if ( $epsilon == 1/(1+$min_size) ); # Otherwise unlock the person's old list in the last $epsilon_scaling round.
}
if ( $verbose >= 8 ){
my @old_list = sort { $a <=> $b } @objects_with_greater_benefits;
my @new_list = sort { $a <=> $b } keys %{$objects_desired_by_this{$person}};
@updated_price = sort { $a <=> $b } @updated_price;
my @best_3_objects = ( $Opt01ObjForPersonI, $Opt02ObjForPersonI, $Opt03ObjForPersonI );
my $msg = $locked_list{$person} ? '[locked list] ' : '';
@objects_with_same_values = sort { $a <=> $b } @objects_with_same_values;
$this_person_can_choose_n_different_objects{$person}{'objects'} = \@objects_with_same_values; #reference to an array
printf $output "<> PersonI = %3s ; %3s objects desired by this person (old list) = (@old_list) ; objects whose current values are still updated = (@updated_price) : %2s >= 1 ? \n", $person, scalar @old_list, scalar @updated_price;
printf $output "<> PersonI = %3s ; %3s objects desired by this person (new list) = (@new_list) $msg; \@best_3_objects = (@best_3_objects) \n", $person, scalar @new_list if ( defined $Opt03ObjForPersonI );
printf $output "<> PersonI = %3s chose ObjectJ = %3s ; \$bidForPersonI %10.5f = \$Opt01ValForPersonI %.5f - \$Opt02ValForPersonI %.5f + \$epsilon %.5f \n", $person, $Opt01ObjForPersonI, $bidForPersonI, $Opt01ValForPersonI, $Opt02ValForPersonI, $e...
printf $output "<> PersonI = %3s ; these objects (@objects_with_same_values) have the same values \$Opt01ValForPersonI = %10.5f ; \$Opt01ObjForPersonI = $Opt01ObjForPersonI ; *** equal values *** \n", $person, $Opt01ValForPersonI if (@objects_wit...
}
}
}
# first, choose objects that appear a few times
foreach my $object ( sort { $count_object{$a} <=> $count_object{$b} || $seen_assignned_objects{$a} <=> $seen_assignned_objects{$b} } keys %objects_with_the_same_values ){ # sort { $price_object{$b} <=> $price_object{$a} }
foreach my $person ( keys %{$objects_with_the_same_values{$object}} ){ # sort { $objects_with_the_same_values{$object}{$a} <=> $objects_with_the_same_values{$object}{$b} }
( run in 0.297 second using v1.01-cache-2.11-cpan-05444aca049 )