НЕУПОРЯДОЧЕННЫЕ СПИСКИ

ФАЛЬШИВАЯ МОНЕТА

unit Unit1;

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm1 = class(TForm)

Memo1: TMemo;

Button1: TButton;

Button3: TButton;

procedure Button1Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

Type

Ti=Integer;

TR=Real;

Ts=String;

Tbl=Boolean;

Tm=Array[1..1500,1..2] of Ti;

 

Var // вводим все переменные

Form1: TForm1;

M1:Tm;

ost,i,nn,ny, N1,N2,N3,N4,N5,N6,Nx,Nk,nn3,n0:Ti;

S1,S2,S3,s4,l:Ti;

st:Ts;

Fl:Tbl;

implementation

 

{$R *.dfm}

Procedure Wrs(st:ts);

Begin

Form1.Memo1.Lines.Add(St); // вывод в мемо строкового массива

End;

Procedure OstOst(Nk,Ost:ti); // обработка остатка

Begin

If Ost=0 then Fl:=true; // если остаток равен 0 то в нем фальшивой монеты нет

If (Ost=1)and(m1[nk,2]=0) then Begin // остаток равен 1 следовательно в нем фальшивая монета

Fl:=False; st:='Фальшивая монета и номер ее= '+inttostr(nk);

Wrs(st); // вызываем процедуру вывода в мемо

end;

If (Ost=2)then Begin // если остаток равен 2

if (m1[nk,2]<>0)and(m1[nk-1,2]<>0) then Fl:=true // если больше или равен 0 то в остатке фальшивой монеты нет

Else begin

If (m1[nk,2]=0) then st:='Фальшивая монета и номер ее= '+inttostr(nk);

If (m1[nk-1,2]=0) then st:='Фальшивая монета и номер ее= '+inttostr(nk-1);

fl:=False; // проверяем 0, 31 и 32 монету, определяем позицию фальш. монеты

Wrs(st); // вызываем процедуру и выводим в мемо

end;

end;

End;

 

Procedure NMod(nn,nk:ti;Var K,L:ti); // определяем остаток

Begin

K:= (nk-nn+1) Div 3; // целочисленное деление

L:= (nk-nn+1) Mod 3; // деление с остатком

st:='k= '+inttostr(k)+' l= '+inttostr(L); // отправляем число nk, k,l в другую процедуру

wrs(st);

End;

 

Procedure S1S2S3(var s1,s2,s3:ti); // общая сумма монет

Var

I:Ti;

Begin

S1:=0;S2:=0;S3:=0;

For i:=N1 to N2 do

If (M1[i,2]=1) Then Inc(S1); // цикл нахождения фальш.монеты в группе S1

For i:=N3 to N4 do

If (M1[i,2]=1) Then Inc(S2); // цикл нахождения фальш.монеты в группе S2

For i:=N5 to N6 do

If (M1[i,2]=1) Then Inc(S3); // цикл нахождения фальш.монеты в группе S3

End;

Procedure Analiz(s1,s2,s3:ti;Var nn,nk:ti); // последовательность монет

Begin

If (S1<S2)and(s1<s3) Then Begin // определяем номер конца и начала каждой группы монет

NN:=n1;Nk:=N2;

End;

If (S2<S1)and(s2<s3) Then Begin

NN:=n3;Nk:=N4;

end;

If (S3<S1)and(s3<s2) Then Begin

NN:=n5;Nk:=N6;

End;

End;

Procedure n1n6(nn,nk,nn3:ti); // начало и конец каждой части монет

Begin

N1:=NN; N2:=N1+Nn3-1; N3:=N2+1; N4:=N3+Nn3-1;

N5:=N4+1; N6:=N5+Nn3-1; // определяем номера монет

St:=' ';

St:=st+' '+IntToStr(N1)+' '+IntToStr(N2)+' '+

IntToStr(N3)+' '+IntToStr(N4)+' '+IntToStr(N5)+' '+IntToStr(N6); // строковый массив

Wrs(st); //вывод в мемо

End;

 

 

procedure TForm1.Button1Click(Sender: TObject); // кнопка отмены

begin

Close;

end;

procedure TForm1.Button3Click(Sender: TObject); // кнопка старта цикла

Var i:ti;

Begin {mAIN}

Fl:=True;

nk:=strtoint(InputBox('Вводите число монет<=411','Вводите',''));

n0:=strtoint(InputBox('Вводите номер фалтшивой монет<=411','Вводите',''));

For i:=1 to Nk do begin // начало цикла

M1[i,1]:=i;

M1[i,2]:=1;

end;

M1[n0,2]:=0;

NMod(1,nk,nn3,Ost);

OstOst(nk,ost);

n1n6(1,nk,nn3); // вызов определенных процедур

While fl=true Do Begin

S1S2S3(s1,s2,s3);

Analiz(s1,s2,s3,nn,nk);

nx:=nk-nn+1;

If nx=3 then begin

s4:=0;

if m1[nn,2]=0 then ny:=nn;

if m1[nn+1,2]=0 then ny:=nn+1;

if m1[nk,2]=0 then ny:=nk;

st:='Фальшивая монета и номер ее= '+inttostr(ny);

wrs(st); Fl:=False;

end

Else Begin

NMod(nn,nk,nn3,Ost);

OstOst(nk,ost);

n1n6(nn,nk,nn3);

end;

end;

end;

 

 

end

 

ПЕРЕСТАНОВКА

unit Unit1;

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm1 = class(TForm)

Memo1: TMemo;

Button1: TButton;

Button2: TButton;

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

type

Ti=Integer;

Ts=String;

Tbl=Boolean;

Const

Mc:Array[1..7] of ti=(1,2,3,4,5,6,7);

var

Form1: TForm1;

MS:array[1..1000,1..10] Of Ti;

M1,m2,m3:array[1..7] Of Ti;

 

n4,n6, N,n1,n2,n3,nj,ni:ti;

implementation

 

{$R *.dfm}

 

procedure TForm1.Button2Click(Sender: TObject); \\ вызов кнопки «отмена»

begin

Close;

end;

 

procedure TForm1.Button1Click(Sender: TObject); \\ начало процедуры

var

Fl:Tbl;

i2,i3,i,j,j1,j2,j3,j4,j5,jj,j0:ti;

st,st1:ts;

begin

N:=strtoint(inputBox('Введите МАХ число','вводите',''));

nj:=n;

Ni:=1; For j:=n Downto 1 do Ni:=ni*j; {n=4} {5}\\ используем в перестановке 4 числа

N1:=1; For j:=n-1 Downto 1 do N1:=n1*j; {3,2,1} {4,3,2,1}

N2:=1; For j:=n-2 Downto 1 do N2:=n2*j; {2,1} {3,2,1}

N3:=1; For j:=n-3 Downto 1 do N3:=n3*j; {1} {2,1}

n6:=N1 div (n-1);{6}

n4:=N1 div n6; {4}

// расчет 2 столбца

 

for j1:=1 to n do

for i:=1 to n1 do Ms[i+n1*(j1-1),1]:=j1; \\ заполнение первого столбца

i:=0;

for j1:=1 to n do begin

j:=1;

For j3:=1 to N4 do begin

inc(i);

jj:=1; \\ в первом столбце единицы

for j5:=1 to N do

If (ms[i,1]<>mc[j5])then begin m1[jj]:=mc[j5]; inc(jj);end; \\ в массив прячем цифры 2,3,4

 

For j2:=1 to N6 do begin \\ организуем цикл J2=1

i:=j2+N6*(j3-1)+N1*(j1-1);

Ms[i,2]:=m1[j3{j}]; \\ присваиваем 2,3,4

end; inc(j);

{end; }

 

end; {j3}

end; {j1}

// расчет третьего столбца

 

n2:= n6 div (n-2); \\ нужно число 2,3

n3:= n6 div n2; i:=0;

for j1:=1 to n do begin //////

For j3:=1 to n4 do begin

inc(i); jj:=1;

for j5:=1 to N do

If (ms[i,1]<>mc[j5])then begin m1[jj]:=mc[j5]; inc(jj);end;

j0:=1;

for j5:=1 to jj do \\ исключаем цифру 2

If (ms[i,2]<>m1[j5])then begin m2[j0]:=m1[j5]; inc(j0);end;

j0:=0;

For j4:=1 to N3 do begin////

inc(j0);

For j2:=1 to N2 do begin //

i:=j2+N2*(j4-1)+(n2*n3)*(j3-1)+N1*(j1-1); \\ группа по 2 числа

Ms[i,3]:=m2[j0];

end; //

end;

//// W

end; /////

end; //////

// расчет четвертого столбца

i:=0;

 

While i<=Ni do begin

inc(i); jj:=1;

for j5:=1 to N do

If (ms[i,1]<>mc[j5])then begin m1[jj]:=mc[j5]; inc(jj);end;

j0:=1;

for j5:=1 to jj do

If (ms[i,2]<>m1[j5])then begin m2[j0]:=m1[j5]; inc(j0);end;

jj:=1;

for j5:=1 to j0 do

If (ms[i,3]<>m2[j5])then begin m3[jj]:=m2[j5]; inc(jj);end;

Ms[i,n-1]:=m3[1]; \\ остаются 2 цифры

Ms[i,n]:=m3[2];

Ms[i+1,n-1]:= Ms[i,n];

Ms[i+1,n]:=Ms[i,n-1];

inc(i);

 

end;

//// W

 

st:=' ';

Form1.Memo1.Lines.Add(st); \\ вывод в мемо

for i:=1 to ni do begin

For j:=1 to n do

st:=st+inttostr(ms[i,j]); \\ выводим в строку i,j

Form1.Memo1.Lines.Add(st); \\ вывод в Мемо

st:=' ';

end;

end;

 

end.

 

НЕУПОРЯДОЧЕННЫЕ СПИСКИ

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, StdCtrls;

type

TForm2 = class(TForm)

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

Exit1: TMenuItem;

Memo1: TMemo;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N21: TMenuItem;

N22: TMenuItem;

procedure Exit1Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure N21Click(Sender: TObject);

procedure N22Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

TYPE

TB=BYTE;

Ti=Integer;

Ts=String;

var

Form2: TForm2;

mas:array[1..120,1..3] of Ti;

ms:array[1..120,1..3] of Ti;

nN,row, value, first,prev,ptr:Ti;

ch:char;

N:Ti=0;

implementation

{$R *.dfm}

procedure TForm2.Exit1Click(Sender: TObject);

begin Close;

end;

procedure TForm2.N2Click(Sender: TObject); //меню1-создать список програмно

var i:ti; st:ts;

begin

st:=InputBox('Вводите в пределе 20-30', 'Вводите число элементов', '');

n:=strtoint(st);

For i:=1 to n do Begin

MAS[I,1]:=I;

MAS[I,2]:=I*I;

MAS[I,3]:=I+1;

end;

MAS[n,3]:=0;

mas[n,2]:=n*n;

end;

procedure TForm2.N4Click(Sender: TObject);// меню7- вывод списка

Var

i,j:Ti;

st:ts;

begin

Form2.Memo1.Clear; \\ стирается Мемо1 и организуется цикл

For i:=1 to n do begin \\ количество записей

St:=' ';

For j:=1 to 3 do \\ количество элементов

st:=st+' '+inttostr(Mas[i,j]);

Form2.Memo1.Lines.Add(St); \\ выводим в Мемо

end;end;

procedure TForm2.N3Click(Sender: TObject);//меню2- создать список пользователем

Var

value,i,j,j1,ii:ti;

st:ts;

begin

st:=InputBox('Введите размер Списка','Вводите в пределе <=20', '');

n:= StrToInt(st);

For ii:=1 to n do begin

st:=InputBox('Введите Элемент Списка', 'Вводите в пределе <=1000', '');

value:=strtoint(st);

if ii=1 then begin \\ если ii=1 то

mas[ii,1]:=ii; \\ 1 столбик число единица

mas[ii,2]:=value; \\ 2 столбик значение

mas[ii,3]:=0; \\ 3 столбик ноль

prev:=0; \\ предыдущий номер записи

ptr:=1; \\ текущий номер

end;

if ii>1 then begin

i:=1;

while (value >mas[i,2])and(mas[i,3]<>0) do inc(i);

if mas[i,3]=0 then begin \\ дошли до конца

ptr:=i;

prev:=ptr;

inc(ptr); \\ 11 запись будет номер n

mas[ptr,1]:=n;

mas[ptr,2]:=value;

mas[ptr,3]:=0;

mas[prev,3]:=ptr; end;

if value < mas[i,2] then begin \\ вводим значение не больше существующего

for j:=1 to ii-i do

for j1:=1 to 3 do \\ 3 значения опускаем вниз

mas[ii-j+1,j1]:=mas[ii-j,j1];

mas[i,1]:=i; \\ в освободившееся место помещаем текущий номер

mas[i,2]:=value; \\ само значение

for j:=1 to n-i do begin

mas[ii-j+1,1]:=mas[ii-j,1]+1; \\ перенос значений

mas[ii-j+1,3]:=mas[ii-j,3]+1;

end;

mas[ii,3]:=0;

mas[ii,1]:=n; ptr:=n; \\ заказываем номер

prev:=ptr-1; \\ предыдущее значение

end; end; end;

end;

procedure TForm2.N5Click(Sender: TObject); //меню3- добавить элемент

Var

st:ts;

begin

st:=InputBox('Введите значение', 'Вводите вставляемый элемент ', '');

value:=strtoint(st);

first:=1; \\ чтобы было не больше вводимого

ptr:=first;

prev:=0; \\ предыдущее равно 0

if mas[ptr,3] = 0 then begin

if value<= mas[ptr,2] then begin

n:=2; \\ формируем вторую строку

mas[n,2]:= mas[ptr,2]; \\ во вторую строку перемещаем значение 1-ой строки

mas[ptr,2]:= value; \\ помещаем введенное значение

mas[ptr,3]:= n; \\ в третью строку - вторую

mas[n,1]:= n;

mas[n,3]:= 0;

prev:=n-1; \\ предыдущее стало первым

value:=0; end;

if value> mas[ptr,2]then begin

n:=2;

mas[n,2]:= value;

mas[n,3]:= 0;

mas[ptr,3]:= n;

mas[n,1]:= n;

prev:=n-1; \\ предыдущее значение станет единицей

end;

ptr:= n;

end else begin

while( value >= mas[ptr,2]) do begin

prev:=ptr;

ptr:=mas[ptr,3];

end;

if prev = 0 then begin

mas[prev+1,3]:=n+1;

mas[n+1,2]:=value;

mas[n+1,1]:=n+1;

mas[n+1,3]:=ptr+1;

end;

if prev <>0 then

begin

mas[prev,3]:=n+1;

mas[n+1,2]:=value;

mas[n+1,1]:=n+1;

mas[n+1,3]:=ptr;

end ; inc(n); end;

end;

procedure TForm2.N6Click(Sender: TObject); //меню5- Удалить элемент

var

nn:ti;

st:ts;

begin

prev:=0;

FIRST:=MAS[1,3];

ptr:=FIRST;

st:=InputBox('Введите значение',

'Вводите удаляемый элемент', '');

nn:=strtoint(st);

While ptr <>0 DO begin

if nn=mas[ptr,2] then begin

if prev =0 then first :=mas[ptr,3]

else

mas[prev,3] :=mas[ptr+1,1] ;

end

else prev:=ptr;

ptr:=mas[ptr,3]; end;

end;

procedure TForm2.N21Click(Sender: TObject); // меню4- добавить элемент 2

var st:ts; i:ti;

begin

st:=InputBox('Введите значение',

'Вводите вставляемый элемент ', '');

value:=strtoint(st);

i:=1;

While value >mas[i,2] do inc(i);

If((value>mas[i-1,2] )and(value<mas[i,2])) then begin

inc(n);

mas[n,2]:=value;

mas[n,1]:=n;

mas[i-1,3]:= n; mas[n,3]:= i; end;

end;

procedure TForm2.N22Click(Sender: TObject); // меню 6-удалить элемент 2

Var st:ts; i:ti;

begin

st:=InputBox('Введите значение',

'Вводите удаляемый элемент ', '');

value:=strtoint(st);

i:=1;

While value >mas[i,2] do inc(i);

If (value=mas[i,2] ) then mas[i-1,3]:=mas[i,3];

end;end.

ziyatdinov@001.vt.perm.ru