Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
36
Добавлен:
28.06.2014
Размер:
7 Кб
Скачать
☆
{¬Ґв®¤ ЄгзЁ}
program LAB1_Zaharov;
uses crt;
type
	  MAS = array [1..500] of integer;
var
	  arr, arr1 : MAS;
	  rez : array [1..2, 2..500] of integer;
	  str : string[1];
	  k,N : integer;
	  j   : 1..3;
	  fin : text;
          fl  : boolean;

{Џа®жҐ¤га  ўлў®¤   ­®¬ «ЁЁ ­  нЄа ­}
procedure Anomaliya (text1, text2 : string; var p_repeat : boolean);
var  p_key : char;
     y : integer;
     i,k : byte;
begin
     clrscr;
     if p_repeat=true then k:=4 else k:=2;
     textcolor(k);
     y:=(82 - 4 - length (text1)) div 2;
     gotoxy (y,10); write ('Й'); for i:=1 to length (text1)+2 do write ('Н'); write ('»');
     gotoxy (y,11); write ('є '); textcolor (k+240); write (text1); textcolor (k); write (' є');
     gotoxy (y,12); write ('И'); for i:=1 to length (text1)+2 do write ('Н'); write ('ј');
     if length(text2)<>0
        then
        begin
             textcolor (8);
             y:=(82 - 8 - length (text2)) div 2;
             gotoxy (y,13); write ('Ъ'); for i:=1 to length (text2)+6 do write ('Д'); write ('ї');
             gotoxy (y,14); write ('і   ',text2,'   і');
             gotoxy (y,15); write ('А'); for i:=1 to length (text2)+6 do write ('Д'); write ('Щ');
        end;
     gotoxy(1,1);
     if p_repeat=true then
     repeat
           sound (400); delay (40000);
           nosound; delay (50000);
     until keypressed
     else  repeat until keypressed;
     k:=1; p_repeat:=true;
     gotoxy (60,20); textcolor (blue); write ('ЪДДДДДДДДДДДї');
     gotoxy (60,23); textcolor (blue); write ('АДДДДДДДДДДДЩ');
     repeat gotoxy (60,21); clreol;
           textcolor (15);
           textbackground (0);
           textcolor (blue); write ('і');
           textcolor (15);
           if k=1 then textbackground(blue) else textbackground(0);
           write (' ЏЋ‚’Ћђ€’њ ');
           textbackground (0);
           textcolor (blue); write ('і');
           textcolor (15);

           gotoxy (60,22); clreol;
           textcolor (15);
           textbackground (0);
           textcolor (blue); write ('і');
           textcolor(15);
           if k=2 then textbackground(blue) else textbackground(0);
           write (' ‡Ђ‚…ђ€’њ ');
           textbackground (0);
           textcolor (blue); write ('і');
           textcolor (15);
           repeat
                 p_key:=readkey;
           until (p_key=chr(72)) or (p_key=chr(80)) or (p_key=chr(13));
           if ((p_key=chr(72)) or (p_key=chr(80))) and (k=1)
              then begin k:=2; p_repeat:=false; end
              else              if ((p_key=chr(72)) or (p_key=chr(80))) and (k=2)
                 then begin k:=1; p_repeat:=true; end
                 else
                 if p_key=chr(13)
                    then k:=3;
    until (k=3);
    clrscr;
end;

Procedure enter (var arr: MAS);
	var
		i: integer;
	begin
	Case j of
	1: 	begin
			writeln ('       і ‚®§а бв ойЁ© ГДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДґ');
			Write(fin, 'VOZRASTAJUSHIY');
			for i:=1 to N do
				arr[i]:=i;
		end;
	2: 	begin
			writeln ('       і  “Ўлў ойЁ©   ГДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДґ');
			Write(fin, 'UBIVAJUSHIY');
			for i:=1 to N do
				arr[i]:=N-i;
		end;
	3: 	begin

			writeln ('       і  ‘«гз ©­л©   ГДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДґ');
			Write(fin, 'SLUCHAYNIY');
			for i:=1 to N do
				arr[i]:=random(N);
		end;
	end;
	Writeln(fin, ' MASSIV');
end;


Procedure analiz;
var ob, obrez, it, itrez, i: integer;
begin
	ob:=2;
	obrez:=rez[2, 2];
	it:=2;
	itrez:=rez[1, 2];
	for i:= 3 to N do
	begin
	     if obrez>rez[2, i]
             then
	     begin
	          obrez:= rez[2, i];
		  ob:=i;
	     end;
	     if itrez > rez[1, i]
             then
	     begin
	          itrez:= rez[1, i];
		  it:=i;
	     end;
	end;
	writeln(fin, 'Naimenshee kolichestvo iteraziy pri k = ', it, ' ravno ', itrez);
	writeln(fin, 'Naimenshee kolichestvo iteraziy pri k = ', ob, ' ravno ', obrez);
  writeln ('       і              і    ',it:3,'     і    ',itrez:4,'    і            і');
  enter (arr);
  writeln ('       і              і    ',ob:3,'     і            і    ',obrez:4,'    і');
  writeln ('       ГДДДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДґ');
end;



procedure Quicksort(k:integer);
	procedure Sort (var arr: MAS; l,r:integer);
		var i,j:integer;
                    x,w:integer;
		begin
			{гбв ­®ўЄ  Ја ­Ёж а §¤Ґ«Ґ­Ёп}
			i:=l;j:=r;
			{ўлЎ®а Ў амҐа  x}
			x:=arr[l+(r-l) div k];
			{а §¤Ґ«Ґ­ЁҐ н«Ґ¬Ґ­в®ў ®в­-­® x}
			repeat
				{Ї®ЁбЄ н«Ґ¬Ґ­в®ў ¤«п ®Ў¬Ґ­ }
				while arr[i]<x do i:=i+1;
				while x<arr[j] do j:=j-1;
				rez[1, k]:=rez[1,k]+1;
				if i<j
                                then
				begin
				     rez[2, k]:=rez[2, k]+1;
				     {®Ў¬Ґ­  [i] Ё a[j] }
				     w:=arr[i]; arr[i]:=arr[j]; arr[j]:=w;
				     i:=i+1; j:=j-1
				end;
				i:=i+1; j:=j-1
			until i>j;
			if l<j then Sort(arr,l,j);
			if i<r then Sort(arr, i,r)
		end;
	begin
		rez[1, k]:=0;
		rez[2, k]:=0;
		Sort(arr1, 1, N);
		writeln(fin, 'Pri k = ', k, ' kolichestvo iteraziy ravno ', rez[1, k], ', a obmenov = ', rez[2, k]);
	end;

begin
     repeat
           clrscr;
           writeln;
           writeln ('                           ‹ Ў®а в®а­ п а Ў®в  # 1');
           writeln ('               Ђ­ «Ё§ нд䥪⨢­®бвЁ ¬Ґв®¤  ў­гв७­Ґ© б®авЁа®ўЄЁ');
           writeln ('                    ¤«п а §­ле д®а¬г« ўлзЁб«Ґ­Ёп Ў амҐа .');
           writeln;
           randomize;
           assign (fin, 'G:\LAB1\LAB1IN.txt');
           rewrite (fin);
           write ('‚ўҐ¤ЁвҐ ¤«Ё­г ¬ ббЁў  > ');
		       readln (N);
	         if (N<=0) or (N>500)
           then
           begin
                fl:=true;
                Anomaliya ('‚­Ё¬ ­ЁҐ, ®иЁЎЄ !!!','„«Ё­  ¬ ббЁў  ¤®«¦­  Ўлвм ­  ®в१ЄҐ [1;500]!',fl);
           end
           else
           begin
	              writeln('‚ ¬ ббЁўҐ ', N, ' н«Ґ¬Ґ­в®ў');
	              writeln;
                writeln ('       ЪДДДДДДДДДДДДДДВДДДДДДДДДДДДВДДДДДДДДДДДДВДДДДДДДДДДДДї');
                writeln ('       і    Њ ббЁў    і      K     і Љ®«ЁзҐбвў® і Љ®«ЁзҐбвў® і');
                writeln ('       і              і            і  ЁвҐа жЁ©  і   ®Ў¬Ґ­®ў  і');
                writeln ('       ГДДДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДЕДДДДДДДДДДДДґ');
	              for j:=1 to 3 do
		            begin

			               {Ѓлбва п б®авЁа®ўЄ }
			               for k:=2 to N do
				             begin
					                arr1:=arr;
					                QuickSort(k);
				             end;
                     analiz;
		            end;
                gotoxy (1,wherey-1);
                clreol;
                writeln ('       АДДДДДДДДДДДДДДБДДДДДДДДДДДДБДДДДДДДДДДДДБДДДДДДДДДДДДЩ');
                readln;
                fl:=false;
                Anomaliya ('Џа®Ја ¬¬  ўлЇ®«­Ґ­  гбЇҐи­®.','',fl);
           end;
    until fl=false;
end.
Соседние файлы в папке LAB1