• API
• FAQ
• Tools
• Trends
• Archive
SHARE
TWEET

# Twelve Statements in Fortran

a guest Dec 3rd, 2012 158 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. ! Solution for http://rosettacode.org/wiki/Twelve_statements
2. ! Demonstrating modern Fortran intrinsic array functions
3. ! Dec 1, 2012
4. program twelve
5.     implicit none
6.     integer, parameter :: NR = 12  ! a global constant
7.     logical :: consistent(NR), statements(NR) = .false.
8.
9.     ! Iterate over all 2^12 = 4096 combinations, checking if they are logically
10.     ! consistent or almost consistent (only 1 contradictory statement)
11.     do
12.         if (iterate(statements)) exit
13.         consistent = statements .eqv. check(statements)
14.         if (all(consistent)) print *, "MATCH:  ", statements
15.         if (count(consistent) == NR-1) print *, "Near miss:  ", statements
16.     end do
17.
18. contains
19.
20.     ! Checks which of the statements are true and which false
21.     function check(stin) result(stout)
22.         implicit none
23.         logical, intent(in) :: stin(NR)
24.         logical :: stout(NR)
25.         integer :: i
26.
27.         stout(1:12) = (/ NR == 12, &                        ! 1. "This is a numbered list of twelve statements."
28.             (count(stin(NR-5:)) == 3), &                    ! 2. "Exactly 3 of the last 6 statements are true."
29.             (count( (/ (stin(i), i=2, NR, 2) /) ) == 2), &  ! 3. "Exactly 2 of the even-numbered statements are true."
30.             merge(stin(6).and.stin(7), .true., stin(5)), &  ! 4. "If statement 5 is true, then statements 6 and 7 are both true."
31.             all(.not.stin(2:4)), &                          ! 5. "The 3 preceding statements are all false."
32.             (count( (/ (stin(i), i=1, NR, 2) /) ) == 4), &  ! 6. "Exactly 4 of the odd-numbered statements are true."
33.             xor(stin(2),stin(3)), &                         ! 7. "Either statement 2 or 3 is true, but not both."
34.             merge(stin(5).and.stin(6), .true., stin(7)), &  ! 8. "If statement 7 is true, then 5 and 6 are both true."
35.             (count(stin(1:6)) == 3), &                      ! 9. "Exactly 3 of the first 6 statements are true."
36.             stin(11).and.stin(12), &                        ! 10. "The next two statements are both true."
37.             (count(stin(7:9)) == 1), &                      ! 11. "Exactly 1 of statements 7, 8 and 9 are true."
38.             (count(stin(:11)) == 4) /)                      ! 12. "Exactly 4 of the preceding statements are true."
39.
40.     end function check
41.
42.
43.     ! Returns .false. until iteration has finished
44.     ! If s is filled with .false. in the beginning, iterates over all possibilities
45.     logical function iterate(s)
46.         implicit none
47.         logical, intent(inout) :: s(NR)
48.         integer :: i
49.
50.         ! Starting from the first element, flip the values until one of them
51.         ! flips to .true. or we reach the end without flipping any of them to .true.
52.         ! (which would mean we are back at the first value, twelve .false.s)
53.         ! eg. for three elements only this would work as
54.         ! FFF -> TFF -> FTF -> TTF -> FFT -> TFT -> FTT -> TTT -> FFF.
55.         do i = 1, 12
56.             s(i) = .not.s(i)
57.             if (s(i)) then
58.                 iterate = .false.
59.                 exit
60.             end if
61.             if (i == NR) iterate = .not.s(i)
62.         end do
63.
64.     end function iterate
65.
66. end program twelve
RAW Paste Data
Top