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


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

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


я бы делал так:


const
n = 10;

type
TArray = array [1..10] of Integer;

function DigitsCount(const value: Integer): Byte;
var
count: Byte;
_value: Integer;
begin
_value := value;
count := 1;
while _value > 0 do begin
inc(count);
_value := _value div 10;
end;

DigitsCount := count;
end;

procedure QSort(var arr: TArray);
var
i, j, T: Integer;
begin
for i := n downto 2 do
for j := 1 to i - 1 do
if not(DigitsCount(arr[j]) <= DigitsCount(arr[j + 1])) then begin
T := arr[j]; arr[j] := arr[j + 1]; arr[j + 1] := T;
end;
end;

var
X: TArray = ( 12345, 2, 42, 1123, 0, 323, 1123, 23, 3, 4);
i: Integer;

begin
clrscr;
QSort(X);
for i := 1 to n do writeln(X[i]);
end.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Зачем тебе целых 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?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Помощник капитана
****

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

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


deleted

Сообщение отредактировано: Артемий -


--------------------
Dum spiro spero!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

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


smile.gif volvo, программы получились практически идентичные у нас, но в твоей функция подсчета цифр в числе для числа 0 дает результат 0, в принципе на правильность выполнения программы это не повлияет, но может повлечь больше лишних перестановок (в случае наличия большого количества нулей и чисел от 1 до 9 в массиве).


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






smile.gif Зато (побочный эффект) все нули гарантированно будут в конце отсортированного массива...
 К началу страницы 
+ Ответить 

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

 





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