Длинная арифметика - Помощь студентам - Страница 3

Alexandr67 · 22.11.2013, 12:51

Цитата:

Сообщение от Mad_Cat

опять же "обычно" <> "всегда" и чудеса иногда случаются

Код:

var a, b, s: string;
  K: integer;

function CharToByte(c: char): byte;
begin
  CharToByte := ord(c) - ord('0');
end;

function BytetoChar(c: byte): char;
begin
  BytetoChar := chr(c + ord('0'));
end;

function Summa(x, y: string): string;
var i: integer;
  summ: byte;
  res: string;
begin
  res := '';
  while length(x) < length(y) do
    x := '0' + x;
  while length(y) < length(x) do
    y := '0' + y;
  for i := 1 to length(x) do
    res := res + '0';
  for i := length(x) downto 2 do
  begin
    summ := CharToByte(x[i]) + CharToByte(y[i]) + CharToByte(res[i]);
    res[i] := bytetochar(summ mod 10);
    res[i - 1] := bytetochar(summ div 10);
  end;
  summ := CharToByte(x[1]) + CharToByte(y[1]) + CharToByte(res[1]);
  if summ <= 9 then
    res[1] := bytetochar(summ)
  else begin
    res[1] := bytetochar(summ mod 10);
    res := bytetochar(summ div 10) + res;
  end;
  summa := res;
end;

function MultDigit(x, y: string): string;
var i: integer;
  Mult: byte;
  res: string;
begin
  res := '';
  for i := 1 to length(x) do
    res := res + '0';
  for i := length(x) downto 2 do
  begin
    Mult := CharToByte(x[i]) * CharToByte(y[1]) + CharToByte(res[i]);
    res[i] := bytetochar(Mult mod 10);
    res[i - 1] := bytetochar(Mult div 10);
  end;
  mult := CharToByte(x[1]) * CharToByte(y[1]) + CharToByte(res[1]);
  if mult <= 9 then
    res[1] := bytetochar(mult)
  else begin
    res[1] := bytetochar(mult mod 10);
    res := bytetochar(mult div 10) + res;
  end;
  MultDigit := res;
end;

function MultNumb(x, y: string): string;
var i: integer;
  Mult: byte;
  res: string;
  buf: string;
  tmp: string;
begin
  res := '';
  buf := '';
  for i := length(y) downto 1 do
  begin
    tmp := Multdigit(x, y[i]) + buf;
    res := summa(res, tmp);
    buf := buf + '0';
  end;
  MultNumb := res;
end;

function HighLow(x, y: string): integer;
var k: integer;
begin
  if trim(x) = trim(y) then begin HighLow := 0; exit; end;
  if Length(x) > length(y) then begin HighLow := 1; exit; end
  else
    if Length(y) > length(x) then begin HighLow := -1; exit; end
    else
    begin
      k := 1;
      while (x[k] = y[k]) do inc(k);
      if CharToByte(x[k]) > CharToByte(y[k]) then begin HighLow := 1; exit; end
      else begin HighLow := -1; exit; end
    end;


end;

begin
  write('Input Number:');
  readln(b);
  k := 1;
  s := '1';
  while highlow(s, b) = -1 do begin
    inc(k);
    Str(k, a);
    s := MultNumb(s, a);
  end;
  if highlow(s, b) = 1 then writeln('No Fuck!!!')
  else
    writeln(a, '!=', b);
end.

P.S Не оптимизировал, В лоб, но работает же, а это имхо главное

Он вводил и получил то,что хотел,счастью нет предела,а автора даже не знаю как отблагодарить

ZX Spectrum-128 · 22.11.2013, 12:55

Цитата:

Он вводил и получил то,что хотел,счастью нет предела,а автора даже не знаю как отблагодарить.

Мне очень бы хотелось увидеть препода, вводящего 700 тыщ цифр. Не догадался тихонько на видео снять? Хотя бы начало самое.

А спасителю денежку пошли

Ну или плюсик поставь.
Два. От меня еще.

Mad_Cat · 22.11.2013, 13:01

Цитата:

автора даже не знаю как отблагодарить

Цитата:

денежку пошли

Полностью поддерживаю

Baburek · 22.11.2013, 14:11

Mad_Cat, ты слишком Good_Cat. На тебя плюсами не напасешься :-D

Alexandr67 · 22.11.2013, 21:29

Цитата:

Сообщение от Mad_Cat

опять же "обычно" <> "всегда" и чудеса иногда случаются

Код:

var a, b, s: string;
  K: integer;

function CharToByte(c: char): byte;
begin
  CharToByte := ord(c) - ord('0');
end;

function BytetoChar(c: byte): char;
begin
  BytetoChar := chr(c + ord('0'));
end;

function Summa(x, y: string): string;
var i: integer;
  summ: byte;
  res: string;
begin
  res := '';
  while length(x) < length(y) do
    x := '0' + x;
  while length(y) < length(x) do
    y := '0' + y;
  for i := 1 to length(x) do
    res := res + '0';
  for i := length(x) downto 2 do
  begin
    summ := CharToByte(x[i]) + CharToByte(y[i]) + CharToByte(res[i]);
    res[i] := bytetochar(summ mod 10);
    res[i - 1] := bytetochar(summ div 10);
  end;
  summ := CharToByte(x[1]) + CharToByte(y[1]) + CharToByte(res[1]);
  if summ <= 9 then
    res[1] := bytetochar(summ)
  else begin
    res[1] := bytetochar(summ mod 10);
    res := bytetochar(summ div 10) + res;
  end;
  summa := res;
end;

function MultDigit(x, y: string): string;
var i: integer;
  Mult: byte;
  res: string;
begin
  res := '';
  for i := 1 to length(x) do
    res := res + '0';
  for i := length(x) downto 2 do
  begin
    Mult := CharToByte(x[i]) * CharToByte(y[1]) + CharToByte(res[i]);
    res[i] := bytetochar(Mult mod 10);
    res[i - 1] := bytetochar(Mult div 10);
  end;
  mult := CharToByte(x[1]) * CharToByte(y[1]) + CharToByte(res[1]);
  if mult <= 9 then
    res[1] := bytetochar(mult)
  else begin
    res[1] := bytetochar(mult mod 10);
    res := bytetochar(mult div 10) + res;
  end;
  MultDigit := res;
end;

function MultNumb(x, y: string): string;
var i: integer;
  Mult: byte;
  res: string;
  buf: string;
  tmp: string;
begin
  res := '';
  buf := '';
  for i := length(y) downto 1 do
  begin
    tmp := Multdigit(x, y[i]) + buf;
    res := summa(res, tmp);
    buf := buf + '0';
  end;
  MultNumb := res;
end;

function HighLow(x, y: string): integer;
var k: integer;
begin
  if trim(x) = trim(y) then begin HighLow := 0; exit; end;
  if Length(x) > length(y) then begin HighLow := 1; exit; end
  else
    if Length(y) > length(x) then begin HighLow := -1; exit; end
    else
    begin
      k := 1;
      while (x[k] = y[k]) do inc(k);
      if CharToByte(x[k]) > CharToByte(y[k]) then begin HighLow := 1; exit; end
      else begin HighLow := -1; exit; end
    end;


end;

begin
  write('Input Number:');
  readln(b);
  k := 1;
  s := '1';
  while highlow(s, b) = -1 do begin
    inc(k);
    Str(k, a);
    s := MultNumb(s, a);
  end;
  if highlow(s, b) = 1 then writeln('No Fuck!!!')
  else
    writeln(a, '!=', b);
end.

P.S Не оптимизировал, В лоб, но работает же, а это имхо главное

Вы в ABC писали?Просто мне сказали оформить,я оформлять все это дело начал и турбо не комплирует,жалуется на "trim" как сий бред исправить? и напишите,как с вами связаться напрямую для вознаграждения

Alexandr67 · 22.11.2013, 21:46

Цитата:

Сообщение от Alexandr67

Вы в ABC писали?Просто мне сказали оформить,я оформлять все это дело начал и турбо не комплирует,жалуется на "trim" как сий бред исправить? и напишите,как с вами связаться напрямую для вознаграждения

Отладил в турбо,дописав еще 1 функцию

Mad_Cat · 22.11.2013, 23:34

Цитата:

напишите,как с вами связаться напрямую

все есть в подписи

Mad_Cat · 02.12.2013, 11:23

вот она благодарность(

Цитата:

ты мне задачу про длинную арифметику решал
таки отблагодарить тебя хочется

в общем,все просто
300р при условии,что отладишь программу так,чтобы она работала быстрее
т.к. препод подумав не принял ее,т.к. система наша ее не приняла
по времени не проходит тест,где вводится 10000!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
C# Длинная арифметика	_Varyag_	Помощь студентам	23	21.02.2012 19:33
Длинная арифметика	morgan97	Паскаль, Turbo Pascal, PascalABC.NET	0	04.12.2011 20:03
Длинная арифметика	nervniy	Общие вопросы Delphi	4	19.04.2011 23:18
длинная арифметика	Dimarik	Общие вопросы C/C++	1	16.09.2009 12:02
Длинная арифметика	DmT	Помощь студентам	2	06.10.2007 22:43

22.11.2013, 14:11	#24
Baburek Форумчанин Регистрация: 12.12.2010 Сообщений: 205	Mad_Cat, ты слишком Good_Cat. На тебя плюсами не напасешься :-D