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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 15.06.2016, 13:51   #11
NikiToZz_
Пользователь
 
Регистрация: 23.04.2016
Сообщений: 75
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
Если я правильно понял, Вы три раза вызываете ТРИ разные процедуры, чтобы сравнить одни и те же массивы? Не приходило в голову, что нужна ОДНА процедура, которая сравнивает ДВА массива и возвращает результат, какой из них больше или возвращает больший из массивов?!
Я вызываю 3 функции по определению наибольшего из массивов. Я попросту не знаю, как сделать это одной функцией. Если бы сравнить нужно было ДВА массива, все было бы гораздо проще! По заданию нужно сравнивать 3 числа - соответственно, 3 массива..

Цитата:
Код:
  assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output);
Не помог мне совет..
NikiToZz_ вне форума Ответить с цитированием
Старый 15.06.2016, 13:56   #12
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Если это acmp.ru - совсем уберите работу с файлами. Это допустимо и удобнее.
FPaul вне форума Ответить с цитированием
Старый 15.06.2016, 14:00   #13
NikiToZz_
Пользователь
 
Регистрация: 23.04.2016
Сообщений: 75
По умолчанию

FPaul, классно)

Я про record и не знал даже..
И вот здесь не допонял
Код:
while not eoln do
В любом случае спасибо за метод)

Тему можно закрывать
NikiToZz_ вне форума Ответить с цитированием
Старый 15.06.2016, 14:07   #14
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

FPaul, у Вас точно чтение работает?
проверил на двух разных компиляторах, результат один и тот же.
попробуйте, что у Вас выдаст при
1000 1001 2000
у меня:
Код:
1000 1001 2000
 10  0
 10  1
 20  0
A<B
Serge_Bliznykov вне форума Ответить с цитированием
Старый 15.06.2016, 15:05   #15
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Точно! Спасибо!
Чтение работает, но некорректен вывод.

А я пробую сдать и получаю WA10.

Хотел скрыть код спойлером, но не вижу BB-code.

Тут можно удалить проверку на лидирующие нули во вводе (ранее делал эту задачу со строками - работало и без этого)
Код:
{$mode fpc}
{$B-}
program LongArithmetic;

const
  MaxLength = 26;
  Base = 10000;
type
  BigIntegerElement = longint;

  BigInteger = record
    Length: integer;
    Value:  array [0..MaxLength - 1] of BigIntegerElement;
  end;
  pBigInteger = ^BigInteger;

  procedure ReadBigInteger(var A: BigInteger);
  var
    ch: char;
    i:  integer;
    Temp: BigIntegerElement;
  begin
    A.Length := 1;
    A.Value[0] := 0;
    while not eoln do
    begin
      Read(ch);
      if ch = ' ' then
        break;
      {обработка очередной цифры}
      {-умножение числа на 10 и добавление новой цифры}
      for i := A.Length - 1 downto 0 do
      begin
        Temp := A.Value[i] * 10;
        A.Value[i] := Temp mod Base;
        Temp := Temp div Base;
        if (i = A.Length - 1) and (Temp > 0) then
        begin
          Inc(A.Length);
          A.Value[i + 1] := 0;
        end;
        A.Value[i + 1] := A.Value[i + 1] + Temp;
      end;
      A.Value[0] := A.Value[0] + Ord(ch) - Ord('0');
    end;
    i := A.Length - 1;
    while (i > 0) and (A.Value[i] = 0) do
      Dec(i);
    A.Length := i + 1;
  end;

  procedure ShowBigInteger(const A: BigInteger);
  var
    i, j: integer;
    s: string;
  begin
    Write(A.Value[A.Length - 1]);
    for i := A.Length - 2 downto 0 do
    begin
      Str(A.Value[i]: 4, s);
      j := 1;
      while (j < 4) and (s[j] = ' ') do
      begin
        s[j] := '0';
        Inc(j);
      end;
      Write(s);
    end;
  end;

  {
  Результат сравнения подобен sign(A-B):
  -1 - если A<B,
   0 - если A=B,
  +1 - если A>B.
  }
  function CompBigInteger(const A, B: BigInteger): integer;
  var
    Res: BigIntegerElement;
    i: integer;
  begin
    {1. Сравниваем длины}
    Res := (A.Length - B.Length);
    if Res = 0 then
    begin
      for i := A.Length - 1 downto 0 do
      begin
        Res := A.Value[i] - B.Value[i];
        if Res <> 0 then
          break;
      end;
    end;
    if Res < 0 then
      Res := -1;
    if Res > 0 then
      Res := 1;
    CompBigInteger := Res;
  end;

  function MaxBigInteger(const A, B: BigInteger): pBigInteger;
  begin
    if CompBigInteger(A, B) > 0 then
      MaxBigInteger := @A
    else
      MaxBigInteger := @B;
  end;

var
  A, B, C: BigInteger;
  Max: pBigInteger;
begin
  ReadBigInteger(A);
  ReadBigInteger(B);
  ReadBigInteger(C);

  Max := MaxBigInteger(A, B);
  Max := MaxBigInteger(Max^, C);

  ShowBigInteger(Max^);
end.

Последний раз редактировалось FPaul; 15.06.2016 в 15:19.
FPaul вне форума Ответить с цитированием
Старый 15.06.2016, 15:26   #16
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

FPaul, подскажите, а Вы видели ссылку на тему на форуме, где есть решение этой задачи? Намного проще и короче.
Насчёт автора этой темы понятно, он хочет добить свой вариант решения и не хочет смотреть на другие алгоритмы (например, эффективное и короткое решение через использование строк). А позвольте полюбопытствовать о ваших мотивах. Вы почему не хотите использовать строки?
по той же самой причине - охота довести своё решение до кондиции? Или по какой-то другой причине?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 15.06.2016, 15:36   #17
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Я уже делал через строки. Это решение сделал из любопытства и для некоторой помощи ТС.

Через строки у меня было такое же решение, только я для результата Max выбирал указатель, чтобы не копировать саму строку.
Я считал строку и разделил на 3 части. Это потеря времени. Более оптимальным был бы вариант по типу ASCIIZ строк, когда пробел заменить на #0 и проводить сравнение без копирования (а в отдельных переменных хранить длины).
Код:
{$H+}
{$mode Delphi}
program acmp_0007_3;

type
  PString = ^string;

  function CompareStr(S1, S2: PString): PString;
  begin
    if length(S1^) = length(S2^) then
    begin
      if S1^ > S2^ then
        CompareStr := S1
      else
        CompareStr := S2;
    end
    else
    begin
      if length(S1^) > length(S2^) then
        CompareStr := S1
      else
        CompareStr := S2;
    end;
  end;

var
  Heap1, Heap2, Heap3: string;
  Indx: integer;
  MaxStr: PString;
begin
  readln(Heap3);

  Indx  := pos(' ', Heap3);
  Heap1 := copy(Heap3, 1, Indx - 1);
  Delete(Heap3, 1, Indx);
  Indx  := pos(' ', Heap3);
  Heap2 := copy(Heap3, 1, Indx - 1);
  Delete(Heap3, 1, Indx);

  MaxStr := CompareStr(@Heap1, @Heap2);
  MaxStr := CompareStr(MaxStr, @Heap3);

  writeln(MaxStr^);
end.
-------------------------------------------------------------
Так без копирования строк (почти без копирования - при выводе результата есть copy).
Но почему-то на сайте нет разницы по времени решения между вариантом с копированием и вариантом без копирования при {$mode Delphi}, но она появляется при {$mode fpc}.
Код:
{$H+}
{$mode fpc}
program acmp_0007_4;

type
  TNumberIntoStr = record
    Start, Length: integer
  end;

  function CompareStr(const S: string; A, B: TNumberIntoStr): TNumberIntoStr;
  var
    i, j: integer;
  begin
    if A.Length = B.Length then
    begin
      CompareStr := A;
      j := B.Start;
      for i := A.Start to A.Start + A.Length - 1 do
      begin
        if s[i] <> s[j] then
        begin
          if s[i] < s[j] then
            CompareStr := B;
          break;
        end;
        Inc(j);
      end;
    end
    else
    begin
      if A.Length > B.Length then
        CompareStr := A
      else
        CompareStr := B;
    end;
  end;

var
  Heap1, Heap2, Heap3, MaxHeap: TNumberIntoStr;
  Indx: integer;
  s: string;
begin
  readln(s);

  Heap1.Start := 1;
  Indx := pos(' ', s);
  Heap1.Length := Indx - Heap1.Start;
  s[Indx] := #0;

  Heap2.Start := Indx + 1;
  Indx := pos(' ', s);
  Heap2.Length := Indx - Heap2.Start;
  s[Indx] := #0;

  Heap3.Start  := Indx + 1;
  Heap3.Length := length(s) - Heap3.Start + 1;

  MaxHeap := CompareStr(s, Heap1, Heap2);
  MaxHeap := CompareStr(s, MaxHeap, Heap3);

  writeln(copy(s, MaxHeap.Start, MaxHeap.Length));
end.

Последний раз редактировалось FPaul; 15.06.2016 в 16:40.
FPaul вне форума Ответить с цитированием
Старый 15.06.2016, 16:52   #18
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

я Вас понял.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 15.06.2016, 17:12   #19
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

Намёк понял - останавливаюсь
FPaul вне форума Ответить с цитированием
Старый 15.06.2016, 17:25   #20
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от FPaul Посмотреть сообщение
Намёк понял - останавливаюсь
да не, я просто понял, что Вы решаете разными способами, именно потому что, есть желание попробовать разные подходы.
Это неплохо.
можете смело продолжать!
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Олимпиадная задача "Золото племени АББА" на Pascal (№7 с acmp.ru) Ghost3 Помощь студентам 19 17.01.2013 21:04
Сравнить две программы. Одну из самых первых и одну из последний coNsept Свободное общение 8 23.03.2012 23:21
Выбрать одну таблицу или много grom333 БД в Delphi 7 12.10.2011 02:51
какой выбрать протокол, если есть сервер в интернете, и клиент должен передать ему команды anyx Работа с сетью в Delphi 3 25.09.2009 23:13
Число N, заменить одну из его цифр, чтобы получилось число, max близкое к некоторой степени двойки urgu_st Помощь студентам 13 23.10.2007 09:14