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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 14.06.2016, 19:52   #1
NikiToZz_
Пользователь
 
Регистрация: 23.04.2016
Сообщений: 75
Стрелка Главный вождь племени Абба не умеет считать. В обмен на одну из его земель вождь другого племени предложил ему выбрать одну

Привет, существует задача.. С первого взгляда она простая, но стоит углубиться и возникнут трудности...

Главный вождь племени Абба не умеет считать. В обмен на одну из его земель вождь другого племени предложил ему выбрать одну из трех куч с золотыми монетами. Но вождю племени Абба хочется получить наибольшее количество золотых монет. Помогите вождю сделать правильный выбор!

Входные данные

В первой строке входного файла INPUT.TXT записаны три натуральных числа через пробел. Каждое из чисел не превышает 10100.

Выходные данные

В выходной файл OUTPUT.TXT нужно вывести одно целое число — максимальное количество монет, которые может взять вождь.

Примеры
INPUT.TXT ||||OUTPUT.TXT
1 5 7 3 ||||7
2 987531 234 86364 ||||987531
3 189285 283 4958439238923098349024 ||||4958439238923098349024


===============================

Я попробовал ее решить через процедуры, запоминал числа массивами и выводил так же.. Осталось самое главное сравнение трех массивов, получается. Этого я сделать не смог. ВОт код:


Код:
program zoloto_plemeni_abba;
const MaxDig=1000;
      Osn=10000;
             type TLong=array[1..MaxDig] of integer;
     var Input,Output:text;
       a,b,c,d:TLong;
       procedure ReadLong (Var a:TLong);
       Var ch:char; i:integer;
       begin
         FillChar(A,SizeOf(A),0);
         Repeat
           read(ch);
         Until ch in ['0'..'9'];
         while ch in ['0'..'9'] do
               Begin
                 For i:=A[0] DownTo 1 do
                     Begin
                       a[i+1]:=a[i+1]+(LongInt(A[i])*10) div Osn;
                       a[i]:=(LongInt(A[i])*10) mod Osn;
                     End;
                 a[1]:=a[1]+ord(ch)-ord('0');
                 if a[a[0]+1]>0 then Inc(a[0]);
                 read(ch);
               End;
       end;
       procedure WriteLong(Const A:Tlong);
       var ls,s:string;
         i:integer;
         Begin
           str(osn div 10,ls);
           write(a[a[0]]);
           For i:=A[0]-1 downto 1 do
               Begin
                 Str(A[i],s);
                 While length(s)<length(ls) do
                       s:='0'+s;
                 write(s);
               End;
           writeln;
         end;
begin
  assign(Input,'Input.txt');
  reset(Input);
  ReadLong(a); ReadLong(b); ReadLong(c);
  close(Input);
 { if (a>b) then
     if b>c then d:=a else
       if a>c then d:=a else d:=c    Вот такую штуку провернуть с массивами надо...
       else
         if b>c then d:=b else
           d:=c;}
  assign(Output,'Output.txt');
  rewrite(Output);
  WriteLong(d);
  close(Output);
end.
NikiToZz_ вне форума Ответить с цитированием
Старый 14.06.2016, 20:51   #2
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

В данной задаче именно длинная арифметика не очень-то и нужна.
Т.к. считываешь отдельные символы/цифры в массив. В результате - три массива. Тот что длиннее - тот и больше. А при равной длине - придётся сравнивать поразрядно начиная со старшего.

Современный Pascal (Delphi/FPC/PABC.NET) оперирует со строками значительных размеров. Это я к тому, что можно схалтурить и часть работы по длинной арифметике переложить на Runtime Library - сравнение строк.

Кстати, если идти вашим способом, ввод можно организовать так
Код:
  while not eoln do
  begin
    read(ch);
    if ch=' ' then
      break;
    {обработка очередной цифры}
    ..........................
  end;
И так три раза для каждого из чисел.
FPaul вне форума Ответить с цитированием
Старый 14.06.2016, 21:03   #3
NikiToZz_
Пользователь
 
Регистрация: 23.04.2016
Сообщений: 75
По умолчанию

FPaul, знаете, я тоже хотел идти преобразованием массивов в строки, потом сравнивать длину их. И правильно вы заметили, длина может совпадать. Тогда придется сравнивать по первому символу строки и так далее.. Но на мой взгляд, это не совсем оптимизировано, потому жду лучших вариантов =)
NikiToZz_ вне форума Ответить с цитированием
Старый 14.06.2016, 21:08   #4
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

10100 это 10^100? Дык вполне обычная строка и для турбо паскаля. Нолик впереди не должен быть по идее, как-то натуральность не вяжется с ведущим нулем. Какая строка длиннее, та и победила. При равенстве длин - просто какая больше обычным сравнением. По-разрядное сравнение ни к чему. Даже если очень вдруг нолики впереди - их можно отбросить
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию

Последний раз редактировалось Аватар; 14.06.2016 в 21:10.
Аватар вне форума Ответить с цитированием
Старый 15.06.2016, 00:11   #5
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию


Что было, то и будет; и что делалось, то и будет делаться, и нет ничего нового под солнцем.
Бывает нечто, о чем говорят: "смотри, вот это новое"; но это было уже в веках, бывших прежде нас.
Нет памяти о прежнем; да и о том, что будет, не останется памяти у тех, которые будут после.


Всё уже было:
Олимпиадная задача "Золото племени АББА" на Pascal (№7 с acmp.ru)
Serge_Bliznykov вне форума Ответить с цитированием
Старый 15.06.2016, 12:12   #6
NikiToZz_
Пользователь
 
Регистрация: 23.04.2016
Сообщений: 75
Вопрос

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
Та не хочу я строки... Способ с массивами надежнее. К примеру, число из 400 цифр.. Ето уже не только для этой задачи, это уже просто интерес, как работать с такими числами!

P.S. если не подключать библиотеки, содержащие такие типы и классы)

Последний раз редактировалось NikiToZz_; 15.06.2016 в 12:21.
NikiToZz_ вне форума Ответить с цитированием
Старый 15.06.2016, 12:22   #7
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

10^100 - откуда 400 цифр?
Цитата:
Способ с массивами надежнее
С чего решил? Строка тоже массив и, как выше писали, в современных паскалях нет ограничения 255. Ну а длинная арифметика тоже работает с массивами или строками. Погугли Длинная арифметика паскаль
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 15.06.2016, 13:06   #8
NikiToZz_
Пользователь
 
Регистрация: 23.04.2016
Сообщений: 75
Печаль

Не могу успокоиться =) Доделал программу, сравниваю числа функциями перебора массивов..

Возникает RunError(2) на 95 строке (здесь:
Код:
reset(Input);
), что такое, я не знаю...


Код:
program zoloto_plemeni_abba;
const MaxDig=1000;
      Osn=10000;
             type TLong=array[1..MaxDig] of integer;
     var //Input,Output: file;
       a,b,c,d:TLong;
       procedure ReadLong (Var a:TLong);
       Var ch:char; i:integer;
       begin
         FillChar(A,SizeOf(A),0);
         Repeat
           read(ch);
         Until ch in ['0'..'9'];
         while ch in ['0'..'9'] do
               Begin
                 For i:=A[0] DownTo 1 do
                     Begin
                       a[i+1]:=a[i+1]+(LongInt(A[i])*10) div Osn;
                       a[i]:=(LongInt(A[i])*10) mod Osn;
                     End;
                 a[1]:=a[1]+ord(ch)-ord('0');
                 if A[A[0]+1]>0 then Inc(a[0]);
                 read(ch);
               End;
       end;
       procedure WriteLong(Const A:Tlong);
       var ls,s:string;
         i:integer;
         Begin
           str(osn div 10,ls);
           write(a[a[0]]);
           For i:=A[0]-1 downto 1 do
               Begin
                 Str(A[i],s);
                 While length(s)<length(ls) do
                       s:='0'+s;
                 write(s);
               End;
           writeln;
         end;
         Function MoreA (A,B,C:TLong):Boolean;
         Var i:integer;
           Begin
             If (A[0]<B[0]) and (A[0]<C[0]) then MoreA:=false
             else
               if (A[0]>B[0]) and (A[0]>C[0]) then MoreA:=True
               else
                 if (A[0]=B[0]) and (A[0]=C[0]) then
                 begin
                   i:=A[0];
                   while (i>0) and (A[i]=B[i]) and (A[i]=C[i]) do Dec(i);
                   if i=0 then MoreA:=false
                   else
                     if (A[i]>B[i]) and (A[i]>C[i]) then MoreA:=true
                     else MoreA:=False;
                 end;
           end;
           Function MoreB (A,B,C:TLong):Boolean;
           Var i:integer;
             Begin
               If (B[0]<A[0]) and (B[0]<C[0]) then MoreB:=false
               else
                 if (A[0]<B[0]) and (B[0]>C[0]) then MoreB:=True
                 else
                   if (A[0]=B[0]) and (B[0]=C[0]) then
                   begin
                     i:=B[0];
                     while (i>0) and (A[i]=B[i]) and (B[i]=C[i]) do Dec(i);
                     if i=0 then MoreB:=false
                     else
                       if (A[i]<B[i]) and (B[i]>C[i]) then MoreB:=true
                       else MoreB:=False;
                   end;
             end;
             Function MoreC (A,B,C:TLong):Boolean;
             Var i:integer;
               Begin
                 If (C[0]<B[0]) and (C[0]<A[0]) then MoreC:=false
                 else
                   if (C[0]>B[0]) and (C[0]>A[0]) then MoreC:=True
                   else
                     if (C[0]=B[0]) and (A[0]=C[0]) then
                     begin
                       i:=C[0];
                       while (i>0) and (C[i]=B[i]) and (A[i]=C[i]) do Dec(i);
                       if i=0 then MoreC:=false
                       else
                         if (C[i]>B[i]) and (C[i]>A[i]) then MoreC:=true
                         else MoreC:=False;
                     end;
              end;

begin
 assign(Input,'Input.txt');
  reset(Input);
  ReadLong(a);
  ReadLong(b);
  ReadLong(c);
  close(Input);
  if MoreA(a,b,c)=true then d:=a
     else if MoreB(a,b,c)=true then d:=b
          else if MoreC(a,b,c)=true then d:=c;
  assign(Output,'Output.txt');
  rewrite(Output);
  WriteLong(d);
  close(Output);
end.
Кто разберется, +++ в карму.
NikiToZz_ вне форума Ответить с цитированием
Старый 15.06.2016, 13:42   #9
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

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

а что касается ошибки.
1) проверьте, что Вы нигде не описали переменные Input и Output (если описали - удалите описание этих предопределённых переменных).
2) прямо в начале программы напишите строго так, как рекомендовано в методичке на сайте:
Код:
  assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output);
Serge_Bliznykov вне форума Ответить с цитированием
Старый 15.06.2016, 13:46   #10
FPaul
Форумчанин
 
Регистрация: 25.01.2015
Сообщений: 472
По умолчанию

NikiToZz_, посмотри на такую реализацию.
Я оформил ввод по условию - в строке три числа
Код:
program LongArithmetic;

const
  MaxLength = 100;
  Base = 100;
type
  BigInteger = record
    Length: integer;
    Value:  array [0..MaxLength - 1] of integer;
  end;

  procedure ReadBigInteger(var A: BigInteger);
  var
    ch: char;
    i:  integer;
    Temp: integer;
  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;
  end;

  procedure ShowBigInteger(const A: BigInteger);
  var
    i: integer;
  begin
    for i := A.Length - 1 downto 0 do
      Write(A.Value[i]: 3);
  end;

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

var
  A, B, C: BigInteger;
begin
  ReadBigInteger(A);
  ReadBigInteger(B);
  ReadBigInteger(C);
  ShowBigInteger(A);
  writeln;
  ShowBigInteger(B);
  writeln;
  ShowBigInteger(C);
  writeln;

  case CompBigInteger(A, B) of
    -1: writeln('A<B');
    0: writeln('A=B');
    1: writeln('A>B');
  end;
end.
Такой результат прогона
Код:
12345 12346 56564654654
  1 23 45
  1 23 46
  5 65 64 65 46 54
A<B
При печати числа разделены пробелом чтобы видеть, что они из разных ячеек.

Для решения задачи с acmp.ru во избежании ненужного копирования лучше сравнивать по указателям и возвращать указатель на максимальное число.

Последний раз редактировалось FPaul; 15.06.2016 в 13:51.
FPaul вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 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