game24_module Module Reference

Functions/Subroutines
subroutine	convert_to_number (input_str, number, ios)
	Converts user input (cards or numbers) into numeric values.
subroutine	remove_decimal_zeros (str, result)
	Removes trailing zeros after the decimal point in a string.
subroutine	create_new_arrays (nums, exprs, idx1, idx2, result, new_expr, new_nums, new_exprs)
	Creates new arrays after performing an operation.
subroutine	update_progress_bar ()
	Updates and displays the horizontal percentage-based progress bar.
recursive subroutine	solve_24 (nums, exprs, found)
	Recursively solves the 24 game by trying all possible operations.

Variables
integer, parameter	max_limit = 8
integer, parameter	expr_len = 200
integer(int64), parameter	total_calls_n6 = 20000000_int64
integer(int64), parameter	total_calls_n7 = 2648275200_int64
integer(int64), parameter	total_calls_n8 = 444557593600_int64
integer(int64)	total_calls = 0
integer(int64)	completed_calls = 0
integer	last_percentage = -1
integer, parameter	progress_bar_width = 50
character(len=1)	carriage_return = char(13)
logical	show_progress = .false.

Function/Subroutine Documentation

convert_to_number()

subroutine game24_module::convert_to_number	(	character(len=*), intent(in)	input_str,
		real, intent(out)	number,
		integer, intent(out)	ios )

Converts user input (cards or numbers) into numeric values.

Handles card values such as 'A', 'J', 'Q', 'K'.

Parameters

input_str	String representing the number or card value
number	The corresponding numeric value after conversion
ios	I/O status indicator (0 for success)

        implicit none
        character(len=*), intent(in) :: input_str
        real, intent(out)            :: number
        integer, intent(out)         :: ios
        character(len=1)             :: first_char
        real                         :: temp_number
 
        ios = 0  ! Reset the I/O status to 0 (valid input by default)
        first_char = input_str(1:1)
 
        select case (first_char)
        case ('A', 'a')
            number = 1.0
        case ('J', 'j')
            number = 11.0
        case ('Q', 'q')
            number = 12.0
        case ('K', 'k')
            number = 13.0
        case default
            read (input_str, *, iostat=ios) temp_number  ! Attempt to read a real number
 
            ! If input is not a valid real number or is not an integer, set ios to 1
            if (ios /= 0 .or. mod(temp_number, 1.0) /= 0.0) then
                ios = 1  ! Invalid input
            else
                number = temp_number  ! Valid integer input
            end if
        end select

create_new_arrays()

subroutine game24_module::create_new_arrays	(	real, dimension(:), intent(in)	nums,
		character(len=expr_len), dimension(:), intent(in)	exprs,
		integer, intent(in)	idx1,
		integer, intent(in)	idx2,
		real, intent(in)	result,
		character(len=expr_len), intent(in)	new_expr,
		real, dimension(:), intent(out), allocatable	new_nums,
		character(len=expr_len), dimension(:), intent(out), allocatable	new_exprs )

Creates new arrays after performing an operation.

Parameters

nums	Input array of numbers
exprs	Input array of expressions
idx1	Index of the first element to remove
idx2	Index of the second element to remove
result	Result of the operation
new_expr	New expression string
new_nums	Output array of numbers with elements removed and result added
new_exprs	Output array of expressions with elements removed and new_expr added

        implicit none
        real, intent(in)                        :: nums(:)       ! Input: Array of numbers
        character(len=expr_len), intent(in)     :: exprs(:)      ! Input: Array of expressions
        integer, intent(in)                     :: idx1, idx2    ! Input: Indices of elements to remove
        real, intent(in)                        :: result        ! Input: Result of the operation
        character(len=expr_len), intent(in)     :: new_expr      ! Input: New expression
        real, allocatable, intent(out)          :: new_nums(:)   ! Output: New array of numbers
        character(len=expr_len), allocatable, intent(out) :: new_exprs(:) ! Output: New array of expressions
        integer                                 :: i, j, n       ! Loop counters and size of input arrays
 
        n = size(nums)
        allocate (new_nums(n - 1))
        allocate (new_exprs(n - 1))
 
        j = 0
        do i = 1, n
            if (i /= idx1 .and. i /= idx2) then
                j = j + 1
                new_nums(j) = nums(i)
                new_exprs(j) = exprs(i)
            end if
        end do
 
        ! Add the result of the operation to the new arrays
        new_nums(n - 1) = result
        new_exprs(n - 1) = new_expr

remove_decimal_zeros()

subroutine game24_module::remove_decimal_zeros	(	character(len=*), intent(in)	str,
		character(len=*), intent(out)	result )

Removes trailing zeros after the decimal point in a string.

Parameters

str	Input string that may contain trailing zeros
result	Output string with trailing zeros removed

        implicit none
        character(len=*), intent(in)  :: str       ! Input: String to remove zeros from
        character(len=*), intent(out) :: result    ! Output: String without trailing zeros
        integer                        :: i, len_str  ! Loop counter and string length
 
        len_str = len_trim(str)
        result = adjustl(str(1:len_str))
 
        ! Find the position of the decimal point
        i = index(result, '.')
 
        ! If there's a decimal point, remove trailing zeros
        if (i > 0) then
            do while (len_str > i .and. result(len_str:len_str) == '0')
                len_str = len_str - 1
            end do
            if (result(len_str:len_str) == '.') len_str = len_str - 1
            result = result(1:len_str)
        end if

solve_24()

recursive subroutine game24_module::solve_24	(	real, dimension(:), intent(in)	nums,
		character(len=expr_len), dimension(:), intent(in)	exprs,
		logical, intent(inout)	found )

Recursively solves the 24 game by trying all possible operations.

Utilizes OpenMP tasks for parallelization.

Parameters

nums	Array of numbers to use in the game
exprs	Array of string expressions representing the numbers
found	Logical flag indicating if a solution has been found

        use omp_lib
        implicit none
        real, intent(in)                         :: nums(:)       ! Input: Array of numbers
        character(len=expr_len), intent(in)      :: exprs(:)      ! Input: Array of expressions
        logical, intent(inout)                   :: found         ! Input/Output: Flag indicating if a solution is found
        integer                                  :: n             ! Size of the input arrays
        integer                                  :: i, j, op      ! Loop counters
        real                                     :: a, b, result  ! Temporary variables for calculations
        real, allocatable                        :: new_nums(:)   ! Temp array to store numbers after an operation
        character(len=expr_len), allocatable     :: new_exprs(:)  ! Temp array to store expressions after an operation
        character(len=expr_len)                  :: expr_a, expr_b, new_expr ! Temp variables for expressions
 
        n = size(nums)
 
        ! Increment the completed_calls counter and update progress bar
        if (show_progress) then
            !$omp atomic
            completed_calls = completed_calls + 1
            call update_progress_bar()
        end if
 
        ! If a solution is found, return
        if (found) return
 
        ! Base case: If only one number is left, check if it is 24
        if (n == 1) then
            if (abs(nums(1) - 24.0) < 1e-4) then
                if (show_progress) then
                    write (*, '(A, F5.1, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] ', 100.0, '%'
                    write (*, '(A)') ''  ! Insert a blank line
                end if
                !$omp critical
                write (*, '(A, A, A, F10.7, A)') 'Solution found:', trim(exprs(1)), '= 24 (', nums(1), ')'
                found = .true.
                !$omp end critical
            end if
            return
        end if
 
        ! Iterate over all pairs of numbers
        do i = 1, n - 1
            do j = i + 1, n
                a = nums(i)
                b = nums(j)
                expr_a = exprs(i)
                expr_b = exprs(j)
 
                ! Iterate over all operators
                do op = 1, 4
                    ! Avoid division by zero
                    if ((op == 4 .and. abs(b) < 1e-6)) cycle
 
                    ! Perform the operation and create the new expression
                    select case (op)
                    case (1)
                        result = a + b
                        new_expr = '('//trim(expr_a)//'+'//trim(expr_b)//')'
                    case (2)
                        result = a - b
                        new_expr = '('//trim(expr_a)//'-'//trim(expr_b)//')'
                    case (3)
                        result = a * b
                        new_expr = '('//trim(expr_a)//'*'//trim(expr_b)//')'
                    case (4)
                        result = a / b
                        new_expr = '('//trim(expr_a)//'/'//trim(expr_b)//')'
                    end select
 
                    ! Create new arrays with the selected numbers removed
                    call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)
 
                    ! For the first few recursion levels, create parallel tasks
                    if (n >= 6 .and. omp_get_level() < 2) then
                        !$omp task shared(found) firstprivate(new_nums, new_exprs)
                        call solve_24(new_nums, new_exprs, found)
                        !$omp end task
                    else
                        call solve_24(new_nums, new_exprs, found)
                    end if
 
                    ! If a solution is found, deallocate memory and return
                    if (found) then
                        deallocate (new_nums)
                        deallocate (new_exprs)
                        return
                    end if
 
                    ! Handle commutative operations only once
                    if (op == 1 .or. op == 3) cycle
 
                    ! Swap operands for subtraction and division
                    if (op == 2 .or. op == 4) then
                        if (op == 4 .and. abs(a) < 1e-6) cycle  ! Avoid division by zero
 
                        select case (op)
                        case (2)
                            result = b - a
                            new_expr = '('//trim(expr_b)//'-'//trim(expr_a)//')'
                        case (4)
                            result = b / a
                            new_expr = '('//trim(expr_b)//'/'//trim(expr_a)//')'
                        end select
 
                        ! Create new arrays with the selected numbers removed
                        call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)
 
                        ! For the first few recursion levels, create parallel tasks
                        if (n >= 6 .and. omp_get_level() < 2) then
                            !$omp task shared(found) firstprivate(new_nums, new_exprs)
                            call solve_24(new_nums, new_exprs, found)
                            !$omp end task
                        else
                            ! Recursively call the solve_24 function with the new arrays
                            call solve_24(new_nums, new_exprs, found)
                        end if
 
                        ! If a solution is found, deallocate memory and return
                        if (found) then
                            deallocate (new_nums)
                            deallocate (new_exprs)
                            return
                        end if
                    end if
 
                end do  ! End of operator loop
            end do  ! End of j loop
        end do  ! End of i loop

update_progress_bar()

subroutine game24_module::update_progress_bar

Updates and displays the horizontal percentage-based progress bar.

        implicit none
        real :: percentage
        integer :: filled_length
        character(len=progress_bar_width) :: bar
        integer :: int_percentage
 
        if (total_calls == 0 .or. .not. show_progress) return  ! Avoid division by zero and check the flag
 
        percentage = real(completed_calls) / real(total_calls) * 100.0
 
        ! Ensure percentage does not exceed 100%
        if (percentage > 100.0) percentage = 100.0
 
        ! Calculate integer percentage
        int_percentage = int(percentage)
 
        ! Update progress bar only when percentage increases by at least 1%
        if (int_percentage > last_percentage) then
            last_percentage = int_percentage
 
            ! Calculate the filled length of the progress bar
            filled_length = min(int(percentage / 100.0 * progress_bar_width), progress_bar_width)
 
            ! Construct the progress bar string
            bar = repeat('=', filled_length)
            if (filled_length < progress_bar_width) then
                bar = bar//'>'//repeat(' ', progress_bar_width - filled_length - 1)
            end if
 
            ! Print the progress bar and integer percentage
            write (*, '(A, F4.1, A)', advance='no') carriage_return//'['//bar//'] ', percentage, '%'
            call flush (0)  ! Ensure output is displayed immediately
        end if

Variable Documentation

carriage_return

character(len=1) game24_module::carriage_return = char(13)

    character(len=1) :: carriage_return = char(13) ! Carriage return character

completed_calls

integer(int64) game24_module::completed_calls = 0

    integer(int64) :: completed_calls = 0       ! Number of completed recursive calls

expr_len

integer, parameter game24_module::expr_len = 200

    integer, parameter :: expr_len = 200   ! Maximum length for expressions

last_percentage

integer game24_module::last_percentage = -1

    integer :: last_percentage = -1              ! Last percentage reported

max_limit

integer, parameter game24_module::max_limit = 8

    integer, parameter :: max_limit = 8     ! Maximum allowed value for the number of inputs

progress_bar_width

integer, parameter game24_module::progress_bar_width = 50

    integer, parameter :: progress_bar_width = 50  ! Width of the progress bar

show_progress

logical game24_module::show_progress = .false.

    logical :: show_progress = .false.           ! Flag to show progress bar

total_calls

integer(int64) game24_module::total_calls = 0

    integer(int64) :: total_calls = 0           ! Total number of recursive calls

total_calls_n6

integer(int64), parameter game24_module::total_calls_n6 = 20000000_int64

    integer(int64), parameter :: total_calls_n6 = 20000000_int64

total_calls_n7

integer(int64), parameter game24_module::total_calls_n7 = 2648275200_int64

    integer(int64), parameter :: total_calls_n7 = 2648275200_int64

total_calls_n8

integer(int64), parameter game24_module::total_calls_n8 = 444557593600_int64

    integer(int64), parameter :: total_calls_n8 = 444557593600_int64