Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ! 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement