firstf90
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
[more] попытался воспроизвести алгоритм Шеннона-Фано.
прошлый вопрос, снят понял ошибку. но всё равно не работает. буду рад с подсказку.
[more]
Код: MODULE modsh_f
Character :: a(6) ! символы
Integer :: af(6) ! частота символов
END MODULE
! подпрограмма для поиска кода каждой буквы
RECURSIVE Subroutine SearchTree(branch, full_branch, start_pos, end_pos)
USE modsh_f
Real :: dS ! Среднее значение массива
Integer :: i, m, S, start_pos, end_pos ! m - номер средней буквы в последовательности, S - сумма чисел, левой ветки
!Integer :: c_branch !string текущая история поворотов по веткам
Character :: branch
Character(len=77) :: c_branch,full_branch
a(1)='a'
a(2)='b'
a(3)='c'
a(4)='d'
a(5)='e'
a(6)='f'
af(1)=10
af(2)=8
af(3)=6
af(4)=5
af(5)=4
af(6)=3
do i=1,6
! проверка если это вход нулевой то очистить историю
if (a(i) .NE. ' ') then
call charSUM(c_branch,full_branch,branch)
c_branch= c_branch
else
c_branch = ''
EndIf
enddo
! Критерий выхода: если позиции символов совпали, то это конец
if (start_pos == end_pos) then
Write(*,*)a(start_pos), ' = ', c_branch
stop
EndIf
! Подсчет среднего значения частоты в последовательности
dS= 0
do i=start_pos, end_pos
dS= dS + af(i)
dS= dS/2
EndDo
S= 0
i= start_pos
m= i
do while (S+af(i)<dS .and. i<=end_pos)
S= S + af(i)
call INC(i); call INC(m)
enddo
! Рекурсия левая ветка дерева
call SearchTree('1', c_branch, start_pos, m)
! Правая ветка дерева
call SearchTree('0', c_branch, m+1, end_pos)
end
Subroutine INC(X)
Integer :: X
X=X+1.
END
Program ShennonFano
call SearchTree(' ',' ', 1, 6)
End Program ShennonFano
Subroutine charSUM(Summa,a,b)
Character(len=77) :: a, b
Character(len=77) :: Summa
Integer :: i
a=trim(a)
i = Len_Trim(a)
Summa = a(1:i)//b
end |
|
Всего записей: 3 | Зарегистр. 09-02-2012 | Отправлено: 10:12 09-02-2012 | Исправлено: firstf90, 11:16 09-02-2012 |
|
