! Palindrome_test Version 1, 25 May 2003

!     Takes DNA sequence as input and determines whether or not
!        it is a palindrome
!     A sequence is palindromic if it is identical to its reverse complement
!     "reverse" means read backwards
!     "complement" means A==>T, T==>A, C==>G, G==>C
!
!     Input is from keyboard:
!        DNA sequence of any length, case doesn't matter
!     Output is:
!        "palindromic" for sequences of even length that are palindromic 
!        "odd palindromic" for sequences of odd length that are
!             palindromic except for the central nucleotide
!        "not palindromic" for other sequences

! ******************* LIBRARIES and DECLARATIONS *******************
  DECLARE FUNCTION Palindrome_test, Even_length

! ************************ FILE DEFINITIONS ************************
! (none)

! *************************** CONSTANTS ****************************
  LET bases$ = "ACGT"	! The four DNA nucleotides arranged symmetrically
                        ! A is complementary to T, C to G
  LET true = 1          
  LET false = 0

! **************************** VARIABLES ***************************
! Variables are initialized and described
! Arrays are defined and described

! ************************** MAIN PROGRAM **************************

  CALL Enter_sequence
  IF Palindrome_test(sequence$) = true THEN
     IF Even_length(sequence$) = true THEN
        PRINT "palindromic"
     ELSE
        PRINT "odd palindromic"
     END IF
  ELSE
     PRINT "not palindromic"
  END IF

! ******************* SUBROUTINES and FUNCTIONS ********************

SUB Enter_sequence
!  It may seem silly to define what could be a single line subroutine, 
!  but doing so makes it easy to plug in more complicated routines later.
!  For example, I might decide later to check the sequence for
!  illegal characters

   INPUT PROMPT "Enter DNA sequence: ": input$
   LET sequence$ = UCase$(input$)
END SUB

FUNCTION Palindrome_test(sequence$)
!   Determines whether passed sequence is palindromic
!   Strategy:
!      Examines one nucleotide at a time, left to right
!         to see whether it is identical to the complement of 
!         the corresponding nucleotide from the right side of the
!         sequence 
!      Only the left half is examined in this way, since examining
!         the right half would duplicate effort
!      The central nucleotide of odd length sequences is ignored

   LET Palindrome_test = true
           ! Test for palindrome is true unless a pair of
           ! nonpalindromic nucleotides is encountered
   LET length_of_sequence = Len(sequence$)

   FOR left = 1 to length_of_sequence/2
      LET right = (length_of_sequence - left) + 1
      LET left_nucleotide$ = sequence$[left:left]
      LET left_nucleotide = Pos(bases$,left_nucleotide$)
           ! Pos finds position of one string within another)
      LET left_complement = 5 - left_nucleotide
      LET left_complement$ = bases$[left_complement:left_complement]
      LET right_nucleotide$ = sequence$[right:right]
      IF left_complement$ <> right_nucleotide$ THEN
         LET Palindrome_test = false
           ! One nonpalindromic nucleotide is enough
         EXIT FOR
      END IF
   NEXT left

END FUNCTION
    
FUNCTION Even_length(sequence$)
!  Determines whether the length of the passed sequence is even
!  Strategy:
!     If the length of the sequence Mod 2 is zero, then the length is even

   LET length_of_sequence = Len(sequence$)
   IF Mod(length_of_sequence,2) = 0 THEN 
      LET Even_length = true
   ELSE
      LET Even_length = false
   END IF
END FUNCTION  

! ****************************** DATA ******************************
! (none)

END

! *************** EXTERNAL SUBROUTINES and FUNCTIONS ***************
! (none)