Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.09.2012, 11:34   #1
suigintou
 
Регистрация: 30.09.2012
Сообщений: 9
По умолчанию Упорядочить последовательность чисел по трем условиям

Помогите решить такую задачу, я слабо представляю алгоритм ее решения. Надо составить блок-схему алгоритма, а затем написать на паскале.

Цитата:
1. Начертить блок-схему алгоритма.
Ввести последовательность натуральных чисел {Aj}j=1...n. >Упорядочить последовательность по невозрастанию первой цифры числа, числа с одинаковыми первыми цифрами дополнительно упорядочить по невозрастанию суммы цифр числа, числа с одинаковыми первыми цифрами и одинаковыми суммами цифр дополнительно упорядочить по невозрастанию самого числа.
Я так понимаю, массив надо обрабатывать в несколько раундов.
1) Сначала в цикле упорядочить по невозрастанию первой цифры числа.
2) Потом снова просмотреть весь массив, и элементы с одинаковыми первыми цифрами упорядочить по невозрастанию суммы цифр числа.
3) Снова просмотреть весь массив, числа с одинаковыми первыми цифрами и одинаковыми суммами цифр дополнительно упорядочить по невозрастанию самого числа.

На получается слишком много проходов по массиву и сравнений. Можно ли как-то оптимизировать сортировку с кучей таких условий? Все это сделать в одном цикле, например?
suigintou вне форума Ответить с цитированием
Старый 30.09.2012, 14:40   #2
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

Цитата:
Сообщение от suigintou Посмотреть сообщение
Все это сделать в одном цикле, например?
Конечно, нужно делать все в одном цикле. Зачем делать поэтапную сортировку? Какой смысл?

сравниваем А и В
if (первые цифры не равны ) then ставим в нужном порядке
else if (суммы не равны) then ставим в нужном порядке
else if (числа не равны) then ставим в нужном порядке
else все равно как ставить )))
Предпочитаю на "ты".
TinMan вне форума Ответить с цитированием
Старый 30.09.2012, 16:12   #3
suigintou
 
Регистрация: 30.09.2012
Сообщений: 9
По умолчанию

Цитата:
Сообщение от TinMan Посмотреть сообщение
Конечно, нужно делать все в одном цикле. Зачем делать поэтапную сортировку? Какой смысл?

сравниваем А и В
if (первые цифры не равны ) then ставим в нужном порядке
else if (суммы не равны) then ставим в нужном порядке
else if (числа не равны) then ставим в нужном порядке
else все равно как ставить )))
Попробую с этим разобраться.

Цитата:
if (первые цифры не равны ) then ставим в нужном порядке
Вроде бы, здесь выполняется упорядочивание по невозрастанию первой цифры числа? Потому что нигде больше не вижу проверку на невозрастание.
Но тогда где упорядочивание при равных первых цифрах? При этом утверждение "у чисел равная первая цифра" подходит и под условие "первая цифра не возрастает", а друг за другом блоки кода в каждом ответвлении if-else выполняться не могут. То есть выполнится либо один блок, либо другой.
Слабо понимаю, как твой код реализует проверку всех этих условий...
А еще вот тут какая-то странная функция greater, можешь объяснить, что она делает?
suigintou вне форума Ответить с цитированием
Старый 30.09.2012, 16:33   #4
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Цитата:
а друг за другом блоки кода в каждом ответвлении if-else выполняться не могут
Как раз наоборот, такая конструкция будет выполняться последовательно.
if (первые цифры не равны ) then ставим в нужном порядке
else {сюда попадаем, если первые цифры равны} if (суммы не равны) then ставим в нужном порядке
else {сюда попадаем, если первые цифры равны и суммы равны} if (числа не равны) then ставим в нужном порядке
else все равно как ставить )))

В коде по ссылке как раз и задается условие для перестановки 2 чисел, просто в виде логического выражения.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Старый 30.09.2012, 17:49   #5
suigintou
 
Регистрация: 30.09.2012
Сообщений: 9
По умолчанию

Написал вот такой код:

Код:
  program main;

  var
    n, i, j: Integer;
    arr: array[1..100] of Integer;
    
  function firstDigit(a:Integer):Integer;
    Begin
      while (a>9) do
        Begin
          a:=a div 10;
        End;
      firstDigit:=a;
    End;
    
  function productDigits(a:Integer):Integer;
    var
      product:Integer := 1;
    Begin
      while (a>9) do
        Begin
          product:=product*(a mod 10);
          a:= a div 10;
          a:=a
        End;
      product:=product*a;
      productDigits:=product;
    End;
  
  function summary(a:Integer):Integer;
  var temp:Integer:= 0;
    Begin
      while (a>9) do
        Begin
          temp:=temp + (a div 10);
          a:= a div 10;
        End;
      summary:=temp;
    End;
  
  procedure swap(a, b:Integer);
    var temp:Integer;
    Begin
      temp:=a;
      a:=b;
      b:=temp;
    End;
  
  Begin
    writeln('Enter n:');
    read(n);
    writeln('Enter ', n, ' numbers:');
    for i:=1 to n do
      Begin
        read(arr[i]);
      End;
    write('You have entered:');
    for i:=1 to n do
      Begin
        write(arr[i], ' ');
      End;
      
    for i:=1 to n do
      Begin
        if (firstDigit(arr[i]) <> firstDigit(arr[i+1])) then swap(arr[i],arr[i+1])
        else if (summary(arr[i]) <> summary(arr[i+1])) then swap(arr[i], arr[i+1])
        else if (arr[i] <> arr[i+1]) then swap(arr[i], arr[i+1]);
      End;
    
    writeln('Sorted array: ');
    for i:=1 to n do
      Begin
        write(arr[i], ' ');
      End;
  End.
Но почему-то последовательность выводится в таком же порядке, в каком вводил ее.
suigintou вне форума Ответить с цитированием
Старый 30.09.2012, 17:54   #6
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Из бросающегося в глаза:
Код:
procedure swap(var a, b:Integer);
var
temp:Integer;
Begin
    temp:=a;
    a:=b;
    b:=temp;
End;
Да и сортировка какая-то странная - одного прохода по массиву точно не хватит для полной сортировки в общем случае.

Да и само условие сортировки задано не до конца верно - если первые цифры не равны, то менять местами нужно только в случае, если первая цифра первого числа меньше первой цифры второго и т.д.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )

Последний раз редактировалось BDA; 30.09.2012 в 17:58.
BDA вне форума Ответить с цитированием
Старый 30.09.2012, 18:16   #7
suigintou
 
Регистрация: 30.09.2012
Сообщений: 9
По умолчанию

А что не так с процедурой swap? Сейчас попробовал ею поменять местами 2 первых элемента, но ничего не произошло. Массивы что ли передаются не по указателю, и изменение значений в процедуре ничего не дает?
А, заметил, добавил var
То есть код должен быть таким?
Код:
  program main;

  var
    n, i: Integer;
    arr: array[1..100] of Integer;
    
  function firstDigit(a:Integer):Integer;
    Begin
      while (a>9) do
        Begin
          a:=a div 10;
        End;
      firstDigit:=a;
    End;
    
  function productDigits(a:Integer):Integer;
    var
      product:Integer := 1;
    Begin
      while (a>9) do
        Begin
          product:=product*(a mod 10);
          a:= a div 10;
          a:=a
        End;
      product:=product*a;
      productDigits:=product;
    End;
  
  function summary(a:Integer):Integer;
  var temp:Integer:= 0;
    Begin
      while (a>9) do
        Begin
          temp:=temp + (a div 10);
          a:= a div 10;
        End;
      summary:=temp;
    End;
  
  procedure swap(var a, b:Integer);
    var temp:Integer;
    Begin
      temp:=a;
      a:=b;
      b:=temp;
    End;
  
  Begin
    writeln('Enter n:');
    read(n);
    writeln('Enter ', n, ' numbers:');
    for i:=1 to n do
      Begin
        read(arr[i]);
      End;
    writeln('You have entered:');
    for i:=1 to n do
      Begin
        write(arr[i], ' ');
      End;
      
    for i:=1 to n-1 do
      Begin
        if (firstDigit(arr[i]) <> firstDigit(arr[i+1])) then
        if (firstDigit(arr[i]) < firstDigit(arr[i+1])) then swap(arr[i], arr[i+1])
        else if (summary(arr[i]) <> summary(arr[i+1])) then swap (arr[i+1], arr[i])
        else if (arr[i] <> arr[i+1]) then swap (arr[i+1], arr[i]);
      End;
    
    writeln('Sorted array: '); {swap(arr[1], arr[2]);}
    for i:=1 to n do
      Begin
        write(arr[i], ' ');
      End;
  End.
Последовательность 111 222 333 отсортирована как 222 333 111

Последний раз редактировалось suigintou; 30.09.2012 в 18:22.
suigintou вне форума Ответить с цитированием
Старый 30.09.2012, 19:15   #8
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Код:
for i := 1 to n-1 do
for j := i + 1 to n do
if (firstDigit(arr[i]) <> firstDigit(arr[j])) then
begin
    if (firstDigit(arr[i]) < firstDigit(arr[j])) then swap(arr[i], arr[j]);
end else if (summary(arr[i]) <> summary(arr[j])) then 
begin
    if (summary(arr[i]) < summary(arr[j])) then swap (arr[i], arr[j]);
end else if (arr[i] < arr[j]) then swap (arr[i], arr[j]);
Попробуйте так.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Старый 30.09.2012, 19:34   #9
suigintou
 
Регистрация: 30.09.2012
Сообщений: 9
По умолчанию

Большое спасибо, вроде бы работает.
Цитата:
You have entered:
111 222 333 145 111
Sorted array:
333 222 145 111 111
Запощу окончательный исходник, вдруг кому-то пригодится.

Код:
program main;

  var
    n, i, j: Integer;
    arr: array[1..100] of Integer;
    
  function firstDigit(a:Integer):Integer;
    Begin
      while (a>9) do
        Begin
          a:=a div 10;
        End;
      firstDigit:=a;
    End;
    
  function productDigits(a:Integer):Integer;
    var
      product:Integer := 1;
    Begin
      while (a>9) do
        Begin
          product:=product*(a mod 10);
          a:= a div 10;
          a:=a;
        End;
      product:=product*a;
      productDigits:=product;
    End;
  
  function summary(a:Integer):Integer;
  var temp:Integer:= 0;
    Begin
      while (a>9) do
        Begin
          temp:=temp + (a div 10);
          a:= a div 10;
        End;
      summary:=temp;
    End;
  
  procedure swap(var a, b:Integer);
    var temp:Integer;
    Begin
      temp:=a;
      a:=b;
      b:=temp;
    End;
  
  Begin
    writeln('Enter n:');
    read(n);
    writeln('Enter ', n, ' numbers:');
    for i:=1 to n do
      Begin
        read(arr[i]);
      End;
    writeln('You have entered:');
    for i:=1 to n do
      Begin
        write(arr[i], ' ');
      End;
      
    for i := 1 to n-1 do
      for j := i + 1 to n do
        if (firstDigit(arr[i]) <> firstDigit(arr[j])) then
          begin
            if (firstDigit(arr[i]) < firstDigit(arr[j])) then swap(arr[i], arr[j]);
          end 
        else if (summary(arr[i]) <> summary(arr[j])) then
          begin
              if (summary(arr[i]) < summary(arr[j])) then swap (arr[i], arr[j]);
          end 
        else if (arr[i] < arr[j]) then swap (arr[i], arr[j]);
    
    writeln();
    writeln('Sorted array: ');
    for i:=1 to n do
      Begin
        write(arr[i], ' ');
      End;
    read(n);
  End.
suigintou вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Дана последовательность вещественных чисел. каждая пара чисел задает границы отрезка. Найти количество целых чисел на отрезках 'studentka' Помощь студентам 6 30.11.2011 18:35
последовательность чисел - поиск максимума, второго после максимума значения, количество чисел равных максимуму wasy96 Паскаль, Turbo Pascal, PascalABC.NET 1 28.09.2011 01:19
С\С++ Дана последовательность чисел. Найти количество различных чисел в этой последовательности yuliyayuliya Помощь студентам 1 14.04.2011 06:30
Delphi. найти последовательность всех чисел от 1 до n, кроме чисел с одинаковыми цифрами bayda06 Помощь студентам 7 01.07.2010 18:18
В заданном массиве чисел упорядочить элементы dolya2007 Общие вопросы C/C++ 0 01.05.2009 02:44