! Solution for http://rosettacode.org/wiki/Twelve_statements
! Demonstrating modern Fortran intrinsic array functions
! Dec 1, 2012
program twelve
implicit none
integer, parameter :: NR = 12 ! a global constant
logical :: consistent(NR), statements(NR) = .false.
! Iterate over all 2^12 = 4096 combinations, checking if they are logically
! consistent or almost consistent (only 1 contradictory statement)
do
if (iterate(statements)) exit
consistent = statements .eqv. check(statements)
if (all(consistent)) print *, "MATCH: ", statements
if (count(consistent) == NR-1) print *, "Near miss: ", statements
end do
contains
! Checks which of the statements are true and which false
function check(stin) result(stout)
implicit none
logical, intent(in) :: stin(NR)
logical :: stout(NR)
integer :: i
stout(1:12) = (/ NR == 12, & ! 1. "This is a numbered list of twelve statements."
(count(stin(NR-5:)) == 3), & ! 2. "Exactly 3 of the last 6 statements are true."
(count( (/ (stin(i), i=2, NR, 2) /) ) == 2), & ! 3. "Exactly 2 of the even-numbered statements are true."
merge(stin(6).and.stin(7), .true., stin(5)), & ! 4. "If statement 5 is true, then statements 6 and 7 are both true."
all(.not.stin(2:4)), & ! 5. "The 3 preceding statements are all false."
(count( (/ (stin(i), i=1, NR, 2) /) ) == 4), & ! 6. "Exactly 4 of the odd-numbered statements are true."
xor(stin(2),stin(3)), & ! 7. "Either statement 2 or 3 is true, but not both."
merge(stin(5).and.stin(6), .true., stin(7)), & ! 8. "If statement 7 is true, then 5 and 6 are both true."
(count(stin(1:6)) == 3), & ! 9. "Exactly 3 of the first 6 statements are true."
stin(11).and.stin(12), & ! 10. "The next two statements are both true."
(count(stin(7:9)) == 1), & ! 11. "Exactly 1 of statements 7, 8 and 9 are true."
(count(stin(:11)) == 4) /) ! 12. "Exactly 4 of the preceding statements are true."
end function check
! Returns .false. until iteration has finished
! If s is filled with .false. in the beginning, iterates over all possibilities
logical function iterate(s)
implicit none
logical, intent(inout) :: s(NR)
integer :: i
! Starting from the first element, flip the values until one of them
! flips to .true. or we reach the end without flipping any of them to .true.
! (which would mean we are back at the first value, twelve .false.s)
! eg. for three elements only this would work as
! FFF -> TFF -> FTF -> TTF -> FFT -> TFT -> FTT -> TTT -> FFF.
do i = 1, 12
s(i) = .not.s(i)
if (s(i)) then
iterate = .false.
exit
end if
if (i == NR) iterate = .not.s(i)
end do
end function iterate
end program twelve