1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
|
program roulette
use iso_fortran_env ! to get at longer integers
implicit none
integer, parameter :: nrMax = 100000000 ! max random numbers to be generated at once
integer(kind=int64) spinCount, i, nr ! potentially large integers
real, parameter :: redLimit = 18.0 / 38.0, blackLimit = 36.0 / 38.0
integer :: longestStreak = 0, currentStreak = 0, lastColour = 0, colour
real, allocatable :: R(:)
real start, finish
write( *, "( 'How many spins? ' )", advance="no" ); read( *, * ) spinCount
allocate( R( min(spinCount,nrMax) ) )
start = getTime()
call random_seed
nr = 0; call random_number( R ) ! generate size(R) random numbers in [0,1)
do i = 1, spinCount
nr = nr + 1
if ( nr > nrMax ) then
! write( *, * ) "So far: ", i - 1
nr = 1
call random_number( R )
end if
if ( R(nr) < redLimit ) then
colour = 1
else if ( R(nr) < blackLimit ) then
colour = 2
else
colour = 3
end if
if ( colour == lastColour ) then
currentStreak = currentStreak + 1
else
if ( currentStreak > longestStreak ) longestStreak = currentStreak
currentStreak = 1
lastColour = colour
end if
end do
if ( currentStreak > longestStreak ) longestStreak = currentStreak ! just the final one
finish = getTime()
write( *, "( 'Longest streak = ' , i0 )" ) longestStreak
write( *, "( 'Time taken = ' , f8.3, ' s' )" ) finish - start
contains
real function getTime()
integer t(8)
call date_and_time( values=t )
getTime = 3600 * t(5) + 60 * t(6) + t(7) + 0.001 * t(8)
end function getTime
end program roulette
| |