Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Документ Microsoft Office Word

.docx
Скачиваний:
10
Добавлен:
07.02.2016
Размер:
33.48 Кб
Скачать

a[j]:=c

end;

p:=0;

while a[p+1].bin[1]='0' do p:=p+1; {p - kil''kist'' vidjemnyh chysel}

if p=1 then b[1]:=a[1];

if p=n-1 then b[n]:=a[n];

k:=h;

while k>=2 do begin

SortVidjem(b,a,k);

SortDodat(b,a,k);

a_or_b:=0;

k:=k-1;

if k>=2 then begin

SortVidjem(a,b,k); SortDodat(a,b,k);

a_or_b:=1;

k:=k-1

end;

end;

Vyvid(a,b);

readln

end.

Пошук Фібоначчі

program FiboSearch;

{$APPTYPE CONSOLE}

uses

SysUtils;

const

n=12;

type

TSpysok=array[1..n] of integer;

Var

K,i:integer;

a:TSpysok;

error:boolean;

porivn:integer;

procedure Vvid(var z:TSpysok);

var sign,i,choice:integer;

begin

Randomize;

writeln('1 - Vypadkovi chysla');

writeln('2 - Vvesty chysla');

readln(choice);

while (choice1) and (choice2) do begin

writeln('!!! Nevirnyj vybir. Vvedit'' 1 abo 2');

readln(choice);

end;

if choice=1 then begin

sign:=1;

for i:=1 to n do begin

a[i]:=Random(1000)*sign;

sign:=-sign;

end;

end

else if choice=2 then begin

writeln('Vvedit'' 12 chysel');

for i:=1 to n do readln(a[i])

end

end;

procedure Sort(var z:TSpysok);

var i,j,x:integer;

begin

for i:=n downto 2 do

for j:=1 to i-1 do

if a[j]>a[j+1] then begin

x:=a[j+1];

a[j+1]:=a[j];

a[j]:=x

end

end;

function Find(z:TSpysok; x:integer):integer;

var i,p,q,p1:integer;

found:boolean;

begin

Find:=0;

error:=false;

found:=false;

i:=8; p:=5; q:=3;

repeat

porivn:=porivn+1;

if xthen

if q0 then begin

i:=i-q;

p1:=p;

p:=q; q:=p1-q

end

else begin

writeln('!Nema takogo elementa v masyvi!');

readln; halt

end

else begin

porivn:=porivn+1;

if x>a[i] then

if p1 then begin

i:=i+q;

p:=p-q; q:=q-p

end

else begin

writeln('!Nema takogo elementa v masyvi.!');

readln; halt

end

else begin

Find:=i;

found:=true

end

end

until found;

end;

begin

porivn:=0;

writeln('*** Poshuk Fibonacci ***');

Vvid(a);

Sort(a);

writeln('

Vhidna poslidovnist''');

for i:=1 to n do writeln(i,')

',a[i]);

write('Vvedit'' element, jakyy treba znaity: ');

readln(K);

writeln('Poriadkovyi nomer chysla ',K,': ',Find(a,K),'.');

writeln('Kil''kist'' porivnian'' : ',porivn,'.');

readln

end.

Додаток 3.

Обчислення арифметичного виразу, записаного у префіксній формі.

program spysok_masyv;

{$APPTYPE CONSOLE}

uses SysUtils, A_list;

begin

Init(L);

writeln('** Obchyslennia vyrazy, zapysanogo v prefiksnij formi **');

Vvid(L,Free,Space);

writeln('** Rezultat obchyslennia : ',PrefixCalculate(L):10:4,'**');

readln

end.

unit A_List;

interface

const N=100;

type

IndexType=0..N;

InfoType=real;

ElemType=record

typ:boolean;

num:InfoType;

znak:char;

next:IndexType;

end;

ListType=IndexType;

SpaceType=array [0..N] of ElemType;

var L:ListType;

Free:IndexType;

Space:SpaceType;

procedure Init (var L:ListType);

function Empty (L:ListType):boolean;

function Full (L:ListType):boolean;

function FindLast (L:ListType):IndexType;

function FindBefore (L:ListType; K:IndexType):IndexType;

procedure Delete (var L:ListType;K:IndexType);

procedure AddElem (var L:ListType; t:boolean; x:InfoType; c:char);

procedure Vvid(var L:ListType;var Free:IndexType;var Space:SpaceType);

function PrefixCalculate (L:ListType):real;

implementation

procedure Init (var L:ListType);

var i:IndexType;

begin

for i:=1 to N-1 do space[i].Next:=i+1;

Space[0].next:=0;

Space[N].next:=0;

L:=0;

Free:=1

end;

function Empty (L:ListType):boolean;

begin

Empty:=L=0

end;

function Full (L:ListType):boolean;

begin

Full:=Free=0

end;

function FindLast (L:ListType):IndexType;

var i:IndexType;

begin

i:=L;

while Space[i].Next0 do i:=space[i].Next;

FindLast:=i

end;

function FindBefore (L:ListType; K:IndexType):IndexType;

var i:IndexType;

begin

i:=L;

FindBefore:=0;

while Space[i].NextK do i:=Space[i].Next;

FindBefore:=i

end;

procedure Delete (var L:ListType;K:IndexType);

var i,j:IndexType;

begin

i:=K;

if Space[i].Next=0

then begin

j:=FindBefore(L,i); Space[j].Next:=0;

end

else begin

j:=Space[i].Next;

Space[i]:=Space[j]; i:=j;

end;

Space[FindLast(Free)].Next:=i;

Space[i].Next:=0

end;

procedure AddElem (var L:ListType; t:boolean; x:InfoType; c:char);

var i,j:IndexType;

begin

if not Full(L) then begin

i:=Free;

Free:=Space[Free].next;

space[i].typ:=t; space[i].num:=x; space[i].znak:=c;

space[i].next:=0;

j:=FindLast(L);

space[j].Next:=i;

end

else writeln('Error: List is Full')

end;

procedure Vvid(var L:ListType;var Free:IndexType;var Space:SpaceType);

var i:integer; s:string; x:InfoType;

begin

writeln('- Vvedit vyraz v prefiksnij formi, natyskajuchy "Enter"');

writeln('

pislia kozhnogo operatora ta operanda');

writeln('

(dlia zakinchennia vvodu vyraza vvedit'' q)');

repeat

readln(s);

if (s[1]='+')or(s[1]='-')or(s[1]='*')or(s[1]='/')or(s[1]='.')

or(s[1]='1')or(s[1]='2')or(s[1]='3')or(s[1]='4')or(s[1]='5')

or(s[1]='6')or(s[1]='7')or(s[1]='8')or(s[1]='9')or(s[1]='0')

then if (s[1]='+')or(s[1]='-')or(s[1]='*')or(s[1]='/')

then AddElem(L,true,0,s[1])

else begin

Val(s,x,i); AddElem(L,false,x,' ');

end

else if s[1]='q'

then writeln('- vvid zakincheno')

until s[1]='q';

end;

function PrefixCalculate (L:ListType):real;

var i,j:IndexType;

z:char;

calc:0..2;

a:array[1..2] of InfoType;

begin

PrefixCalculate:=0;

calc:=0;

z:=' ';

while FindLast(L)>1 do begin

i:=L;

repeat

i:=Space[i].next;

if Space[i].typ=true

then begin

calc:=0;

z:=Space[i].znak

end

else begin

calc:=calc+1; a[calc]:=Space[i].num

end;

until calc=2;

j:=FindBefore(L,i);

Delete(L,i);

i:=FindBefore(L,j);

Delete(L,j);

Space[i].typ:=false;

Space[i].znak:=' ';

case z of

'+': Space[i].num:=a[1]+a[2];

'-': Space[i].num:=a[1]-a[2];

'*': Space[i].num:=a[1]*a[2];

'/': Space[i].num:=a[1]/a[2];

end;

end;

i:=Space[L].next;

if Space[i].next=0

then PrefixCalculate:=Space[i].num

else writeln('Error - je > 1 elem')

end;

end.

Ключові слова:

Курсова робота , Структури даних та алгоритми

Коментарі

Залишити коментар »

Ви не можете залишити коментар.

Для цього, будь ласка, увійдіть або зареєструйтесь.

Завантаження файлу

поділитись

Стань активним учасником руху antibotan!

Поділись актуальною інформацією,

детальніше

і отримай привілеї у користуванні архівом! детальніше

Вхід

увійти

реєстрація

забули пароль?

запам'ятати мене

Партнери сайту

© 2012 antibotan.com - Навчатись легко!