114 lines
4.1 KiB
Fortran
114 lines
4.1 KiB
Fortran
! Move-to-front algorithm
|
|
! tested with Intel ifx (IFX) 2025.2.1 20250806 on Kubuntu 25.10
|
|
! GNU Fortran (Ubuntu 15.2.0-4ubuntu4) 15.2.0 on Kubuntu 25.10
|
|
! VSI Fortran x86-64 V8.7-001 on OpenVMS x86_64 V9.2-3
|
|
! No Non-standard features used, should compile on any fairly recent Fortran.
|
|
! U.B., February 2026
|
|
!=========================================================================================
|
|
program FrontMove
|
|
implicit none
|
|
|
|
! Starting sequence in the local symbol tables in 2 subroutines
|
|
character (len=26), parameter :: startSymbolTab = 'abcdefghijklmnopqrstuvwxyz'
|
|
|
|
! The test cases of the task description:
|
|
call EncodeAndCrossCheck ('broood')
|
|
call EncodeAndCrossCheck ('bananaaa')
|
|
call EncodeAndCrossCheck ('hiphophiphop')
|
|
|
|
! Two more tests: What happens in MoveToFront() if char appears at the beginning ('a')
|
|
! or at the end ('z') of the symbol table?
|
|
call EncodeAndCrossCheck ('anton')
|
|
call EncodeAndCrossCheck ('zwareshagz')
|
|
|
|
contains
|
|
|
|
! =========================================================================
|
|
! Encode a given text string using the Move-to-fromt algorithm, then
|
|
! decode the resultant sequence of numbers, to be compared to the original.
|
|
! =========================================================================
|
|
subroutine EncodeAndCrossCheck (text)
|
|
|
|
character (len=*), intent(in) :: text ! Input: the text to encode
|
|
|
|
integer, dimension(len(text)) :: code ! Resultant numeric array
|
|
|
|
character (len=26) :: SymTab ! The symbol table to work with
|
|
integer :: l ! LEngth of input text
|
|
integer :: ii, idx ! Loop index, Pos of a char inside Symbol Table
|
|
|
|
! Initialize work table
|
|
SymTab = startSymbolTab
|
|
l = len (text)
|
|
|
|
write (*,'(A, T13, A)', advance='no') text, ' ->'
|
|
! Encoding Algorithm:
|
|
! for each symbol of the input sequence:
|
|
! output the index of the symbol in the symbol table
|
|
! move that symbol to the front of the symbol table
|
|
|
|
do ii=1, l
|
|
idx = index (SymTab, text(ii:ii))
|
|
code (ii) = idx-1 ! Code muss be null-based
|
|
write (*, '(I3)', advance='no') code(ii)
|
|
call moveToFront (SymTab, idx)
|
|
end do
|
|
do ii=3*l,36
|
|
write (*,'(x)', advance='no') ! some space to format output
|
|
enddo
|
|
write (*,'(A)', advance='no') ' -> '
|
|
! Now decode the resultant code and hope to see again the original text.
|
|
call decodeAndCheck (code, l, text)
|
|
|
|
end subroutine EncodeAndCrossCheck
|
|
|
|
|
|
! =====================================================================================
|
|
! Decode a given array of numbers and check if the rtesult matches the given input text
|
|
! =====================================================================================
|
|
subroutine decodeAndCheck (code, l, text)
|
|
|
|
integer , intent(in) ::l
|
|
integer, dimension(l), intent(in) :: code
|
|
character (len=*), intent(in) :: text ! the text to compare to the decode result.
|
|
|
|
character (len=26) :: SymTab
|
|
integer :: ii, idx
|
|
logical :: mismatch
|
|
|
|
! # Using the same starting symbol table
|
|
SymTab = startSymbolTab
|
|
mismatch = .false.
|
|
|
|
! Decoding Algorithm:
|
|
! for each index of the input sequence:
|
|
! output the symbol at that index of the symbol table
|
|
! move that symbol to the front of the symbol table
|
|
do ii=1, l
|
|
idx = code(ii) + 1
|
|
write (*, '(A1)', advance='no') SymTab (idx:idx)
|
|
if (SymTab (idx:idx) .ne. text (ii:ii)) mismatch = .true.
|
|
call moveToFront (SymTab, idx)
|
|
end do
|
|
|
|
if (.not. mismatch) then
|
|
write (*,*) '(Success)'
|
|
else
|
|
write (*,*) 'ERROR.'
|
|
endif
|
|
|
|
end subroutine decodeAndCheck
|
|
|
|
|
|
! =========================================================================
|
|
! Move the character found at index 'ind' in the string "'txt' to the front
|
|
! =========================================================================
|
|
subroutine moveToFront (txt, ind)
|
|
character (len=*), intent(inout) :: txt
|
|
integer, intent(in) :: ind
|
|
|
|
! Rearrange txt: character at ind, then everything in front of ind, then everything behind.
|
|
txt = txt(ind:ind) // txt(:ind-1) // txt (ind+1:)
|
|
end subroutine moveToFront
|
|
|
|
end program FrontMove
|