Task: Anagrams








VB: dim x as integer, y as integer
dim SortX as integer
dim StrOutPut as string
dim Count as integer
dim MaxCount as integer

dim AnaList as QStringlist
dim wordlist as QStringlist
dim Templist as QStringlist
dim Charlist as Qstringlist


function sortChars(expr as string) as string
    Charlist.clear
    for SortX = 1 to len(expr)
         Charlist.AddItems expr[SortX]
    next
    charlist.sort
    result = Charlist.text - chr$(10) - chr$(13)
end function
 

    wordlist.loadfromfile ("unixdict.txt")

    
    for x = 0 to wordlist.itemcount-1
        AnaList.AddItems sortChars(wordlist.item(x))
    next
       
    
    analist.sort
    MaxCount = 0
    
    for x = 0 to AnaList.Itemcount-1
        Count = 0
        for y = x+1 to AnaList.Itemcount-1
            if AnaList.item(y) = AnaList.item(x) then
                inc(count)
            else
                if count > MaxCount then 
                    Templist.clear
                    MaxCount = Count
                    Templist.AddItems AnaList.item(x)
                elseif count = MaxCount then
                    Templist.AddItems AnaList.item(x)
                end if
                exit for
            end if
        next
    next
       
    
    for x = 0 to Templist.Itemcount-1
        for y = 0 to wordlist.Itemcount-1 
            if Templist.item(x) = sortChars(wordlist.item(y)) then
                StrOutPut = StrOutPut + wordlist.item(y) + "  "
            end if
        next
        StrOutPut = StrOutPut + chr$(13) + chr$(10)
    next

ShowMessage StrOutPut 
End



Fortran: 
	module anagram_routines

	implicit none
	
	
	integer,parameter :: file_unit = 1000
	character(len=*),parameter :: filename = 'unixdict.txt'
	
	
	integer,parameter :: max_chars = 50
	
	
	integer,parameter :: str_len = 256
	
	type word 
	  character(len=max_chars) :: str = repeat(' ',max_chars)    
	  integer                  :: n = 0                          
	  integer                  :: n_anagrams = 0	             
	  logical                  :: checked = .false.              
	  character(len=str_len)   :: anagrams = repeat(' ',str_len) 
	end type word
	
	
	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
		
		
		
		rewind(fid)	  
		
		n_lines = 0
		do 
			read(fid,'(A1)',iostat=ios) tmp
			if (ios < 0) exit      
			n_lines = n_lines + 1  
		end do

		rewind(fid)   
				
	
		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	
		integer :: i,j
		
		
		character(len=1),parameter :: null = achar(0)
			
		
		
		x_tmp = x
		do i=1,len_trim(x)
			j = index(x_tmp, y(i:i)) 
			if (j/=0) then
				x_tmp(j:j) = null  
			else
				is_anagram = .false. 
				return
			end if
		end do
	
		
		
		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)	
	
	
	open(unit=file_unit,file=filename)      
	n = count_lines_in_file(file_unit)      
	allocate(dict(n))                       
	do i=1,n                                
		read(file_unit,'(A)') dict(i)%str   
		dict(i)%n = len_trim(dict(i)%str)   
	end do		
	close(file_unit)                        
	
	
	do i=1,n
		
		x => dict(i)	
		first_word = .true.	
		
		do j=i,n
		
			y => dict(j)	
			
			
			if (x%checked .or. y%checked) cycle     
			if (x%n/=y%n) cycle                     
			if (x%str(1:x%n)==y%str(1:y%n)) cycle   
			
			
			if (is_anagram(x%str(1:x%n), y%str(1:y%n))) then
				
				y%checked = .true. 	
				x%n_anagrams = x%n_anagrams + 1
				if (first_word) then
					
					first_word = .false.
					x%n_anagrams = x%n_anagrams + 1
					x%anagrams = trim(x%anagrams)//x%str(1:x%n)  
				end if
				x%anagrams = trim(x%anagrams)//','//y%str(1:y%n) 
			end if
	
		end do
		x%checked = .true.  
		 
	end do
	
	
	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
	
	
	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)	
	write(*,'(A,F6.3,A)') '[Runtime = ',finish-start,' sec]'
	write(*,*) ''


	end program main