Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Twelve Statements in Fortran

By: a guest on Dec 3rd, 2012  |  syntax: Fortran  |  size: 3.23 KB  |  views: 138  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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