!*************************************************************************************** module anagram_routines !*************************************************************************************** implicit none !the dictionary file: integer,parameter :: file_unit = 1000 character(len=*),parameter :: filename = 'unixdict.txt' !maximum number of characters in a word: integer,parameter :: max_chars = 50 !maximum number of characters in the string displaying the anagram lists: integer,parameter :: str_len = 256 type word character(len=max_chars) :: str = repeat(' ',max_chars) !the word from the dictionary integer :: n = 0 !length of this word integer :: n_anagrams = 0 !number of anagrams found logical :: checked = .false. !if this one has already been checked character(len=str_len) :: anagrams = repeat(' ',str_len) !the anagram list for this word end type word !the dictionary structure: type(word),dimension(:),allocatable,target :: dict contains !*************************************************************************************** !****************************************************************************** function count_lines_in_file(fid) result(n_lines) !****************************************************************************** implicit none integer :: n_lines integer,intent(in) :: fid character(len=1) :: tmp integer :: i integer :: ios !the file is assumed to be open already. rewind(fid) !rewind to beginning of the file n_lines = 0 do !read each line until the end of the file. read(fid,'(A1)',iostat=ios) tmp if (ios < 0) exit !End of file n_lines = n_lines + 1 !row counter end do rewind(fid) !rewind to beginning of the file !****************************************************************************** end function count_lines_in_file !****************************************************************************** !****************************************************************************** pure elemental function is_anagram(x,y) !****************************************************************************** implicit none character(len=*),intent(in) :: x character(len=*),intent(in) :: y logical :: is_anagram character(len=len(x)) :: x_tmp !a copy of x integer :: i,j !a character not found in any word: character(len=1),parameter :: null = achar(0) !x and y are assumed to be the same size. x_tmp = x do i=1,len_trim(x) j = index(x_tmp, y(i:i)) !look for this character in x_tmp if (j/=0) then x_tmp(j:j) = null !clear it so it won't be checked again else is_anagram = .false. !character not found: x,y are not anagrams return end if end do !if we got to this point, all the characters ! were the same, so x,y are anagrams: is_anagram = .true. !****************************************************************************** end function is_anagram !****************************************************************************** !*************************************************************************************** end module anagram_routines !*************************************************************************************** !*************************************************************************************** program main !*************************************************************************************** use anagram_routines implicit none integer :: n,i,j,n_max type(word),pointer :: x,y logical :: first_word real :: start, finish call cpu_time(start) !..start timer !open the dictionary and read in all the words: open(unit=file_unit,file=filename) !open the file n = count_lines_in_file(file_unit) !count lines in the file allocate(dict(n)) !allocate dictionary structure do i=1,n ! read(file_unit,'(A)') dict(i)%str !each line is a word in the dictionary dict(i)%n = len_trim(dict(i)%str) !saving length here to avoid trim's below end do close(file_unit) !close the file !search dictionary for anagrams: do i=1,n x => dict(i) !pointer to simplify code first_word = .true. !initialize do j=i,n y => dict(j) !pointer to simplify code !checks to avoid checking words unnecessarily: if (x%checked .or. y%checked) cycle !both must not have been checked already if (x%n/=y%n) cycle !must be the same size if (x%str(1:x%n)==y%str(1:y%n)) cycle !can't be the same word ! check to see if x,y are anagrams: if (is_anagram(x%str(1:x%n), y%str(1:y%n))) then !they are anagrams. y%checked = .true. !don't check this one again. x%n_anagrams = x%n_anagrams + 1 if (first_word) then !this is the first anagram found for this word. first_word = .false. x%n_anagrams = x%n_anagrams + 1 x%anagrams = trim(x%anagrams)//x%str(1:x%n) !add first word to list end if x%anagrams = trim(x%anagrams)//','//y%str(1:y%n) !add next word to list end if end do x%checked = .true. !don't check this one again end do !anagram groups with the most words: write(*,*) '' n_max = maxval(dict%n_anagrams) do i=1,n if (dict(i)%n_anagrams==n_max) write(*,'(A)') trim(dict(i)%anagrams) end do !anagram group containing longest words: write(*,*) '' n_max = maxval(dict%n, mask=dict%n_anagrams>0) do i=1,n if (dict(i)%n_anagrams>0 .and. dict(i)%n==n_max) write(*,'(A)') trim(dict(i)%anagrams) end do write(*,*) '' call cpu_time(finish) !...stop timer write(*,'(A,F6.3,A)') '[Runtime = ',finish-start,' sec]' write(*,*) '' !*************************************************************************************** end program main !***************************************************************************************