Task: Semordnilap

C: #include <stdio.h>
#include <stdlib.h>
#include <alloca.h> 
#include <string.h>

static void reverse(char *s, int len)
{
    int i, j;
    char tmp;

    for (i = 0, j = len - 1; i < len / 2; ++i, --j)
        tmp = s[i], s[i] = s[j], s[j] = tmp;
}


static int strsort(const void *s1, const void *s2)
{
    return strcmp(*(char *const *) s1, *(char *const *) s2);
}

int main(void)
{
    int i, c, ct = 0, len, sem = 0;
    char **words, **drows, tmp[24];
    FILE *dict = fopen("unixdict.txt", "r");

    
    while ((c = fgetc(dict)) != EOF)
        ct += c == '\n';
    rewind(dict);

    
    words = alloca(ct * sizeof words);
    drows = alloca(ct * sizeof drows);

    for (i = 0; fscanf(dict, "%s%n", tmp, &len) != EOF; ++i) {
        
        strcpy(words[i] = alloca(len), tmp);

        
        strcpy(drows[i] = alloca(len), tmp);
        reverse(drows[i], len - 1);
    }

    fclose(dict);
    qsort(drows, ct, sizeof drows, strsort);

    
    for (c = i = 0; i < ct; ++i) {
        while (strcmp(drows[i], words[c]) > 0 && c < ct - 1)
            c++;
        
        if (!strcmp(drows[i], words[c])) {
            strcpy(tmp, drows[i]);
            reverse(tmp, strlen(tmp));
            
            if (strcmp(drows[i], tmp) > 0 && sem++ < 5)
                printf("%s\t%s\n", drows[i], tmp);
        }
    }

    printf("Semordnilap pairs: %d\n", sem);
    return 0;
}










Fortran: 

























program Semordnilap
  implicit none
  integer :: i, ios, words, swords
  character(len=24), dimension(32768) :: dictionary, backword
  real, dimension(5) :: harvest
  
  open(7,file='unixdict.txt')
  do words = 1, 32768
    read(7, '(a)', iostat = ios) dictionary(words)
    if (ios .ne. 0) exit
  enddo
  close(7)
  if (iachar(dictionary(words)(1:1)) .eq. 0) words = words-1
  
  call bs(dictionary, words)
  
  
  
  swords = 0
  do i = 1, words
    call reverse(dictionary(i), backword(swords+1))
    if ((binary_search(dictionary, words, backword(swords+1))) &      
      .and. (.not. binary_search(backword, swords, dictionary(i))) &  
      .and. (dictionary(i) .ne. backword(swords+1))) then             
      swords = swords + 1
      call bs(backword, swords)
    endif
  enddo
  call random_number(harvest)
  call reverse('spalindromes', backword(swords+1))
  write(6, *) '5 of ', swords, backword(swords+1)
  write(6,'(5(a/))') (backword(1+int(harvest(i)*(swords-2))), i=1,5)

contains

  subroutine reverse(inp, outp)
    character(len=*), intent(in) :: inp
    character(len=*), intent(inout) :: outp
    integer :: k, L
    L = len_trim(inp)
    do k = 1, L
      outp(L+1-k:L+1-k) = inp(k:k)
    enddo
    do k = L+1, len(outp)
      outp(k:k) = ' '
    enddo
  end subroutine reverse

  subroutine bs(a, n) 
    
    character(len=*),dimension(*),intent(inout) :: a
    integer, intent(in) :: n
    integer :: i, j, k
    logical :: done
    character(len=1) :: t
    do i=n-1, 1, -1
      done = .true.
      do j=1, i
        if (a(j+1) .lt. a(j)) then
          done = .false.
          do k = 1, max(len_trim(a(j+1)), len_trim(a(j)))
            t = a(j+1)(k:k)
            a(j+1)(k:k) = a(j)(k:k)
            a(j)(k:k) = t(1:1)
          enddo
        endif
      enddo
      if (done) return
    enddo
  end subroutine bs

  logical function binary_search(source, n, target)
    character(len=*),dimension(*),intent(in) :: source
    character(len=*),intent(in) :: target
    integer, intent(in) :: n
    integer :: a,m,z
    a = 1
    z = n
    do while (a .lt. z)
      m = a + (z - a) / 2
      if (target .lt. source(m)) then
        z = m-1
      else
        if (m .eq. a) exit
        a = m
      endif
    enddo
    binary_search = (target .eq. source(a)) .or. (target .eq. source(z))
  end function binary_search

end program Semordnilap