IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Сортировка одномерного массива, отсортировать по убыванию кол-ва заданных цифр числа
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской

Репутация: -  0  +


Отсортировать одномерный массив по убыванию количества заданных цифр числа
вот что получилось:

const len=10;
type mymas=array [1..len] of integer;
var A,B,work:mymas; i:integer;

procedure index(m:mymas; var ind:mymas);
var i,j,k:integer;
begin
for i:=1 to len do begin
j:=m[i];k:=0;
while j>0 do begin
k:=k+1;
j:=j div 10;
end;
ind[i]:=k;
end;
end;

procedure doit(m,ind:mymas;var x:mymas);
var k,i,j,max:integer; indx:mymas;
begin indx:=ind;
for i:=1 to len do
for j:=i to len do begin
if (max<indx[i]) then begin max:=indx[i];
k:=j;end;
indx[i]:=ind[k];
indx[k]:=ind[i];
x[i]:=m[k];
end;
end;

begin
for i:=1 to len do
begin
writeln('vvod');
readln(a[i]);
end;

index(A,work);
doit(A,work,B);

for i:=1 to len do
writeln(b[i]);

end.



в искомом массиве получаются одни нули, где ошибка?

Сообщение отредактировано: Zlo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Зачем тебе целых 2 дополнительных массива? Можно же сделать так:

const
len = 10;
type
mymas = array[1 .. len] of integer;

function f(X: integer): integer;
var i: integer;
begin
i := 0;
while X > 0 do begin
inc(i); X := X div 10;
end;
f := i;
end;

procedure sort(var ar: mymas);
var i, j, T: integer;
begin
for i := 1 to len do
for j := len downto i + 1 do
if f(ar[j - 1]) < f(ar[j]) then begin
T := ar[j - 1]; ar[j - 1] := ar[j]; ar[j] := T
end
end;

var i: integer;
const
a: mymas = (
1, 54, 22, 87, 101, 9023, 1165, 373, 590, 5
);

begin
sort(a);
for i := 1 to len do
writeln(a[i]);
end.



По поводу твоей программы: у тебя выход за границы массива. Если бы запускал программу в режиме {$R+}, то увидел бы это... А так - получаешь неправильный результат, и не знаешь, почему... Смотри (процедура do_it):

Цитата
for i:=1 to len do
for j:=i to len do begin
if (max<indx[i]) then begin max:=indx[i];
k:=j;end;
indx[i]:=ind[k]; { <--- Вот тут !!! }
indx[k]:=ind[i];
x[i]:=m[k];
end;

Ну хорошо, если условие приведенное выше выполнилось, то все будет нормально (я имею в виду, не вылетишь за границы), а если нет? Чему тогда равно K?
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 13.09.2025 10:24
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name