game24_ultra Program

Uses

  • program~~game24_ultra~~UsesGraph program~game24_ultra game24_ultra module~game24_module game24_module program~game24_ultra->module~game24_module iso_fortran_env iso_fortran_env module~game24_module->iso_fortran_env omp_lib omp_lib module~game24_module->omp_lib

An enhanced version of the 24-game solver using recursive search and pruning. Utilizes OpenMP for parallelization and includes a progress bar for real-time monitoring.


Calls

program~~game24_ultra~~CallsGraph program~game24_ultra game24_ultra proc~convert_to_number convert_to_number program~game24_ultra->proc~convert_to_number proc~remove_decimal_zeros remove_decimal_zeros program~game24_ultra->proc~remove_decimal_zeros proc~solve_24 solve_24 program~game24_ultra->proc~solve_24 proc~solve_24->proc~solve_24 omp_get_level omp_get_level proc~solve_24->omp_get_level proc~create_new_arrays create_new_arrays proc~solve_24->proc~create_new_arrays proc~update_progress_bar update_progress_bar proc~solve_24->proc~update_progress_bar

Variables

Type Attributes Name Initial
integer :: maxn
real, allocatable :: numbers(:)
character(len=expr_len), allocatable :: expressions(:)
integer :: i
integer :: ios
logical :: found_solution
character(len=10) :: user_input
character(len=1) :: play_again

Source Code

program game24_ultra
!! An enhanced version of the 24-game solver using recursive search and pruning.
!! Utilizes OpenMP for parallelization and includes a progress bar for real-time monitoring.
    use game24_module
    implicit none

    ! Declare variables
    integer                        :: maxn            ! Number of numbers to be entered by the user
    real, allocatable              :: numbers(:)      ! Array to store the numbers entered by the user
    character(len=expr_len), allocatable :: expressions(:)  ! Array to store the expressions
    integer                        :: i, ios          ! Loop counter and I/O status
    logical                        :: found_solution  ! Flag to indicate if a solution was found
    character(len=10)              :: user_input      ! Variable to store user input
    character(len=1)               :: play_again      ! Variable to store the user's decision

    do  ! Game loop to allow restarting the game

        ! Prompt the user for the number of numbers to use in the game
        do
            write (*, '(A,I0,A)', advance='no') 'Enter the number of numbers (1 to ', max_limit, '): '
            read (*, *, iostat=ios) maxn

            ! Check if the input is valid
            if (ios /= 0) then
                write (*, '(A,I0,A)') 'Invalid input. Please enter an integer between 1 and ', max_limit, '.'
                cycle
            end if

            ! Validate the input: Ensure the number of numbers is within the valid range
            if (maxn < 1 .or. maxn > max_limit) then
                write (*, '(A,I0,A)') 'Error: Number of numbers must be between 1 and ', max_limit, '. Try again.'
                cycle
            end if

            exit  ! Exit loop if the input is valid
        end do

        ! Allocate memory for the arrays based on the number of numbers
        allocate (numbers(maxn))
        allocate (expressions(maxn))

        ! Prompt the user to enter the numbers or card values
        write (*, '(A,I0,A)') 'Enter ', maxn, ' numbers or card values (A=1, J=11, Q=12, K=13).'
        do i = 1, maxn
            do
                ! Prompt the user to enter a number or card value
                write (*, '(A,I0,A)', advance='no') 'Enter value for card ', i, ': '
                read (*, '(A)', iostat=ios) user_input

                ! Check if input is an integer or valid card symbol (A, J, Q, K)
                call convert_to_number(user_input, numbers(i), ios)

                ! If the input is valid, exit loop
                if (ios == 0) exit

                ! Invalid input: prompt the user to try again
                write (*, '(A)') 'Invalid input. Please enter an integer or valid card symbol (A, J, Q, K).'
            end do

            ! Convert the number to a string expression and remove trailing zeros
            write (expressions(i), '(F0.2)') numbers(i)
            call remove_decimal_zeros(expressions(i), expressions(i))
        end do

        ! Initialize the solution flag to false
        found_solution = .false.

        ! Assign precomputed total_calls based on n
        select case (maxn)
        case (6)
            total_calls = total_calls_n6
        case (7)
            total_calls = total_calls_n7
        case (8)
            total_calls = total_calls_n8
        case default
            total_calls = 0
        end select

        ! Decide whether to show progress bar based on n
        if (maxn >= 6) then
            show_progress = .true.
            completed_calls = 0
            last_percentage = -1

            ! Initialize progress bar display
            write (*, '(A)', advance='no') '['//repeat(' ', progress_bar_width)//'] 0%'
            call flush (0)  ! Ensure the output is displayed immediately
        else
            show_progress = .false.
        end if

        ! Start parallel region
        !$omp parallel
        !$omp single nowait
        call solve_24(numbers, expressions, found_solution)
        !$omp end single
        !$omp end parallel

        ! After search completes, ensure the progress bar reaches 100% if shown
        if (show_progress .and. .not. found_solution) then
            write (*, '(A, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] 100%  '
            call flush (0)
            write (*, '(A)') ''  ! Insert a blank line
        end if

        ! If a solution was found and progress bar is shown, ensure a blank line
        if (show_progress .and. found_solution) then
            ! Progress bar already refreshed to 100% and blank line inserted in solve_24
        end if

        ! If no solution was found, print a message
        if (.not. found_solution) then
            write (*, '(A)') 'No valid solution found.'
        end if

        ! Deallocate the memory used by the arrays
        deallocate (numbers)
        deallocate (expressions)

        ! Ask the user if they want to play again
        if (show_progress) then
            write (*, '(A)', advance='no') carriage_return//'Play again? (Enter y/n to continue or any other key to exit): '
        else
            write (*, '(A)', advance='no') 'Play again? (Enter y/n to continue or any other key to exit): '
        end if
        read (*, '(A)') play_again  ! Read user input

        ! Check if the user wants to exit
        if (play_again /= 'y' .and. play_again /= 'Y') exit

    end do  ! End of game loop

    write (*, '(A)') 'Exiting the game...'

end program game24_ultra