Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Калькулятор

Автор: RathaR 25.07.2009 20:29

Вот решил написать прогу "калькулятор".
Вчера ночью еще написал функции на "+" и "-", проверил, всё работало железобетонно, но то что писал не сохранилось злой рок и електричество...
Начал сегодня писать, вроде написал снова на + и -, плюс работает, но с минусом возникла какаято проблема которую я просто немогу осознать
Вот код:


program Kalkyl;

uses Crt;

var
        A,B,rez:string;

        S1,S2:string;

        C:char;

        E_e:char;

        Dalee:boolean;


function Suma(A,B:string):string;                   <============ работает правильно

var
       I,sub:integer;

       L1,L2:integer;

       S1,S2,S3:string;

begin

S1:=A;

S2:=B;

L1:=Length(S1);

L2:=Length(S2);

For I:=L2 to L1 do

  insert('0',S2,1);

insert('0',S1,1);


S3:='';

Sub:=0;

For I:=L1+1 downto 1 do

  If (ORD(S1[I])-48+ORD(S2[I])-48+sub)>9 then begin

                                                S3:=CHR(ORD(S1[I])+ORD(S2[I])-48+sub-10)+S3;

                                                sub:=1;

                                                end

                                         else

                                                begin

                                                 S3:=CHR(ORD(S1[I])+ORD(S2[I])-48+sub)+S3;

                                                 sub:=0;

                                                end;

if S3[1]='0' then delete(S3,1,1);

Suma:=S3;

end;

function Raznica(A,B:string):string;                              <==========работает неправильно

var
       I,sub:integer;

       L1,L2:integer;

       S1,S2,S3:string;

begin

S1:=A;

S2:=B;

L1:=Length(S1);

L2:=Length(S2);

for I:=L2 to L1 do

  insert('0',S2,1);

insert('0',S1,1);


S3:='';

Sub:=0;

For I:=L1+1 downto 1 do

  If (ORD(S1[I])-48-ORD(S2[I])-48-sub)<0 then begin

                                                S3:=CHR(ORD(S1[I])-ORD(S2[I])-sub+10+48)+S3;

                                                sub:=1;

                                                end

                                         else
                                                begin

                                                 S3:=CHR(ORD(S1[I])-ORD(S2[I])+48-sub)+S3;

                                                 sub:=0;

                                                end;

if S3[1]='0' then delete(S3,1,1);

Raznica:=S3;

end;

procedure Logo;

begin

clrscr;

gotoxy(15,1);

textcolor(lightblue);

Writeln('Калькулятор');

gotoxy(15,2);

textcolor(white);

end;

function Opr_d(C:char):string;

begin

case C of

        '+':Opr_d:='сложение';
        '-':Opr_d:='вычитание';
        '*':Opr_d:='произведение';
        '/':Opr_d:='деление'

        else Opr_d:='Некоректные данные';
end;

end;

procedure Vvod;

begin

gotoxy(2,6);

writeln('Введите первое число и нажмите "Enter".');

gotoxy(2,8);

textcolor(red);

write('Первое число: ');

textcolor(white);

readln(A);

gotoxy(2,10);

write('Введите необходимое действие и нажмите "Enter: ');

readln©;

gotoxy(2,12);

textcolor(red);

write('Необходимо выполнить : ');

textcolor(white);

write(Opr_d©);

gotoxy(2,14);

writeln('Введите второе число и нажмите "Enter"');

gotoxy(2,16);

textcolor(red);

write('Второе число: ');

textcolor(white);

readln(B);

end;

procedure Rezultat;

begin

case C of

        '+':rez:=Suma(A,B);

        '-':rez:=Raznica(A,B);
end;

gotoxy(10,20);

writeln('Решение: ');

write(A,' ',C,' ',B,' = ',rez);

end;

BEGIN

logo;

gotoxy(2,4);

write('Нажмите  "Enter" чтобы продолжить, или "Escape" чтобы выйти');

Dalee:=false;

while Dalee=false do

begin

E_e:=readkey;

if E_e=chr(27) then exit;

if E_e=char(13)then Dalee:=true;

delline;

end;

Vvod;

Rezultat;

readln;

END.

помогите найти ошибку в функции Raznica

и еще... я когда запускаю программу прямо с Fpc 2.2.2. то сначала всё что на екране пишет иероглифами, а после первого нажатия - нормально, а после последнего нажатия, когда должно вывести результат, выводит результат и снова всё слова становятся иероглифами, причом происходит это только в полноекранном режиме, если в окне всё норм, и когда запускаю програму с ексешника, в окне, тоже всё норм

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

Автор: volvo 26.07.2009 1:04

Цитата

помогите найти ошибку в функции Raznica

Как минимум - нужно

Цитата

  If (ORD(S1[I])-48-ORD(S2[I])-48-sub)<0 then begin

заменить на более правильный вариант:

  If ((ORD(S1[I])-48)-(ORD(S2[I])-48)-sub)<0 then begin

Если теперь открыть скобки, то увидишь, что перед вторым числом 48 будет плюс, а не минус, как у тебя... Но я бы оставил именно в скобках.

Цитата

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

Программу надо для начала нормально отформатировать, чтобы ее можно было читать. То, что ты привел - нечитаемо абсолютно. Где отступы? Зачем пустые строки? Зачем оформление, перемешанное с логикой? Сначала отладь логику, потом добавляй "рюшечки".

Автор: RathaR 26.07.2009 2:00

Цитата(volvo @ 25.07.2009 21:04)

Как минимум - нужно
заменить на более правильный вариант:

  If ((ORD(S1[I])-48)-(ORD(S2[I])-48)-sub)<0 then begin

действительно

исправил, работает

Цитата(volvo @ 25.07.2009 21:04)

пустые строки ставлю когда во FPC работаю... без них мне текст кажется слишком слитным... ну, плохие привычки еще практика исправит

И возник еще один вопрос, на этот раз по поводу умножения...
Я думаю следующим образом:
в функцию Proizvedenie передаю две строки - числа, функция записывает их следующим образом:
0125
0025
затем вызываеться функция Syma которая находит сумму 5кратного сумирования большего числа, и результат записываеться в первый елемент масива М, далее функция Syma находит результат 2кратного сумирования числа 125, и записывает его во второй елемент масива М, и тд по розрядам, а после этого к каждому елементу масива М дописываеться еше (І-1) ноль, где І - номер елемента масива М.
А потом все елементы сумируються всё той же функцией.

Но в реализации допустил ошибки, ибо функция Proizvedenie просто вылитает
вот эта функция:

Function Proizvedenie(A,B:string):string;

var
        M:array[1..256] of string;
        I,J,N:integer;
        S1,S2,S3:string;
        L1,L2,L3:integer;

begin

S1:=A;
S2:=B;

L1:=Length(S1);
L2:=Length(S2);

if L1<L2 then begin
              L3:=L1;
              L1:=L2;
              L2:=L3;
              S3:=S1;
              S1:=S2;
              S2:=S3;
              end;
for I:=L2 to L1 do
  insert('0',S2,1);

insert('0',S1,1);
S3:='';
N:=0;

For I:=L1+1 downto 1 do
  begin
  For J:=1 to (ORD(S2[I])-48) do
    M[N]:=Suma(M[N],S1);
    M[N]:=M[N]+O_gen(N-1);
    inc(N);
  end;
For J:=1 to I do
  begin
  S3:=Suma(M[J],S3);
  end;
end;

а эта функция генерирует нужное кол-во нулей которые надо добавить:

function O_gen(K:integer):string;
var
        I:integer;
begin
O_gen:='';
For I:=1 to K do
O_gen:=O_gen+'0';
end;

просидел довольно долго, но полного успеха над умножением так и не удалось добиться...

Автор: volvo 26.07.2009 2:14

Цитата

Но в реализации допустил ошибки, ибо функция Proizvedenie просто вылитает

Во-первых:

function O_gen(K:integer):string;
var
  I:integer;
  s: string;
begin
  s:='';
  For I:=1 to K do s:=s+'0';
  O_gen := s;
end;

, иначе у тебя получается что-то типа рекурсии. Не надо делать непереносимые вещи.

А во-вторых, что, тебе FPC не сообщает, почему программа вылетает? Мне, например, сообщает:

строка №166 выделена. Беглый просмотр дает ответ: при N = 0 - вылет за нижнюю границу массива. Отладчик для кого?

Добавлено через 2 мин.
P.S. Если ты думаешь, что тот цикл, в котором находится выделенная строка, отформатирован правильно - ты ошибаешься. Отформатируй, пока не поздно, как положено. Иначе будут проблемы...

Автор: RathaR 26.07.2009 2:55

Доделал программу, всё работает
volvo большое спасиба за помощь

Автор: RathaR 27.07.2009 0:05

И снова я со всё темеже проблемами, на этот раз там где не ожидал...
Упорно отказываеться работать функция Factorial.

function Factorial(A:string):string;
var
        Fact,K,S,F:string;
begin

S:=A;
if S='1' then Factorial:='1' 
           else
begin
        Fact:='1';
        K:='1';

        Repeat
            Fact:=Proizvedenie(Fact,K);
            K:=Suma(K,'1');
        until K=S;

Factorial:=Fact;
end;
end;

Беглый просмотр показал что Fact:=Proizvedenie(Fact,K); считает неправильно,(1*2=3)хотя функция Proizvedenie сама по себе работает правильно.
Пробовал и

F:=Proizvedenie(Fact,K);
Fact:=F;
K:=Suma(K,'1');

Где ошибка ума не приложу

Автор: volvo 27.07.2009 0:36

Показывай реализацию функции Proizvedenie.

Автор: RathaR 27.07.2009 0:46

Цитата(volvo @ 26.07.2009 20:36)

Показывай реализацию функции Proizvedenie.

Function Proizvedenie(A,B:string):string;

var
        M:array[1..256] of string;
        I,J,N:integer;
        S1,S2,S3:string;
        L1,L2,L3:integer;

begin

S1:=A;
S2:=B;

L1:=Length(S1);
L2:=Length(S2);

if L1<L2 then 
begin
              L3:=L1;
              L1:=L2;
              L2:=L3;

              S3:=S1;
              S1:=S2;
              S2:=S3;
              end;

for I:=L2 to L1 do
  insert('0',S2,1);

insert('0',S1,1);
S3:='';
N:=1;

For I:=L1+1 downto 1 do
  begin

  For J:=1 to (ORD(S2[I])-48) do
    M[N]:=Suma(M[N],S1);

M[N]:=M[N]+O_gen(N-1);
inc(N);
end;

For J:=1 to L1+1 do
  begin
  S3:=Suma(M[J],S3);
  end;
  Proizvedenie:=S3;
end;

Автор: volvo 27.07.2009 0:55

Цитата

функция Proizvedenie сама по себе работает правильно.

Неправда:

  writeln(Proizvedenie('12', '6'));

печатает '00' вместо того, что должно быть напечатано.

Автор: RathaR 27.07.2009 1:16

Цитата(volvo @ 26.07.2009 20:55)

Неправда:

  writeln(Proizvedenie('12', '6'));

печатает '00' вместо того, что должно быть напечатано.

эмм...я запускаю программу(полностью) ввожу 12 и 6, действие - умножение, и результат 72....

Автор: volvo 27.07.2009 1:30

Значит, твоя функция имеет побочный эффект, и, что самое ужасное, работает ТОЛЬКО за счет побочного эффекта. А при работе Factorial этот эффект не проявляется, вот тебе и неправильный результат.

Корректно написанная функция должна выдавать правильный результат и при таком вызове, как я показал.

Автор: RathaR 27.07.2009 1:53

Цитата(volvo @ 26.07.2009 21:30)

эм... я вот только что ввёл эту строку, в параметры указал '6' , '12' и всё правильно сработало...
Наверное я код скопировал неправильный или не весь, вот собственно вся программа, в которой я проверял:

program Kalkyl;
uses Crt;
var
        A,B,rez:string;
        S1,S2:string;
        C:char;
        E_e:char;
        Dalee:boolean;
        V:integer;

{=============================================================}

function O_gen(K:integer):string;

var
        I:integer;
        S:string;

begin

S:='';
For I:=1 to K do
S:=S+'0';
O_gen:=S;
end;

{==========================================================}

function Suma(A,B:string):string;
var
       I,sub:integer;
       L1,L2,L3:integer;
       S1,S2,S3:string;

begin
S1:=A;
S2:=B;

L1:=Length(S1);
L2:=Length(S2);
if L1<L2 then begin

              L3:=L1;
              L1:=L2;
              L2:=L3;

              S3:=S1;
              S1:=S2;
              S2:=S3;
              end;

For I:=L2 to L1 do
  insert('0',S2,1);

insert('0',S1,1);
S3:='';
Sub:=0;
For I:=L1+1 downto 1 do

  If (ORD(S1[I])-48+ORD(S2[I])-48+sub)>9 then begin

                                                S3:=CHR(ORD(S1[I])+ORD(S2[I])-48+sub-10)+S3;
                                                sub:=1;
                                                end
                                         else
                                                begin
                                                 S3:=CHR(ORD(S1[I])+ORD(S2[I])-48+sub)+S3;
                                                 sub:=0;
                                                end;

if S3[1]='0' then
        begin
        delete(S3,1,1);
        If S3[1]='0' then delete(S3,1,1);
        end;
Suma:=S3;
end;

{==================================================}

function Raznica(A,B:string):string;

var
       I,sub:integer;
       L1,L2,L3:integer;
       S1,S2,S3:string;

begin
S1:=A;
S2:=B;
L1:=Length(S1);
L2:=Length(S2);
if L1<L2 then begin

              L3:=L1;
              L1:=L2;
              L2:=L3;

              S3:=S1;
              S1:=S2;
              S2:=S3;

              end;



for I:=L2 to L1 do
  insert('0',S2,1);

insert('0',S1,1);

S3:='';
Sub:=0;

For I:=L1+1 downto 1 do

  If (ORD(S1[I])-48)-(ORD(S2[I])-48-sub)<0 then begin

                                                S3:=CHR(ORD(S1[I])-ORD(S2[I])-sub+10+48)+S3;
                                                sub:=1;
                                                end
                                         else
                                                begin
                                                 S3:=CHR(ORD(S1[I])-ORD(S2[I])+48-sub)+S3;
                                                 sub:=0;
                                                end;

if S3[1]='0' then delete(S3,1,1);
Raznica:=S3;
end;

{==========================================================}

Function Proizvedenie(A,B:string):string;
var
        M:array[1..256] of string;
        I,J,N:integer;
        S1,S2,S3:string;
        L1,L2,L3:integer;

begin
S1:=A;
S2:=B;
L1:=Length(S1);
L2:=Length(S2);

if L1<L2 then begin

              L3:=L1;
              L1:=L2;
              L2:=L3;
              S3:=S1;
              S1:=S2;
              S2:=S3;
              end;



for I:=L2 to L1 do
  insert('0',S2,1);

insert('0',S1,1);

S3:='';
N:=1;

For I:=L1+1 downto 1 do
  begin
  For J:=1 to (ORD(S2[I])-48) do
    M[N]:=Suma(M[N],S1);
    M[N]:=M[N]+O_gen(N-1);
    inc(N);
  end;

For J:=1 to L1+1 do
  begin
  S3:=Suma(M[J],S3);
  end;
  Proizvedenie:=S3;

end;

{===================================================}

function Factorial(A:string):string;
var
        Fact,K,S,F:string;

begin
S:=A;
if S='1' then Factorial:='1' else

begin
        Fact:='1';
        K:='1';
        Repeat
            F:=Proizvedenie(Fact,K);
            Fact:=F;
            K:=Suma(K,'1');
        until K=S;

Factorial:=Fact;
end;
end;
{===================================================}

procedure Logo;
begin
clrscr;
gotoxy(15,1);
textcolor(lightblue);
Writeln(' Љ «мЄг«пв®а');
gotoxy(15,2);
textcolor(white);
end;

{=====================================================}

function Opr_d(C:char):string;

begin

case C of

        '+':Opr_d:='б«®¦ҐЁҐ';
        '-':Opr_d:='ўлзЁв ЁҐ';
        '*':Opr_d:='Їа®Ё§ўҐ¤ҐЁҐ';
        '/':Opr_d:='¤Ґ«ҐЁҐ';
        '!':Opr_d:='д Єв®аЁ « зЁб« '

        else Opr_d:='ЌҐўҐал© § Є, ўбҐ Ї®б«Ґ¤гойЁҐ ¤Ґ©бвўЁп ЎҐбЇ®«Ґ§л!';
end;

end;

{=======================================================}

procedure Vvod;
begin
gotoxy(2,6);
writeln('‚ўҐ¤ЁвҐ ЇҐаў®Ґ зЁб«®, Ё  ¦¬ЁвҐ "Enter".');
gotoxy(2,8);
textcolor(red);
write('ЏҐаў®Ґ зЁб«®: ');
textcolor(white);
readln(A);
gotoxy(2,10);
write('‚ўҐ¤ЁвҐ ¤Ґ©бвўЁҐ Є®в®а®Ґ г¦® ўлЇ®«Ёвм,Ё  ¦¬ЁвҐ "Enter: ');
readln©;
gotoxy(2,12);
textcolor(red);
write('ЌҐ®Ўе®¤Ё¬® ўлЇ®«Ёвм : ');
textcolor(white);
write(Opr_d©);

if Opr_d©<>'д Єв®аЁ « зЁб« ' then

begin
gotoxy(2,14);
writeln('‚ўҐ¤ЁвҐ ўв®а®Ґ зЁб«®, Ё  ¦¬ЁвҐ "Enter"');
gotoxy(2,16);
textcolor(red);
write('‚в®а®Ґ зЁб«®: ');
textcolor(white);
readln(B);

end;

end;

{===========================================================}

procedure Rezultat;
begin
case C of

        '+':rez:=Suma(A,B);

        '-':rez:=Raznica(A,B);

        '*':rez:=Proizvedenie(A,B);

        '!':rez:=Factorial(A);
end;
gotoxy(2,20);
textcolor(red);
writeln('ђҐиҐЁҐ: ');
textcolor(white);
gotoxy(20,22);
write(A,' ',C,' ',B,' = ',rez);
end;

{============================================================}

BEGIN

logo;

gotoxy(2,4);
write('—в®Ўл  з вм а Ў®вг  ¦¬ЁвҐ "Enter", зв®Ўл ўл©вЁ  ¦¬ЁвҐ "Escape"');
Dalee:=false;
while Dalee=false do
  begin
  E_e:=readkey;
  if E_e=chr(27) then exit;
  if E_e=char(13)then Dalee:=true;
  delline;
  end;
Vvod;

Rezultat;

writeln(Proizvedenie('6','12'));

readln;

END.

копировал с блокнота поэтому кодировка другая.... слова уже менять не стал - долго....

Автор: volvo 27.07.2009 2:06

Внутри функции Proizvedenie очищай массив M:

for i := 1 to 256 do m[i] := '';

, иначе там у тебя - мусор, он тебе мешает. Это первое.

Второе: при вычислении факториала

        Repeat
            F:=Proizvedenie(Fact,K);
            Fact:=F;
            K:=Suma(K,'1');
        until K>S; { <--- Здесь не должно быть "равно" }

, если будет "=", то считается факториал (A - 1).

Автор: RathaR 27.07.2009 2:27

Цитата(volvo @ 26.07.2009 22:06)

Внутри функции Proizvedenie очищай массив M:

for i := 1 to 256 do m[i] := '';

, иначе там у тебя - мусор, он тебе мешает. Это первое.

Второе: при вычислении факториала

        Repeat
            F:=Proizvedenie(Fact,K);
            Fact:=F;
            K:=Suma(K,'1');
        until K>S; { <--- Здесь не должно быть "равно" }

, если будет "=", то считается факториал (A - 1).

действительно, обнуления масива я не делал, но теперь до 8 программа работает, на 9 выдаёт какойто заоблачный результат, а на числа больше 9 реагирует тем, что выдаёт факториал первой цыфры - старшего розряда числа...
Но с этим думаю както розберусь

Еще раз спасибо

Автор: volvo 27.07.2009 3:30

Цитата

на 9 выдаёт какойто заоблачный результат

Нормальный результат: 362880 (видно при пошаговом прогоне). Другое дело, что нельзя сравнивать '9' и '10' между собой как строки, это приведет к неправильному результату ('9' всегда будет больше '10', и цикл продолжится, пока K не станет равно '90'). Теперь понятно, где надо искать проблему?