Skip to content

Instantly share code, notes, and snippets.

@Karasiq
Last active August 29, 2015 14:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Karasiq/11184652 to your computer and use it in GitHub Desktop.
Save Karasiq/11184652 to your computer and use it in GitHub Desktop.
Сортировка по-уебански
program lab;
uses
windows, crt;
label showMassive,showCPUtime,ShowSortResult,sortingstats,showmdlngrsltAve,showmdlngrsltFull,search,1,11,111,1111,112,113,12,121,1211,122,123,13,131,132,133,14,666;
procedure numSorting(scn:integer;a:array of integer;srtdA:array of integer;anum:array of integer;var srtdnum:array of integer);
var i,j,k,povt:integer;
begin
for i:=1 to scn do
begin
povt:=0;
for j:=1 to scn do
begin
if srtdA[i]=a[j] then
begin
srtdnum[i]:=anum[j];
if i>1 then
begin
for k:=1 to i-1 do
if srtdnum[i]=srtdnum[k] then
begin
povt:=1;
break;
end
else
povt:=0;
end;
if povt=1 then
continue;
break;
end;
end;
end;
end;
procedure Sliv(var a:array of integer;p,q : integer;var com1,per1:int64);{процедур слив ющ я м ссивы, p-н ч ло, q-конец}
var r,i,j,k : integer;
b:array[1..10000]of integer;
begin
r:=(p+q) div 2;{делим м ссив}
i:=p;{н ч ло левой половины}
j:=r+1;{н ч ло пр вой половины}
for k:=p to q do{смотрим от н ч л до конц }
begin
com1:=com1+3;
if (i<=r) and ((j>q) or (a[i]<a[j])) then
{перест вляем элементы из половин в новый м ссив, упорядочив я п ры}
begin
per1:=per1+1;
b[k]:=a[i];
i:=i+1;
end
else
begin
per1:=per1+1;
b[k]:=a[j];
j:=j+1;
end ;
end;
for k:=p to q do
begin
per1:=per1+1;
a[k]:=b[k];
end;
end;
{рекурсивн я процедур сортировки, проверяет если ост лось
больше одного элемент , повторяет слияние в левой или пр вой ч стях м ссив }
procedure Sort(var a:array of integer;p,q : integer;var com,per:int64); {p,q - индексы н ч л и конц сортируемой ч сти м ссив }
begin
if p<q then {м ссив из одного элемент триви льно упорядочен}
begin
Sort(a,p,(p+q) div 2,com,per);{сортируем левую половину}
Sort(a,(p+q) div 2 + 1,q,com,per);{пр вую половину}
Sliv(a,p,q,com,per);{слив ем две половины}
end;
end;
var
i,j,k,l:integer; {переменные циклов}
f,e:text; {р бот с текстом}
p1,p11,p12,p13:string; {пункт меню (строковый тип)}
cp1,cp11,cp12,cp13:integer; {пункт меню}
n,CPUn:string; {кол-во потоков/времен проц-р (строковый тип)}
cn,cCPUn:integer; {кол-во потоков/времен проц-р }
c:integer; {"з щит от дур ков"}
MINthrd:integer; {миним льный поток (сортировк выбором)}
MINthrdNUM:integer; {номер миним льного поток (сортировк выбором)}
res,start1,finish1,start2,finish2,start3,finish3:int64; {измерение времени}
permnum1,comparsnum1,permnum2,comparsnum2,permnum3,comparsnum3:int64; {количество перест новок и ср внений}
sthread:array [0..10000]of string; {потоки (строк. тип)}
thread:array [0..10000]of integer; {потоки}
sortedthrd:array [0..10000] of integer; {сортиров нный м ссив потоков}
sortednum:array [0..10000] of integer; {сортиров нный м ссив номеров потоков}
num:array [0..10000]of integer; {номер эл-тов м сив }
cs:array [byte]of integer; {сортировк подсчетом (вспом. м ссив)}
sort3:integer; {проверяет, выполнял сь ли сортировк подсчетом}
sCPUtime:array [0..10000] of string; {времен проц-р (строк. тип)}
CPUtime:array [1..10000]of integer; {времен проц-р }
used:array[1..1000] of integer;
manual:byte;
usedthrds:integer;
ost:integer;
bin:integer;
min,max,mid:integer;
mdldmas,mdldnum:integer;
sumcpu,realsumcpu:integer;
stroka:integer;
found:integer;
begin
sort3:=0;
queryperformancefrequency (res);
1:clrscr;
writeln (' ***OS Thread scheduler Emulator***');
writeln (' Main Menu (Choose point 1-8)');
writeln (' 1.Insert threads');
writeln (' 2.Sorting');
writeln (' 3.Modelling');
writeln (' 4.Exit');
readln (p1);
clrscr;
val (p1,cp1,c);
if c <> 0 then
begin
writeln;
writeln ('ERROR! Insert number from 1 to 8 (Press Enter to back to menu)');
readln;
goto 1;
end;
case cp1 of
1: goto 11;
2: begin
if cn=0 then
begin
clrscr;
writeln ('You must insert threads first');
readln;
goto 1;
end;
goto 13;
end;
3: begin
if cn=0 then
begin
clrscr;
writeln ('You must insert threads first');
readln;
goto 1;
end
else
begin
if sortednum[1]=0 then
begin
clrscr;
writeln ('You must sort theads first');
readln;
goto 1;
end
else
if cCPUn=0 then
begin
clrscr;
writeln ('You must insert CPU times first');
readln;
goto 12;
end;
end;
goto 14;
end;
4: goto 666;
else writeln ('Choose point 1-4 (Enter=Ok)'); readln; goto 1;
end;
11:clrscr;
writeln (' Insert threads');
Writeln (' Choose insert type (1-3)');
writeln (' 1.Manual filling (If number of threads < 20)');
writeln (' 2.Autofilling');
writeln (' 3.From file (Threads.txt)');
writeln (' 4.Back to main menu');
readln (p11);
clrscr;
val (p11,cp11,c);
if c <> 0 then
begin
writeln;
writeln ('ERROR! Insert number from 1 to 4 (Press Enter to back to menu)');
readln;
goto 11;
end;
c:=0;
case cp11 of
1:goto 111;
2:goto 112;
3:goto 113;
4: goto 1;
else writeln ('Choose point 1-4 (Enter=Ok)');readln;clrscr;goto 11;
end;
111:clrscr;writeln ('Insert number of threads (1-20)');
readln (n);
clrscr;
val (n,cn,c);
if c <> 0 then
begin
writeln;
writeln ('ERROR! Insert number from 1 to 20 (Press Enter to back to menu)');
readln;
goto 11;
end;
if (cn<1) or (cn>20) then
begin
writeln ('Insert number from 1 to 20 (Enter=Ok)');
readln;
goto 111;
end;
1111:clrscr;
writeln ('Insert threads (Numbers from 0 to 255)');
for i:=1 to cn do
begin
write (i, ' thread: ');
readln (sthread[i]);
val (sthread[i],thread[i],c);
if c<>0 then
begin
clrscr;
writeln;
writeln ('ERROR! Insert number from 0 to 255 (Press enter to back to menu)');
readln;
goto 11;
end;
if (thread[i]<0) or (thread[i]>255) then
begin
clrscr;
writeln;
writeln ('Insert number from 0 to 255 (Enter=Ok)');
readln;
goto 1111;
end;
num[i]:=i;
end;
clrscr;
comparsnum1:=0;
comparsnum2:=0;
sort3:=0;
sortednum[1]:=0;
goto showmassive;
112:clrscr;writeln ('Insert number of threads (1-1000)');
readln (n);
clrscr;
val (n,cn,c);
if c<>0 then
begin
writeln;
writeln ('ERROR! Insert number from 1 to 1000 (Press enter to back to menu)');
readln;
goto 11;
end;
if (cn<1) or (cn>1000) then
begin
writeln ('Insert number from 1 to 1000 (Enter=Ok)');
readln;
goto 112;
end;
for i:=1 to cn do
begin
thread[i]:=random(255);
num[i]:=i;
end;
clrscr;
comparsnum1:=0;
comparsnum2:=0;
sort3:=0;
sortednum[1]:=0;
goto showmassive;
113:clrscr;
assign (f,'Threads.txt');
reset (F);
i:=0;
while not eof(f) do
begin
i:=i+1;
num[i]:=i;
read (f,thread[i]);
if (thread[i]<0) or (thread[i]>255) then
begin
clrscr;
writeln;
writeln ('Error! Threads.txt must be filled with numbers from 0 to 255 (Press Enter to back to menu)');
readln;
close (f);
goto 11;
end;
end;
close (f);
cn:=i;
clrscr;
comparsnum1:=0;
comparsnum2:=0;
sort3:=0;
sortednum[1]:=0;
goto showmassive;
12:clrscr;
writeln (' Insert CPU times');
Writeln (' Choose insert type (1-3)');
writeln (' 1.Manual filling (If number of times < 20)');
writeln (' 2.Autofilling');
writeln (' 3.From file (CPUtimes.txt)');
writeln (' 4.Back to main menu');
readln (p12);
clrscr;
val (p12,cp12,c);
if c <> 0 then
begin
writeln;
writeln ('ERROR! Insert number from 1 to 4 (Press Enter to back to menu)');
readln;
goto 12;
end;
case cp12 of
1:goto 121;
2:goto 122;
3:goto 123;
4:goto 1;
else writeln ('Choose point 1-4 (Enter=Ok)');readln;clrscr;goto 12;
end;
121:clrscr; manual:=1;goto 14;
122:clrscr;writeln ('Insert number of CPU times (1-1000)');
readln (CPUn);
clrscr;
val (CPUn,cCPUn,c);
if c<>0 then
begin
writeln;
writeln ('ERROR! Insert number from 1 to 1000 (Press enter to back to menu)');
readln;
goto 12;
end;
if (cCPUn<1) or (cCPUn>1000) then
begin
writeln ('Insert number from 1 to 1000 (Enter=Ok)');
readln;
goto 122;
end;
for i:=1 to cCPUn do
begin
CPUtime[i]:=random(255)+1;
end;
clrscr;
goto ShowCPUtime;
123:clrscr;
assign (e,'CPUtimes.txt');
reset (e);
i:=0;
while not eof(e) do
begin
i:=i+1;
read (e,CPUtime[i]);
if (CPUtime[i]<0) or (CPUtime[i]>255) then
begin
clrscr;
writeln;
writeln ('Error! CPUtimes.txt must be filled with numbers from 0 to 255 (Press Enter to back to menu)');
readln;
close (e);
goto 12;
end;
end;
close (e);
cCPUn:=i;
clrscr;
goto showCPUtime;
13:clrscr;
writeln (' Sorting');
writeln (' Choose sorting type');
writeln (' 1.Selection');
writeln (' 2.Merge ');
writeln (' 3.Counting');
writeln (' 4.Back to main menu');
readln (p13);
clrscr;
val (p13,cp13,c);
if c<>0 then
begin
writeln;
writeln ('Error! Insert number from 1 to 4 (Enter=ok)');
readln;
goto 13;
end;
case cp13 of
1: goto 131;
2: goto 132;
3: goto 133;
4: goto 1;
else writeln ('Choose point 1-4 (Enter=ok)'); readln; goto 13;
end;
131:clrscr;
permnum1:=0;
comparsnum1:=0;
write ('Sorting of threads.Please wait... ');
for i:=1 to cn do
begin
sortedthrd[i]:=thread[i];
sortednum[i]:=num[i];
end;
queryperformancecounter (start1);
for i:=1 to cn-1 do
begin
minthrdnum:=i;
minthrd:=sortedthrd[i];
for j:=i+1 to cn do
begin
comparsnum1:=comparsnum1+1;
if sortedthrd[j]<minthrd then
begin
permnum1:=permnum1+1;
minthrdnum:=j;
minthrd:=sortedthrd[j];
sortedthrd[minthrdnum]:=sortedthrd[i];
sortedthrd[i]:=minthrd;
end;
end;
end;
queryperformancecounter (finish1);
write ('ok');
writeln;
write ('Sorting of numbers.Please wait... ');
numsorting(cn,thread,sortedthrd,num,sortednum);
writeln ('ok');
writeln;
writeln ('Press Enter to show sorting statistics');
readln;
goto ShowSortResult;
132:clrscr;
permnum2:=0;
comparsnum2:=0;
write ('Sorting of threads.Please wait... ');
for i:=1 to cn do
begin
sortedthrd[i]:=thread[i];
sortednum[i]:=num[i];
end;
queryperformancecounter (start2);
sort(sortedthrd,1,cn,comparsnum2,permnum2);
queryperformancecounter (finish2);
write ('ok');
writeln;
write ('Sorting of numbers.Please wait... ');
numsorting(cn,thread,sortedthrd,num,sortednum);
writeln ('ok');
writeln;
writeln ('Press Enter to show sorting statistics');
readln;
goto ShowSortResult;
133:clrscr;
sort3:=1;
permnum3:=0;
comparsnum3:=0;
write ('Sorting of threads.Please wait... ');
queryperformancecounter (start3);
for i:=1 to 255 do
cs[i]:=0;
for i:=1 to cn do
begin
cs[thread[i]]:=cs[thread[i]]+1;
sortednum[i]:=num[i];
end;
for i:=1 to 255 do
cs[i]:=cs[i-1]+cs[i];
for i:=cn downto 1 do
begin
permnum3:=permnum3+1;
sortedthrd[cs[thread[i]]]:=thread[i];
cs[thread[i]]:=cs[thread[i]]-1;
end;
queryperformancecounter (finish3);
write ('ok');
writeln;
write ('Sorting of numbers.Please wait... ');
numsorting(cn,thread,sortedthrd,num,sortednum);
writeln ('ok');
writeln;
writeln ('Press Enter to show sorting statistics');
readln;
goto showsortresult;
14:clrscr;
gotoxy(1,1);write ('CPUt');gotoxy(6,1);write ('SumT');gotoxy (12,1);write ('Thrd');gotoxy(18,1);write('No');gotoxy(24,1);write('Res');gotoxy(30,1);write('Attmepts');
for i:=1 to cn do
used[i]:=0;
stroka:=2;
usedthrds:=0;
ost:=0;
i:=0;
while usedthrds<>cn do
begin
i:=i+1;
if manual=0 then
if i>ccpun then
break;
if manual=1 then
begin
gotoxy(1,stroka);read(cputime[i]);
end
else
begin
gotoxy(1,stroka);write(cputime[i]);
end;
realsumcpu:=cputime[i]+ost;
sumcpu:=cputime[i]+ost;
found:=0;
bin:=0;
min:=1;max:=cn;
search:
while (min<=max) and (found=0) do
begin
bin:=bin+1;
mid:=(min+max)div 2;
if sumcpu<sortedthrd[mid] then
max:=mid-1
else
if sumcpu>sortedthrd[mid] then
min:=mid+1
else
if used[mid]=1 then
begin
if mid<>cn then
begin
l:=1;
while sortedthrd[mid+l]=sortedthrd[mid] do
begin
if used[mid+l]<>1 then
begin
mdldmas:=sortedthrd[mid+l];
mdldnum:=sortednum[mid+l];
ost:=realsumcpu-mdldmas;
used[mid+l]:=1;
found:=1;break;
end;
l:=l+1;
if mid+l>cn then break;
end;
end;
if (mid<>1) and (found=0) then
begin
l:=1;
while sortedthrd[mid-l]=sortedthrd[mid] do
begin
if used[mid-l]<>1 then
begin
mdldmas:=sortedthrd[mid-l];
mdldnum:=sortednum[mid-l];
ost:=realsumcpu-mdldmas;
used[mid-l]:=1;
found:=1;break;
end;
l:=l+1;
if mid-l<1 then break;
end;
end;
break;
end
else
begin
mdldmas:=sortedthrd[mid];
mdldnum:=sortednum[mid];
used[mid]:=1;
ost:=realsumcpu-mdldmas;
found:=1;
break;
end;
end;
if (found=0) and (sumcpu>0) then
begin
sumcpu:=sumcpu-1;bin:=0;min:=1;max:=cn;
goto search;
end;
if found=0 then
ost:=realsumcpu
else
begin
gotoxy(6,stroka);write (realsumcpu);gotoxy (12,stroka);write (mdldmas);gotoxy(18,stroka);write(mdldnum);gotoxy(24,stroka);write(ost);gotoxy(30,stroka);write(bin);
stroka:=stroka+1;
end;
if found=1 then
begin
realsumcpu:=ost;
sumcpu:=ost;
found:=0;bin:=0;min:=1;max:=cn;
goto search;
end;
usedthrds:=0;
for j:=1 to cn do
if used[j]=1 then
usedthrds:=usedthrds+1;
end;
writeln;
writeln ('Press ENTER to back to main menu');readln;readln;goto 1;
showsortresult:
clrscr;
writeln ('Original massive of threads');
gotoXY (1,2); writeln ('T');
gotoXY (1,3); writeln ('N');
if cn<16 then
begin
for i:=1 to cn do
begin
gotoXY (5*i,2);
writeln (thread[i]);
gotoXY (5*i,3);
writeln (num[i]);
end;
writeln;
end
else
begin
for i:=1 to 14 do
begin
gotoXY (5*i,2);
writeln (thread[i]);
gotoXY (5*i,3);
writeln (num[i]);
end;
gotoXY (75,2);
writeln ('...');
gotoXY (75,3);
writeln ('...');
writeln;
end;
writeln ('Sorted massive');
gotoXY (1,6); writeln ('T');
gotoXY (1,7); writeln ('N');
if cn<16 then
begin
for i:=1 to cn do
begin
gotoXY (5*i,6);
writeln (sortedthrd[i]);
gotoXY (5*i,7);
writeln (sortednum[i]);
end;
writeln;
end
else
begin
for i:=1 to 14 do
begin
gotoXY (5*i,6);
writeln (sortedthrd[i]);
gotoXY (5*i,7);
writeln (sortednum[i]);
end;
gotoXY (75,6);
writeln ('...');
gotoXY (75,7);
writeln ('...');
writeln;
end;
sortingstats:writeln (' Stats');
Writeln ('1. Selection sort');
if comparsnum1=0 then
begin
writeln (' Sorting of that type has not been performed yet');
end
else
begin
writeln (' number of permutations = ', permnum1);
writeln (' number of comparisons = ', comparsnum1);
writeln (' time spent (sec) : ', (finish1-start1)/res);
end;
Writeln ('2. Merge sort');
if comparsnum2=0 then
begin
writeln (' Sorting of that type has not been performed yet');
end
else
begin
writeln (' number of permutations = ', permnum2);
writeln (' number of comparisons = ', comparsnum2);
writeln (' time spent (sec) : ', (finish2-start2)/res);
end;
Writeln ('3. Counting sort');
if sort3=0 then
begin
writeln (' Sorting of that type has not been performed yet');
end
else
begin
writeln (' number of permutations = ', permnum3);
writeln (' number of comparisons = ', comparsnum3);
writeln (' time spent (sec) : ',(finish3-start3)/res);
end;
writeln;
writeln ('Press enter to back to main menu');
readln;
goto 1;
showCPUtime:
writeln ('CPUtimes');
gotoXY (1,3); writeln ('T');
if cCPUn<16 then
begin
for i:=1 to cCPUn do
begin
gotoXY (5*i,3);
writeln (CPUtime[i]);
end;
writeln;
writeln ('Press Enter to continue');
readln;
goto 14;
end
else
begin
for i:=1 to 14 do
begin
gotoXY (5*i,3);
writeln (CPUtime[i]);
end;
gotoXY (75,3);
writeln ('...');
writeln;
writeln ('Press Enter to continue');
readln;
manual:=0;
goto 14;
end;
showmassive:
writeln (' Threads');
gotoXY (1,3); writeln ('T');
gotoXY (1,4); writeln ('N');
if cn<16 then
begin
for i:=1 to cn do
begin
gotoXY (5*i,3);
writeln (thread[i]);
gotoXY (5*i,4);
writeln (num[i]);
end;
writeln;
writeln ('T-working time , N-number of thread');
writeln;
writeln ('Press Enter to back to main menu');
readln;
goto 1;
end
else
begin
for i:=1 to 14 do
begin
gotoXY (5*i,3);
writeln (thread[i]);
gotoXY (5*i,4);
writeln (num[i]);
end;
gotoXY (75,3);
writeln ('...');
gotoXY (75,4);
writeln ('...');
writeln;
writeln ('T-working time , N-number of thread');
writeln;
writeln ('Press Enter to back to main menu');
readln;
goto 1;
end;
666:end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment