Добавил:

Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Восточноукраинский национальный университет им. В. Даля

Предмет:

[НЕСОРТИРОВАННОЕ]

Файл:

Алгоритм перебора Бойера

.doc

Скачиваний:

Добавлен:

26.03.2015

Размер:

90.62 Кб

Скачать

☆

Дячишин

Алгоритм перебора Бойера-Мура

Прежде всего, следует определить тип данных «таблица смещений». Для кодовой таблицы, состоящей из 256 символов, определение этого типа будет выглядеть так:

Public Type TBMTable

TBMTable(0 To 255) As Integer

Далее приводится процедура, вычисляющая таблицу смещений

Private Sub MakeBMTable(BMT As TBMTable, P As String)

Dim i As Integer

For i = 0 To 255

BMT(i) = Length(P)

For i = Length(P) To 1

If BMT(P(i)) = Length(P) Then

BMT(P(i)) = Length(P) - i

Next i

End Sub

Теперь напишем функцию, осуществляющую поиск

Function BMSearch (StartPos As Integer, S, P As String, BMT As TBMTable) As Integer

Dim Pos, lp, i As Integer

lp = Length(P)

Pos = StartPos + lp - 1

Do While Pos < Length(S)

If P(lp) <> S(Pos) Then

Pos = Pos + BMT(S(Pos))

Else

For i = lp - 1 To 1

If P(i) <> S(Pos - lp + i) Then

Inc (Pos)

Break

End If

Else

If i = 1 Then

Result = Pos - lp + 1

Exitif

Next i

Result = 0

End Function

Функция BMSearch возвращает позицию первого символа первого вхождения образца P в строке S. Если последовательность P в S не найдена, функция возвращает 0. Параметр StartPos позволяет указать позицию в строке S, с которой следует начинать поиск. Это может быть полезно в том случае, если вы захотите найти все вхождения P в S. Для поиска с самого начала строки следует задать StartPos равным 1. Если результат поиска не равен нулю, то для того, чтобы найти следующее вхождение P в S, нужно задать StartPos равным значению «предыдущий результат плюс длина образца».

Алгоритм Кнута – Мориса - Прата

алгоритм (проверяющий, является ли слово X=x[1]...x[n] подсловом слова Y=y[1]...y[m]

Решение. Сначала вычисляем таблицу l[1]...l[n]как раньше. Затем пишем такую программу:

j=0; len=0;

{len - длина максимального качала слова X, одновременно

являющегося концом слова y[1]..j[j]}

Do while (len<>n) and (j<>m)

Do while (x(len+1)<>у(j+1) and (len>0)

{начало не подходит, применяем к нему функцию l}

len = l(len)

end

{нашли подходящее или убедились в отсутствии}

if x(len+1)=y(j+1)

{x(1)..x(len) - самое длинное подходящее начало}

len=len+1

loop

else

{подходящих нет}

len=0

Loop

j=j+1

end

{если len=n, слово X встретилось; иначе мы дошли до конца

слова Y, так и не встретив X}

Алгоритм кодировки методом Хаффмана

Public sub hafman

Описание в модуле

Public Type PCodElement

PCodElement = CodElement

CodElement = record

NewLeft, NewRight, P0, P1 as PCodElement {элемент входящий одновременно}

LengthBiteChain as byte { в массив , очередь и дерево }

BiteChain as word

CounterEnter as word

Key as boolean

Index as byte

TCodeTable (0 to 255) as PCodElement

dim CurPoint, HelpPoint, LeftRange, RightRange, Root as PCodElement

dim CodeTable as TCodeTable

dim InputF, OutputF, InterF as file

dim TimeUnPakFile, NumRead, NumWritten, LengthOutFile, LengthArcFile as longint

dim AttrUnPakFile as word

dim InBuf (0 to 10239 as byte

dim OutBuf (0..10239) as byte

dim CRC, CounterBite as byte

dim OutCounter, InCounter, OutWord, BiteChain as word

dim St as string

dim Create, NormalWork, ErrorByte, DeleteFile as boolean

Private sub ErrorMessage

If ErrorByte <> 0 then

Case ErrorByte

Case 2

print('File not found ...')

Case 3

print('Path not found ...')

Case 5

print('Access denied ...')

Case 6

print('Invalid handle ...')

Case 8

print('Not enough memory ...')

Case 10

print('Invalid environment ...')

Case 11

print('Invalid format ...')

Case 18

print('No more files ...')

else

print('Error #',ErrorByte,' ...')

end

NormalWork=False

ErrorByte=0

End sub

Private sub ResetFile

{ --- открытие файла для архивации --- }

dim St as string

Assign(InputF, ParamStr(3))

Reset(InputF, 1)

ErrorByte=IOResult

ErrorMessage

If NormalWork then

Print ('Pak file : ',ParamStr(3),'...')

End sub

Private sub ResetArchiv

{ --- открытие файла архива, или его создание --- }

St=ParamStr(2)

If Pos('.',St)<>0 then Delete(St,Pos('.',St),4)

St=St+'.vsg'

Assign(OutputF, St)

Reset(OutPutF,1)

Create=False

If IOResult=2 then Rewrite(OutputF, 1)

Create=True

End if

If NormalWork then elseif Create then print('Create archiv : ',St,'...')

else

print('Open archiv : ',St,'...')

end sub

private sub SearchNameInArchiv

{ --- в дальнейшем - поиск имени файла в архиве --- }

Seek(OutputF,FileSize(OutputF))

ErrorByte=IOResult

ErrorMessage

End sub

procedure DisposeCodeTable

{ --- уничтожение кодовой таблицы и очереди --- }

dim I as byte

For I=0 to 255

Dispose(CodeTable[I])

End sub

Private sub ClosePakFile

{ --- закрытие архивируемого файла --- }

dim I as byte

If DeleteFile then Erase(InputF)

Close(InputF)

End sub

Private sub CloseArchiv

{ --- закрытие архивного файла --- }

If FileSize(OutputF)=0 then Erase(OutputF)

Close(OutputF)

End sub

Private sub InitCodeTable

{ --- инициализация таблицы кодировки --- }

dim I as byte

For I=0 to 255

New(CurPoint)

CodeTable[I]=CurPoint

With CodeTable[I] do

P0=Nil

P1=Nil

LengthBiteChain=0

BiteChain=0

CounterEnter=1

Key=True

Index=I

Next i

For I=0 to 255

If I>0 then CodeTable[I-1].NewRight=CodeTable[I]

elseIf I<255 then CodeTable[I+1].NewLeft=CodeTable[I]

Next i

LeftRange=CodeTable[0]

RightRange=CodeTable[255]

CodeTable[0].NewLeft=Nil

CodeTable[255].NewRight=Nil

End sub

Private sub SortQueueByte

{ --- пузырьковая сортировка по возрастанию --- }

dim Pr1,Pr2 as PCodElement

CurPoint=LeftRange

Do While CurPoint <> RightRange

If CurPoint.CounterEnter > CurPoint.NewRight.CounterEnter then HelpPoint=CurPoint.NewRight

HelpPoint.NewLeft=CurPoint.NewLeft

CurPoint.NewLeft=HelpPoint

If HelpPoint.NewRight<>Nil then

HelpPoint.NewRight.NewLeft=CurPoint

CurPoint.NewRight=HelpPoint.NewRight

HelpPoint.NewRight=CurPoint

If HelpPoint.NewLeft<>Nil then

HelpPoint.NewLeft.NewRight=HelpPoint

If CurPoint=LeftRange then LeftRange=HelpPoint

If HelpPoint=RightRange then RightRange=CurPoint

CurPoint=CurPoint.NewLeft

If CurPoint = LeftRange then CurPoint=CurPoint.NewRight

else CurPoint=CurPoint.NewLeft

else CurPoint=CurPoint.NewRight

loop

end sub

private sub CounterNumberEnter

{ --- подсчет частот вхождений байтов в блоке --- }

dim C as word

For C=0 to NumRead-1

Inc(CodeTable[(InBuf[C])].CounterEnter)

Next c

function SearchOpenCode as boolean

{ --- поиск в очереди пары открытых по Key минимальных значений --- }

CurPoint=LeftRange

HelpPoint=LeftRange

HelpPoint=HelpPoint.NewRight

Do While not CurPoint.Key

CurPoint=CurPoint.NewRight

Do While (not (HelpPoint=RightRange)) and (not HelpPoint.Key)

HelpPoint=HelpPoint.NewRight

If (HelpPoint=CurPoint) and (HelpPoint<>RightRange) then

HelpPoint=HelpPoint.NewRight

loop

If HelpPoint=CurPoint then SearchOpenCode=False else SearchOpenCode=True

End sub

Private sub CreateTree

{ --- создание дерева частот вхождения --- }

do While SearchOpenCode

New(Root)

With Root do

P0=CurPoint

P1=HelpPoint

LengthBiteChain=0

BiteChain=0

CounterEnter=P0.CounterEnter + P1.CounterEnter

Key=True

P0.Key=False

P1.Key=False

End with

HelpPoint=LeftRange

Do While (HelpPoint.CounterEnter < Root.CounterEnter) and

(HelpPoint<>Nil)

HelpPoint=HelpPoint.NewRight

If HelpPoint=Nil then { добавление в конец }

Root.NewLeft=RightRange

RightRange.NewRight=Root

Root.NewRight=Nil

RightRange=Root

End if

else

{ вставка перед HelpPoint }

Root.NewLeft=HelpPoint.NewLeft

HelpPoint.NewLeft=Root

Root.NewRight=HelpPoint

If Root.NewLeft<>Nil then Root.NewLeft.NewRight=Root

loop

end sub

private sub ViewTree( P as PCodElement )

{ --- просмотр дерева частот и присваивание кодировочных цепей листьям --- }

dim Mask,I as word

Inc(CounterBite)

If P.P0<>Nil then ViewTree( P.P0 )

If P.P1<>Nil then

Mask=(1 SHL (16-CounterBite))

BiteChain=BiteChain OR Mask

ViewTree( P.P1 )

Mask=(1 SHL (16-CounterBite))

BiteChain=BiteChain XOR Mask

End if

If (P.P0=Nil) and (P.P1=Nil) then

P.BiteChain=BiteChain

P.LengthBiteChain=CounterBite-1

End if

Dec(CounterBite)

End sub

Private sub CreateCompressCode

{ --- обнуление переменных и запуск просмотра дерева с вершины --- }

BiteChain=0

CounterBite=0

Root.Key=False

ViewTree(Root)

End sub

Private sub DeleteTree

{ --- удаление дерева --- }

dim P as PCodElement

CurPoint=LeftRange

Do While CurPoint<>Nil begin

If (CurPoint.P0<>Nil) and (CurPoint.P1<>Nil) then

If CurPoint.NewLeft <> Nil then

CurPoint.NewLeft.NewRight=CurPoint.NewRight

If CurPoint.NewRight <> Nil then

CurPoint.NewRight.NewLeft=CurPoint.NewLeft

If CurPoint=LeftRange then LeftRange=CurPoint.NewRight

If CurPoint=RightRange then RightRange=CurPoint.NewLeft

P=CurPoint

CurPoint=P.NewRight

Dispose(P)

loop

else CurPoint=CurPoint.NewRight

end sub

private sub SaveBufHeader

{ --- запись в буфер заголовка архива --- }

public Type ByteField

ByteField (0 to 6) as byte

Header as ByteField ( $56, $53, $31, $00, $00, $00, $00 )

header =( $56, $53, $31, $00, $00, $00, $00 )

If Create then

Move(Header,OutBuf[0],7)

OutCounter=7

else

Move(Header[3],OutBuf[0],4)

OutCounter=4

End sub

Private sub SaveBufFATInfo

{ --- запись в буфер всей информации по файлу --- }

dim I as byte

dim St as String

dim R as SearchRec

St=ParamStr(3)

For I=0 to Length(St)+1

OutBuf[OutCounter]=byte(Ord(St[I]))

Inc(OutCounter)

Next i

FindFirst(St,$00,R)

Dec(OutCounter)

Move(R.Time,OutBuf[OutCounter],4)

OutCounter=OutCounter+4

OutBuf[OutCounter]=R.Attr

Move(R.Size,OutBuf[OutCounter+1],4)

OutCounter=OutCounter+5

End sub

Private sub SaveBufCodeArray

{ --- сохранить массив частот вхождений в архивном файле --- }

dim I as byte

For I=0 to 255

OutBuf[OutCounter]=Hi(CodeTable[I].CounterEnter)

Inc(OutCounter)

OutBuf[OutCounter]=Lo(CodeTable[I].CounterEnter)

Inc(OutCounter)

Next i

End sub

Pribate sub CreateCodeArchiv

{ --- создание кода сжатия --- }

InitCodeTable { инициализация кодовой таблицы }

CounterNumberEnter { подсчет числа вхождений байт в блок }

SortQueueByte { cортировка по возрастанию числа вхождений }

SaveBufHeader { сохранить заголовок архива в буфере }

SaveBufFATInfo { сохраняется FAT информация по файлу }

SaveBufCodeArray { сохранить массив частот вхождений в архивном файле }

CreateTree { создание дерева частот }

CreateCompressCode { cоздание кода сжатия }

DeleteTree { удаление дерева частот }

End sub

Private sub PakOneByte

{ --- сжатие и пересылка в выходной буфер одного байта --- }

dim Mask as word

Tail as boolean

CRC=CRC XOR InBuf[InCounter]

Mask=CodeTable[InBuf[InCounter]].BiteChain SHR CounterBite

OutWord=OutWord OR Mask

CounterBite=CounterBite+CodeTable[InBuf[InCounter]].LengthBiteChain

If CounterBite>15 then Tail=True else Tail=False

Do While CounterBite>7

OutBuf[OutCounter]=Hi(OutWord)

Inc(OutCounter)

If OutCounter=(SizeOf(OutBuf)-4) then

BlockWrite(OutputF,OutBuf,OutCounter,NumWritten)

OutCounter=0

End if

CounterBite=CounterBite-8

If CounterBite<>0 then OutWord=OutWord SHL 8 else OutWord=0

If Tail then

Mask=CodeTable[InBuf[InCounter]].BiteChain SHL

(CodeTable[InBuf[InCounter]].LengthBiteChain-CounterBite)

OutWord=OutWord OR Mask

End if

Inc(InCounter)

If (InCounter=(SizeOf(InBuf))) or (InCounter=NumRead) then

InCounter=0

BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead)

End if

end

private sub PakFile

{ --- процедура непосредственного сжатия файла --- }

ResetFile

SearchNameInArchiv

If NormalWork then

BlockRead(InputF,InBuf,SizeOf(InBuf),NumRead)

OutWord=0

CounterBite=0

OutCounter=0

InCounter=0

CRC=0

CreateCodeArchiv

Do While (NumRead<>0)

PakOneByte

OutBuf[OutCounter]=Hi(OutWord)

Inc(OutCounter)

OutBuf[OutCounter]=CRC

Inc(OutCounter)

BlockWrite(OutputF,OutBuf,OutCounter,NumWritten)

DisposeCodeTable

ClosePakFile

loop

end sub

private sub ResetUnPakFiles

{ --- открытие файла для распаковки --- }

InCounter=7

St=''

repeat

St[InCounter-7]=Chr(InBuf[InCounter])

Inc(InCounter)

Do until InCounter=InBuf[7]+8

Assign(InterF,St)

Rewrite(InterF,1)

ErrorByte=IOResult

ErrorMessage

If NormalWork then

print('UnPak file : ',St,'...')

Move(InBuf[InCounter],TimeUnPakFile,4)

InCounter=InCounter+4

AttrUnPakFile=InBuf[InCounter]

Inc(InCounter)

Move(InBuf[InCounter],LengthArcFile,4)

InCounter=InCounter+4

loop

end sub

private sub CloseUnPakFile

{ --- закрытие файла для распаковки --- }

If not NormalWork then Erase(InterF)

else

SetFAttr(InterF,AttrUnPakFile)

SetFTime(InterF,TimeUnPakFile)

End if

Close(InterF)

End sub

Private sub RestoryCodeTable

{ --- воссоздание кодовой таблицы по архивному файлу --- }

dim I as byte

InitCodeTable

For I=0 to 255

CodeTable[I].CounterEnter=InBuf[InCounter]

CodeTable[I].CounterEnter=CodeTable[I].CounterEnter SHL 8

Inc(InCounter)

CodeTable[I].CounterEnter=CodeTable[I].CounterEnter+InBuf[InCounter]

Inc(InCounter)

Next i

End sub

Private sub UnPakByte( P as PCodElement )

{ --- распаковка одного байта --- }

dim Mask as word

If (P.P0=Nil) and (P.P1=Nil) then

OutBuf[OutCounter]=P.Index

Inc(OutCounter)

Inc(LengthOutFile)

If OutCounter = (SizeOf(OutBuf)-1) then

BlockWrite(InterF,OutBuf,OutCounter,NumWritten)

OutCounter=0

else

Inc(CounterBite)

If CounterBite=9 then

Inc(InCounter)

If InCounter = (SizeOf(InBuf)) then

InCounter=0

BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead)

End if

CounterBite=1

End if

Mask=InBuf[InCounter]

Mask=Mask SHL (CounterBite-1)

Mask=Mask OR $FF7F { установка всех битов кроме старшего }

If Mask=$FFFF then UnPakByte(P.P1)

else UnPakByte(P.P0)

end if

end sub

private sub UnPakFile

{ --- распаковка одного файла --- }

BlockRead(OutputF,InBuf,SizeOf(InBuf),NumRead)

ErrorByte=IOResult

ErrorMessage

If NormalWork then ResetUnPakFiles

If NormalWork then

RestoryCodeTable

SortQueueByte

CreateTree { создание дерева частот }

CreateCompressCode

CounterBite=0

OutCounter=0

LengthOutFile=0

Do While LengthOutFile<LengthArcFile

UnPakByte(Root)

BlockWrite(InterF,OutBuf,OutCounter,NumWritten)

DeleteTree

DisposeCodeTable

loop

CloseUnPakFile

End sub

{ ------------------------- main text ------------------------- }

DeleteFile=False

NormalWork=True

ErrorByte=0

ResetArchiv

If NormalWork then

St=ParamStr(1)

Case St[1] of

'a','A'

PakFile

'm','M'

DeleteFile=True

PakFile

'e','E'

UnPakFile

else

end if

CloseArchiv

End sub

Соседние файлы в папке Самостоятельная работа

#
26.03.201590.62 Кб13Алгоритм перебора Бойера.doc
#
26.03.2015130.05 Кб14Лекция 2_2_1 Списки+.doc
#
26.03.2015498.69 Кб21Лекция 2_3. Рекурсия.doc
#
26.03.2015359.94 Кб16Лекция 2_4. Сортировка.doc
#
26.03.2015231.42 Кб21Лекция 2_7. Поиск.doc
#
26.03.20152.41 Mб19Лекция 2_9. Хеширование.doc