Неупорядоченные списки
ФАЛЬШИВАЯ МОНЕТА
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.