Attachment 161373 Details for Bug 35826 – Bug 35826: optimize on transport cost when building holds queue

[patch] Bug 35826: optimize on transport cost when building holds queue

Bug-35826-optimize-on-transport-cost-when-building.patch (text/plain), 13.46 KB, created by Andreas Jonsson on 2024-01-24 23:45:29 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Andreas Jonsson

Created: 2024-01-24 23:45:29 UTC

Size: 13.46 KB

patch

obsolete

>From 24874c763548ef27a5a4bcd39428c6efb3750426 Mon Sep 17 00:00:00 2001
>From: Andreas Jonsson <andreas.jonsson@kreablo.se>
>Date: Sun, 21 Jan 2024 19:47:55 +0000
>Subject: [PATCH] Bug 35826: optimize on transport cost when building holds
> queue
>
>---
> C4/HoldsQueue.pm | 284 +++++++++++++++++++++++++++++++++++++++++------
> cpanfile         |   1 +
> 2 files changed, 252 insertions(+), 33 deletions(-)
>
>diff --git a/C4/HoldsQueue.pm b/C4/HoldsQueue.pm
>index 270bb7c15f..8b78bbf610 100644
>--- a/C4/HoldsQueue.pm
>+++ b/C4/HoldsQueue.pm
>@@ -28,10 +28,12 @@ use Koha::DateUtils qw( dt_from_string );
> use Koha::Hold::HoldsQueueItems;
> use Koha::Items;
> use Koha::Libraries;
>+use Koha::Logger;
> use Koha::Patrons;
> 
> use List::Util qw( shuffle );
> use List::MoreUtils qw( any );
>+use Algorithm::Munkres qw();
> 
> our (@ISA, @EXPORT_OK);
> BEGIN {
>@@ -393,6 +395,241 @@ sub _checkHoldPolicy {
> 
> }
> 
>+sub _allocateWithTransportCostMatrix {
>+    my (
>+        $hold_requests, $available_items, $branches_to_use, $libraries, $transport_cost_matrix, $allocated_items,
>+        $items_by_itemnumber
>+    ) = @_;
>+
>+    my @allocated;
>+
>+    my @remaining_items = grep { !exists $allocated_items->{ $_->{itemnumber} } && $_->{holdallowed} ne 'not_allowed'; }
>+        @$available_items;
>+
>+    my @requests  = grep { !defined $_->{itemnumber} } @$hold_requests;
>+    my @remaining = ();
>+
>+    my $num_agents = scalar(@remaining_items);
>+    my $num_tasks  = scalar(@requests);
>+
>+    return [] if $num_agents == 0 || $num_tasks == 0;
>+
>+    if ( $num_tasks > $num_agents ) {
>+        @remaining = @requests[ $num_agents - 1 .. $num_tasks - 1 ];
>+        @requests  = @requests[ 0 .. $num_agents - 1 ];
>+        $num_tasks = $num_agents;
>+    }
>+
>+    my @m = map { [ (undef) x $num_tasks ] } ( 1 .. $num_agents );
>+
>+    my $inf = -1;    # Initially represent infinity with a negative value.
>+    my $max = 0;
>+
>+    # If some candidate holds requests cannot be filled and there are
>+    # hold requests remaining, we will try again a limited number of
>+    # times.
>+    #
>+    # The limit is chosen arbitrarily and only servers to keep the
>+    # asymptotic worst case to O(num_tasksÂ³).
>+    my $RETRIES = 8;
>+    my $retries = $RETRIES;
>+    my $r       = 0;
>+
>+RETRY:
>+    while (1) {
>+
>+        return [] if $num_agents == 0 || $num_tasks == 0;
>+
>+        if ( $num_tasks < $num_agents && @remaining ) {
>+            # On retry, move tasks from @remaining to @requests up to
>+            # the number of agents.
>+            my $nr = scalar(@remaining);
>+            my $na = $num_agents - $num_tasks;
>+            my $nm = $nr < $na ? $nr : $na;
>+            push @requests, ( splice @remaining, 0, $nm );
>+            $num_tasks += $nm;
>+        }
>+
>+        my @candidate_tasks  = ( (0) x $num_tasks );
>+        my @candidate_agents = ( (0) x $num_agents );
>+        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
>+            for ( my $j = $r ; $j < $num_tasks ; $j++ ) {
>+                my $item    = $remaining_items[$i];
>+                my $request = $requests[$j];
>+
>+                my $pickup_branch = $request->{branchcode} || $request->{borrowerbranch};
>+                my $srcbranch     = $item->{holdingbranch};
>+
>+                my $cost;
>+
>+                $cost = $inf unless _checkHoldPolicy( $item, $request );
>+                $cost = $inf
>+                    unless $items_by_itemnumber->{ $item->{itemnumber} }->{_object}
>+                    ->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
>+
>+                # If hold itemtype is set, item's itemtype must match
>+                $cost = $inf unless ( !$request->{itemtype}
>+                    || $item->{itype} eq $request->{itemtype} );
>+
>+                # If hold item_group is set, item's item_group must match
>+                $cost = $inf
>+                    unless (
>+                    !$request->{item_group_id}
>+                    || (   $item->{_object}->item_group
>+                        && $item->{_object}->item_group->id eq $request->{item_group_id} )
>+                    );
>+
>+                if ( !defined $cost ) {
>+                    my $cell = $transport_cost_matrix->{$pickup_branch}{$srcbranch};
>+
>+                    if ( !defined $cell && $pickup_branch eq $srcbranch ) {
>+                        $cost = 0;
>+                    } elsif ( !defined $cell || $cell->{disable_transfer} ) {
>+                        $cost = $inf;
>+                    } else {
>+                        $cost = $cell->{cost};
>+                    }
>+                }
>+
>+                $m[$i][$j] = $cost;
>+
>+                if ( $cost != $inf ) {
>+                    # There is at least one possible item in row $i and column $j
>+                    $candidate_tasks[$j]  = 1;
>+                    $candidate_agents[$i] = 1;
>+                }
>+
>+                if ( $cost > $max ) {
>+                    $max = $cost;
>+                }
>+            }
>+        }
>+
>+        # Remove any item which have no finite transport cost with respect to any of the hold requests.
>+        for ( my $i = 0, my $i0 = 0 ; $i < $num_agents ; $i++ ) {
>+            if ( !$candidate_agents[$i] ) {
>+                splice @m,               $i - $i0, 1;
>+                splice @remaining_items, $i - $i0, 1;
>+                $i0++;
>+            }
>+        }
>+        $num_agents = scalar(@remaining_items);
>+
>+        # Remove any hold request for which there is no finite transport cost item available.
>+        my $removed_something = 0;
>+        for ( my $j = 0, my $j0 = 0 ; $j < $num_tasks ; $j++ ) {
>+            if ( !$candidate_tasks[$j] ) {
>+                for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
>+                    splice @{ $m[$i] }, $j - $j0, 1;
>+                }
>+                splice @requests, $j - $j0, 1;
>+                $j0++;
>+                $removed_something = 1;
>+            }
>+        }
>+        $num_tasks = scalar(@requests);
>+
>+        if ( $num_agents > $num_tasks && @remaining ) {
>+            $r = $num_tasks - 1;
>+            next RETRY;
>+        }
>+
>+        if ( $num_tasks > $num_agents ) {
>+            return [] if $num_agents == 0;
>+            unshift @remaining, ( splice @requests, $num_agents );
>+            $num_tasks = $num_agents;
>+        }
>+
>+        return [] if $num_agents == 0 || $num_tasks == 0;
>+
>+        # Substitute infinity with a cost that is higher than the total of
>+        # any possible assignment.  This ensures that any possible
>+        # assignment will be selected before any assignment of infinite
>+        # cost.  Infinite cost assignments can be be filtered out at the
>+        # end.
>+        $inf = $max * $num_tasks + 1;
>+
>+        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
>+            for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
>+                if ( $m[$i][$j] < 0 ) {
>+                    # Bias towards not allocating items to holds closer to
>+                    # the end of the queue in the queue if not all holds
>+                    # can be filled by representing infinity with
>+                    # different values.
>+                    $m[$i][$j] = $inf + ( $num_tasks - $j );
>+                }
>+            }
>+        }
>+
>+        my $res = [ (undef) x $num_agents ];
>+
>+        Algorithm::Munkres::assign( \@m, $res );
>+
>+        my @unallocated = ();
>+        @allocated = ();
>+        for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
>+            my $j = $res->[$i];
>+            if ( !defined $j || $j >= $num_tasks ) {
>+                # If the algorithm zero-pads the matrix
>+                # (Algorithm::Munkres version 0.08) holds may be
>+                # allocated to nonexisting items ($j >= 0).  We just ignore these.
>+                next;
>+            }
>+            if ( $m[$i][$j] > $max ) {
>+                # No finite cost item was assigned to this hold.
>+                push @unallocated, $j;
>+            } else {
>+                my $request = $requests[$j];
>+                my $item    = $remaining_items[$i];
>+                push @allocated, [
>+                    $item->{itemnumber},
>+                    {
>+                        borrowernumber => $request->{borrowernumber},
>+                        biblionumber   => $request->{biblionumber},
>+                        holdingbranch  => $item->{holdingbranch},
>+                        pickup_branch  => $request->{branchcode}
>+                            || $request->{borrowerbranch},
>+                        reserve_id   => $request->{reserve_id},
>+                        item_level   => $request->{item_level_hold},
>+                        reservedate  => $request->{reservedate},
>+                        reservenotes => $request->{reservenotes},
>+                    }
>+                ];
>+            }
>+        }
>+
>+        if ( $retries-- > 0 && @unallocated && @remaining ) {
>+            # Remove the transport cost of unfilled holds and compact the matrix.
>+            # Also remove the hold request from the array.
>+            my @rs = ();
>+            for ( my $i = 0 ; $i < $num_agents ; $i++ ) {
>+                my $u = 0;
>+                for ( my $j = 0 ; $j < $num_tasks ; $j++ ) {
>+                    if ( $u < scalar(@unallocated) && $unallocated[$u] == $j ) {
>+                        $u++;
>+                    } elsif ( $u > 0 ) {
>+                        $m[$i][ $j - $u ] = $m[$i][$j];
>+                        push @rs, $requests[$j];
>+                    }
>+                }
>+            }
>+            @requests  = @rs;
>+            $num_tasks = scalar(@requests);
>+
>+            $r = $num_tasks - 1;
>+        } else {
>+            if ( $retries == 0 && @unallocated && @remaining ) {
>+                Koha::Logger->get->warn(
>+                    "There are available items that have not been allocated and remaining holds, but we abort trying to fill these after $RETRIES retries."
>+                );
>+            }
>+            last RETRY;
>+        }
>+    }
>+
>+    return \@allocated;
>+}
>+
> =head2 MapItemsToHoldRequests
> 
>   MapItemsToHoldRequests($hold_requests, $available_items, $branches, $transport_cost_matrix)
>@@ -530,6 +767,18 @@ sub MapItemsToHoldRequests {
>         }
>     }
> 
>+    if ( defined $transport_cost_matrix ) {
>+        my $allocations = _allocateWithTransportCostMatrix(
>+            $hold_requests,         $available_items,  $branches_to_use, $libraries,
>+            $transport_cost_matrix, \%allocated_items, \%items_by_itemnumber
>+        );
>+        for my $allocation (@$allocations) {
>+            $item_map{ $allocation->[0] } = $allocation->[1];
>+            $num_items_remaining--;
>+        }
>+        return \%item_map;
>+    }
>+
>     # group available items by branch
>     my %items_by_branch = ();
>     foreach my $item (@$available_items) {
>@@ -540,6 +789,8 @@ sub MapItemsToHoldRequests {
>     }
>     return \%item_map unless keys %items_by_branch;
> 
>+    my $priority_branch = C4::Context->preference('HoldsQueuePrioritizeBranch') // 'homebranch';
>+
>     # now handle the title-level requests
>     $num_items_remaining = scalar(@$available_items) - scalar(keys %allocated_items);
>     my $pull_branches;
>@@ -553,7 +804,6 @@ sub MapItemsToHoldRequests {
>         my ($itemnumber, $holdingbranch);
> 
>         my $holding_branch_items = $items_by_branch{$pickup_branch};
>-        my $priority_branch = C4::Context->preference('HoldsQueuePrioritizeBranch') // 'homebranch';
>         if ( $holding_branch_items ) {
>             foreach my $item (@$holding_branch_items) {
>                 next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
>@@ -573,38 +823,6 @@ sub MapItemsToHoldRequests {
>             }
>             $holdingbranch = $pickup_branch;
>         }
>-        if (!defined $itemnumber && defined $transport_cost_matrix) {
>-            $pull_branches = [keys %items_by_branch];
>-            $holdingbranch = least_cost_branch( $pickup_branch, $pull_branches, $transport_cost_matrix );
>-            if ( $holdingbranch ) {
>-
>-                my $holding_branch_items = $items_by_branch{$holdingbranch};
>-                foreach my $item (@$holding_branch_items) {
>-                    next if $request->{borrowerbranch} ne $item->{$priority_branch};
>-                    next unless $items_by_itemnumber{ $item->{itemnumber} }->{_object}->can_be_transferred( { to => $libraries->{ $request->{branchcode} } } );
>-
>-                    # Don't fill item level holds that contravene the hold pickup policy at this time
>-                    next unless _checkHoldPolicy($item, $request);
>-
>-                    # If hold itemtype is set, item's itemtype must match
>-                    next unless ( !$request->{itemtype}
>-                        || $item->{itype} eq $request->{itemtype} );
>-
>-                    # If hold item_group is set, item's item_group must match
>-                    next unless (
>-                        !$request->{item_group_id}
>-                        || (   $item->{_object}->item_group
>-                            && $item->{_object}->item_group->id eq $request->{item_group_id} )
>-                    );
>-
>-                    $itemnumber = $item->{itemnumber};
>-                    last;
>-                }
>-            }
>-            else {
>-                next;
>-            }
>-        }
> 
>         unless ($itemnumber) {
>             # not found yet, fall back to basics
>diff --git a/cpanfile b/cpanfile
>index de457b91e8..9bf55bd7e9 100644
>--- a/cpanfile
>+++ b/cpanfile
>@@ -1,4 +1,5 @@
> requires 'Algorithm::CheckDigits', '0.5';
>+requires 'Algorithm::Munkres', '0.08';
> requires 'Array::Utils', '0.5';
> requires 'Auth::GoogleAuth', '1.02';
> requires 'Authen::CAS::Client', '0.05';
>-- 
>2.39.2

Actions: View | Diff | Splinter Review

Attachments on bug 35826: 161373 | 161956 | 163017 | 163018 | 163107 | 163641 | 163642 | 163643 | 163644 | 163645 | 164501 | 164502 | 164503 | 164504 | 164505 | 164964 | 164965 | 164966 | 164967 | 164968