если нет равных элементов, то вывести массив по убыванию последней цифры.
вообще бред какой-то творю
Const
Nmax=10000;
Var
A:Array[1..Nmax] of Integer;
flag:Byte;
i,j,n:integer;
procedure Sort(Var x,y:integer);
Var
tmp:integer;
Begin
tmp:=x;
x:=y;
y:=tmp;
end;
procedure Poisk(x:integer; flag:Byte);
Var
k,y:Byte;
Begin
flag:=1;
y:=x mod 10;
for I := 1 to n-1 do begin
for k := i+1 to n do begin
If a[i]=a[k] Then begin
flag:=0;
Break;
end;
end;
end;
end;
Begin
Writeln('Vvedite dliny posledovatelnosti(n<=10000)');
Read(n);
Writeln('Vvedite posledovatelnost');
flag:=0;
For i:=1 to n Do
Begin
Read(A[i]);
If flag=0 Then
Poisk(A[i],flag);
end;
If flag=1 Then Begin
For i:=1 to n-1 Do Begin
For j:=i+1 to n Do
If (A[i]mod 10)<=(A[j]mod 10) Then
Sort(A[i],A[j]);
end;
end;
For i:=1 to n Do WriteLn(A[i]);
Readln;
Readln;
end.
Побочные эффекты от некорректного использования глобальных переменных... У тебя I в цикле ввода и I в процедуре Poisk - одна переменная. И ведет она себя поэтому непредсказуемо... Объяви локальную переменную I в процедуре, и почти все встанет на свои места (почти - потому, что для того, чтобы определить, не вводился ли уже раньше тот элемент, который был введен только что, достаточно ОДНОГО цикла...)
спасибо.
исправил переменную. но есть еще ошибки, я так подозреваю.
попробую в один цикл.
удалил Y. больше ничего не могу найти T_T
Покажи, что у тебя есть на данный момент...
почти то же самое.
Const
Nmax=10000;
Var
A:Array[1..Nmax] of Integer;
flag:Byte;
i,j,n:integer;
procedure Sort(Var x,y:integer);
Var
tmp:integer;
Begin
tmp:=x;
x:=y;
y:=tmp;
end;
procedure Poisk(x:integer; flag:Byte);
Var
i,k:Byte;
Begin
flag:=1;
for I := 1 to n-1 do begin
for k := i+1 to n do begin
If a[i]=a[k] Then begin
flag:=0;
Break;
end;
end;
end;
end;
Begin
Writeln('Vvedite dliny posledovatelnosti(n<=10000)');
Read(n);
Writeln('Vvedite posledovatelnost');
flag:=0;
For i:=1 to n Do
Begin
Read(A[i]);
If flag=0 Then
Poisk(A[i],flag);
end;
If flag=1 Then Begin
For i:=1 to n-1 Do Begin
For j:=i+1 to n Do
If (A[i]mod 10)<=(A[j]mod 10) Then
Sort(A[i],A[j]);
end;
end;
For i:=1 to n Do WriteLn(A[i]);
Readln;
Readln;
end.
еще предложения есть?
Смотри:
ConstВот так вот...
Nmax=10000;
Var
A:Array[1..Nmax] of Integer;
procedure Sort(Var x,y:integer);
Var
tmp:integer;
Begin
tmp:=x;
x:=y;
y:=tmp;
end;
{
flag должен быть описан как VAR параметр, кроме этого
передаем номер вводимого в данный момент элемента,
чтоб сравнить его со всеми предыдущими
}
procedure Poisk(x, size: integer; var flag: Byte);
var
i: integer;
Begin
flag := 1; { 1 если элемент уже встречался ранее }
for i := 1 to size - 1 do
if a[i] = X then exit;
flag := 0; { 0 если этого элемента еще не было }
end;
{ Переменные описаны здесь, потому что выше они тебе не нужны... }
var
flag:Byte;
i, j, n: integer;
Begin
Writeln('Vvedite dliny posledovatelnosti(n<=10000)');
Readln(n);
Writeln('Vvedite posledovatelnost');
flag:=0;
For i:=1 to n Do
Begin
Readln(A[i]);
If flag=0 Then
Poisk(A[i], i, flag);
end;
If flag=1 Then Begin
For i:=1 to n-1 Do Begin
For j:=i+1 to n Do
If (A[i]mod 10)<=(A[j]mod 10) Then
Sort(A[i],A[j]);
end;
end;
For i:=1 to n Do WriteLn(A[i]);
Readln;
end.
все так просто и понятно
огромное спасибо)
Добавлено через 4 мин.
все равно не работает х_х
If flag=1 Then Begin { <--- здесь }
For i:=1 to n-1 Do Begin
For j:=i+1 to n Do
If (A[i]mod 10)<=(A[j]mod 10) Then
Sort(A[i],A[j]);
end;
end;
оп, извиняюсь)
ну не заметил, бывает)