module VariableSelection contains ! ************************************************************************ ! ************************************************************************ subroutine chooseBranchingVariable(x, domain_, discrete_sets, variableType, & branchingVariableStrategy, index, options) use BranchAndBound_Options use Problems use Constants use Structures use Auxiliar implicit none ! SCALAR ARGUMENT integer, intent(out) :: index integer, intent(in) :: branchingVariableStrategy integer, intent(out) :: variableType ! ARRAY ARGUMENTS real(kind=8), intent(in) :: x(:) ! OTHER ARGUMENTS type(domain), intent(in) :: domain_ type(set), intent(in) :: discrete_sets(:) type(bb_options), intent(in) :: options select case(branchingVariableStrategy) case(LOWEST_INDEX_FIRST) call lowestIndexFirst(x, domain_, discrete_sets, variableType, index) return case(MOST_FRACTIONAL) call mostFractional(x, domain_, discrete_sets, variableType, index) return case(RANDOM_VARIABLE) call randomVariable(x, domain_, discrete_sets, variableType, index) return case(PSEUDO_COSTS) call pseudoCostsBased(x, domain_, discrete_sets, variableType, index, options) return case default ! Choose the lowest index first as the default strategy. call lowestIndexFirst(x, domain_, discrete_sets, variableType, index) return end select end subroutine chooseBranchingVariable ! ************************************************************************ ! ************************************************************************ real(kind=8) function score(x, index, branchingVariableStrategy, options) use BranchAndBound_Options use Constants use PseudoCosts implicit none ! SCALAR ARGUMENTS real(kind=8), intent(in) :: x integer, intent(in) :: index, branchingVariableStrategy ! OTHER ARGUMENTS type(bb_options), intent(in) :: options select case(branchingVariableStrategy) case(MOST_FRACTIONAL) score = min(abs(x - real(floor(x), kind=8)), & abs(x - real(ceiling(x), kind=8))) case(PSEUDO_COSTS) score = evaluatePseudoCost(index, x, options) case default score = 0.0d0 end select end function score ! ************************************************************************ ! ************************************************************************ subroutine lowestIndexFirst(x, domain_, discrete_sets, variableType, index) use Problems use Constants use Structures use Auxiliar implicit none ! Lowest-index first strategy. Select the variable that does ! not satisfy the integer constraints and which has the lowest ! index. ! SCALAR ARGUMENT integer, intent(out) :: index integer, intent(out) :: variableType ! ARRAY ARGUMENTS real(kind=8), intent(in) :: x(:) ! OTHER ARGUMENTS type(domain), intent(in) :: domain_ type(set), intent(in) :: discrete_sets(:) ! LOCAL SCALARS integer :: i, j, k logical :: satisfyConstraint do i = 1, size(domain_%type) index = domain_%indices(i) ! INTEGER variable. if(domain_%type(i) .eq. INTEGER) then if(.not. isInteger(x(index))) then variableType = INTEGER return end if ! BINARY variable. else if(domain_%type(i) .eq. BINARY) then if(.not. isBinary(x(index))) then variableType = BINARY return end if ! DISCRETE variable. else if(domain_%type(i) .eq. DISCRETE) then satisfyConstraint = .false. ! Finding the set of the current variable. do j = 1, size(discrete_sets) if(discrete_sets(j)%index .eq. index) then ! Verify if the value of the variable is equal to ! one in its set. do k = 1, size(discrete_sets(j)%elements) if(abs(x(index) - discrete_sets(j)%elements(k)) & .le. EPSILON_INT) then satisfyConstraint = .true. exit end if end do if(.not. satisfyConstraint) then variableType = DISCRETE return end if exit ! We found the set of variable x_index. Exit from ! this loop and proceed with the next variable. end if end do end if end do ! There is no variable to branch on. All of them satisfy the ! constraints. index = -1 return end subroutine lowestIndexFirst ! ************************************************************************ ! ************************************************************************ subroutine mostFractional(x, domain_, discrete_sets, variableType, index) use Problems use Constants use Structures use Auxiliar implicit none ! Most fractional integer variable strategy. Select the ! variable that has the most fractional value, that is, the one ! that maximizes the value ! ! min(| x_i - floor(x_i) |, | x_i - ceil(x_i) |). ! ! In other words, the most fractional integer variable is the one ! which is farthest from its nearest integer value. ! SCALAR ARGUMENT integer, intent(out) :: index integer, intent(out) :: variableType ! ARRAY ARGUMENTS real(kind=8), intent(in) :: x(:) ! OTHER ARGUMENTS type(domain), intent(in) :: domain_ type(set), intent(in) :: discrete_sets(:) ! LOCAL SCALARS integer :: i, j, k, indexMostFractional logical :: satisfyConstraint real(kind=8) :: fraction, greatestFraction, distance greatestFraction = 0.0d0 indexMostFractional = -1 do i = 1, size(domain_%type) index = domain_%indices(i) ! INTEGER variable. if(domain_%type(i) .eq. INTEGER) then if(.not. isInteger(x(index))) then fraction = min(abs(x(index) - real(floor(x(index)), kind=8)), & abs(x(index) - real(ceiling(x(index)), kind=8))) if(fraction .gt. greatestFraction) then indexMostFractional = index greatestFraction = fraction variableType = INTEGER end if end if ! BINARY variable. else if(domain_%type(i) .eq. BINARY) then if(.not. isBinary(x(index))) then fraction = min(abs(x(index) - real(floor(x(index)), kind=8)), & abs(x(index) - real(ceiling(x(index)), kind=8))) if(fraction .gt. greatestFraction) then indexMostFractional = index greatestFraction = fraction variableType = BINARY end if end if ! DISCRETE variable. else if(domain_%type(i) .eq. DISCRETE) then satisfyConstraint = .false. fraction = LARGEST_VALUE ! Finding the set of the current variable. do j = 1, size(discrete_sets) if(discrete_sets(j)%index .eq. index) then ! Verify if the value of the variable is equal to ! one in its set. do k = 1, size(discrete_sets(j)%elements) distance = abs(x(index) - discrete_sets(j)%elements(k)) if(distance .le. EPSILON_INT) then satisfyConstraint = .true. exit else if(fraction .gt. distance) then fraction = distance end if end do if(.not. satisfyConstraint) then if(fraction .gt. greatestFraction) then indexMostFractional = index greatestFraction = fraction variableType = DISCRETE end if end if exit ! We found the set of variable x_index. Exit from ! this loop and proceed with the next variable. end if end do end if end do index = indexMostFractional return end subroutine mostFractional ! ************************************************************************ ! ************************************************************************ subroutine randomVariable(x, domain_, discrete_sets, variableType, index) use Problems use Constants use Structures use Auxiliar use Random implicit none ! Select randomly the variable to branch on. ! SCALAR ARGUMENT integer, intent(out) :: index integer, intent(out) :: variableType ! ARRAY ARGUMENTS real(kind=8), intent(in) :: x(:) ! OTHER ARGUMENTS type(domain), intent(in) :: domain_ type(set), intent(in) :: discrete_sets(:) ! LOCAL SCALARS integer :: i, j, k, numFractionalVariables logical :: satisfyConstraint real(kind=8) :: distance, fraction real(kind=8), save :: seed = 7919.0d0 ! LOCAL ARRAYS integer :: variableIndex(size(x)), variableTypes(size(x)) numFractionalVariables = 0 do i = 1, size(domain_%type) index = domain_%indices(i) ! INTEGER variable. if(domain_%type(i) .eq. INTEGER) then if(.not. isInteger(x(index))) then numFractionalVariables = numFractionalVariables + 1 variableIndex(numFractionalVariables) = index variableTypes(numFractionalVariables) = INTEGER end if ! BINARY variable. else if(domain_%type(i) .eq. BINARY) then if(.not. isBinary(x(index))) then numFractionalVariables = numFractionalVariables + 1 variableIndex(numFractionalVariables) = index variableTypes(numFractionalVariables) = BINARY end if ! DISCRETE variable. else if(domain_%type(i) .eq. DISCRETE) then satisfyConstraint = .false. fraction = LARGEST_VALUE ! Finding the set of the current variable. do j = 1, size(discrete_sets) if(discrete_sets(j)%index .eq. index) then ! Verify if the value of the variable is equal to ! one in its set. do k = 1, size(discrete_sets(j)%elements) distance = abs(x(index) - discrete_sets(j)%elements(k)) if(distance .le. EPSILON_INT) then satisfyConstraint = .true. exit else if(fraction .gt. distance) then fraction = distance end if end do if(.not. satisfyConstraint) then numFractionalVariables = numFractionalVariables + 1 variableIndex(numFractionalVariables) = index variableTypes(numFractionalVariables) = DISCRETE end if exit ! We found the set of variable x_index. Exit from ! this loop and proceed with the next variable. end if end do end if end do if(numFractionalVariables .eq. 0) then ! There is no variable to branch on. All variables satisfy the ! integrality constraints. index = -1 return end if ! Select one variable among all fractional variables. i = floor (drand(seed) * real(numFractionalVariables,kind=8)) + 1 if(i .ge. 1 .and. i .le. numFractionalVariables) then index = variableIndex(i) variableType = variableTypes(i) else write(*,*) 'Error while selecting a random index for the branching variable.' index = variableIndex(1) variableType = variableTypes(1) end if end subroutine randomVariable ! ************************************************************************ ! ************************************************************************ subroutine pseudoCostsBased(x, domain_, discrete_sets, variableType, & index, options) use BranchAndBound_Options use Problems use Constants use Structures use PseudoCosts use Auxiliar implicit none ! SCALAR ARGUMENT integer, intent(out) :: index integer, intent(out) :: variableType ! ARRAY ARGUMENTS real(kind=8), intent(in) :: x(:) ! OTHER ARGUMENTS type(domain), intent(in) :: domain_ type(set), intent(in) :: discrete_sets(:) type(bb_options), intent(in) :: options ! LOCAL SCALARS integer :: i, j, k, indexBest logical :: satisfyConstraint real(kind=8) :: greatestPseudoCost, distance, pseudoCost greatestPseudoCost = - LARGEST_VALUE indexBest = -1 do i = 1, size(domain_%type) index = domain_%indices(i) ! INTEGER variable. if(domain_%type(i) .eq. INTEGER) then if(.not. isInteger(x(index))) then pseudoCost = evaluatePseudoCost(index,x(index),options) if(pseudoCost .gt. greatestPseudoCost) then indexBest = index greatestPseudoCost = pseudoCost variableType = INTEGER end if end if ! BINARY variable. else if(domain_%type(i) .eq. BINARY) then if(.not. isBinary(x(index))) then pseudoCost = evaluatePseudoCost(index,x(index),options) if(pseudoCost .gt. greatestPseudoCost) then indexBest = index greatestPseudoCost = pseudoCost variableType = BINARY end if end if ! DISCRETE variable. else if(domain_%type(i) .eq. DISCRETE) then satisfyConstraint = .false. pseudoCost = LARGEST_VALUE ! Finding the set of the current variable. do j = 1, size(discrete_sets) if(discrete_sets(j)%index .eq. index) then ! Verify if the value of the variable is equal to ! one in its set. do k = 1, size(discrete_sets(j)%elements) distance = abs(x(index) - discrete_sets(j)%elements(k)) if(distance .le. EPSILON_INT) then satisfyConstraint = .true. exit else if(pseudoCost .gt. distance) then pseudoCost = distance end if end do if(.not. satisfyConstraint) then if(pseudoCost .gt. greatestPseudoCost) then indexBest = index greatestPseudoCost = pseudoCost variableType = DISCRETE end if end if exit ! We found the set of variable x_index. Exit from ! this loop and proceed with the next variable. end if end do end if end do index = indexBest return end subroutine pseudoCostsBased ! ************************************************************************ ! ************************************************************************ end module VariableSelection