Помощь - Поиск - Пользователи - Календарь
Полная версия: Проблемы с задачей
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Jimmy
Задача: на основе динамических массивов jбеспечить выполнение операций сложения, умножения, деления двух полиномов, а также форматный ввод-вывод многочленов (например, в формате 3*x^5-6*x^2+7.23).

Проблемы:
1)некоректная работа процедуры сложения
2)процедура произведения отказывается работать
3) не понимаю как писать процедуру деления

Код

program mnog;
const n=50;
type tmas=^mas;
     mas=array[1..n] of real;
var KL:integer;

function podc(sc:string):integer;{podschet razmera massiva mnogochlena}
var k,m,kol,i:integer;
begin
     k:=length(sc);
     m:=0;
     for i:=1 to k do
     if sc[i]='+' then inc(m);

     kol:=m+1;
     podc:=2*kol;
end;

procedure readp(s:string; var a:tmas);{formatniy vvod}
const lim=['*','+','x','^'];
var i,j,k,code:integer; v:real; m:string;
begin

k:=length(s);
m:='';
j:=1;

  i := 1;
  while i <= k do begin
    while (i <= k) and not(s[i] in lim) do begin
      m:=m+s[i];
      inc(i);
    end;

    if m <> '' then begin
      val(m,v,code);
      a^[j]:=v;
      inc(j); m:='';
    end;
    inc(i);
  end;
kl:=podc(s);
end;




procedure formv(vh:tmas; var v:string);{formatnii vivod}
var i:integer; s:string;
begin
     str(vh^[1],s);
     v:=s+'*x^';
     str(vh^[2],s);
     v:=v+s;

     for i:=3 to kl do
     begin
         str(vh^[i],s);
         v:=v+'+'+s+'*x^';
         str(vh^[i+1],s);
         v:=v+s;
         i:=i+1;
         end;
end;


procedure sum(sl1,sl2:tmas;kc1,kc2:integer; var summ:string);{summa}
var i,j,h,h1:integer; summa:tmas;
begin
     if kc1>kc2 then h:=kc2 else h:=kc1;
     if kc1=kc2 then h:=kc1;

for i:=1 to h do begin
     if sl1^[i+1]=sl2^[i+1] then begin
     summa^[i]:=sl1^[i]+sl2^[i];
     summa^[i+1]:=sl1^[i+1];
     i:=i+1;
     end else begin
     summa^[i]:=sl1^[i];
     summa^[i+1]:=sl1^[i+1];
     summa^[i+2]:=sl2^[i];
     summa^[i+3]:=sl2^[i+1];
     i:=i+3;
     end;
     end;


     if kc1>kc2 then h1:=kc1 else h1:=kc2;
     for i:=h to h1 do begin
     if h1=kc1 then
     summa^[i]:=sl1^[i]
     else
     summa^[i]:=sl2^[i];
     end;

formv(summa,summ);
end;

procedure mult(mn1,mn2:tmas; kmn1,kmn2:integer; mul:string);{proizvedenie}
var i,j,k:integer; multi:tmas;
begin
     k:=1;
     for i:=1 to kmn1 do
         for j:=1 to kmn2 do begin
             multi^[k]:=mn1^[i]*mn2^[j];
             multi^[k+1]:=mn1^[i+1]+mn2^[j+1];
             inc(j);
             k:=k+2;
             end;
formv(multi,mul);
end;

procedure razbna2(cel:tmas; var koef,st:tmas);{razbienie na masivi koeficien i step}
var i,m:integer;
begin
    for i:=1 to kl do begin
        koef^[i]:=cel^[i];
        inc(i);
        st^[i]:=cel^[i];
        end;
end;

var ss,sk,sl1,sl2,sl3,sl4,kk1,kk2:string;
    ob,mn1,mn2,mn3,mn4:tmas;
    i,kl1,kl2,kl3,kl4:integer;
begin
     writeln('Vvedi mnogochlen ');
     readln(ss);
     readp(ss,ob);
     writeln('Vid');
     writeln;

     for i:=1 to kl do
     write(ob^[i],' ');



     writeln;
     writeln;
     formv(ob,sk);
     writeln(sk);
     writeln;

     writeln('Vvedite mnogoch dlya summirovaniya ');
     writeln('Vvedite 1 ');
     readln(sl1);
     readp(sl1, mn1);
     kl1:=kl;

     writeln('Vvedite 2 ');
     readln(sl2);
     readp(sl2, mn2);
     kl2:=kl;

     sum(mn1,mn2,kl1,kl2,kk1);
     writeln;
     writeln(kk1);
     writeln;

     writeln('Vvedite mnogoch dlya umnozh ');
     writeln('Vvedite 1 ');
     readln(sl3);
     readp(sl3, mn3);
     kl3:=kl;

     writeln('Vvedite 2 ');
     readln(sl4);
     readp(sl4, mn4);
     kl4:=kl;

     mult(mn3,mn4,kl3,kl4,kk2);
     writeln;
     writeln(kk2);



     readln;
end.
Помогите пожалуйста, заранее благодарен.
volvo
Ну, во-первых, ты не выделяешь место под динамические массивы, что уже будет приводить к ошибке (у меня, например, это дает Segmentation Fault на Free Pascal Compiler). А во вторых - у тебя внутри цикла For изменяется его параметр, чего тоже делать нельзя - это приведет к багам... Все подобные циклы меняй на While...
Jimmy
Какое услови передать while например в процедуре суммы?
volvo
Если сам алгоритм правилен, то заменить For на While - вот так:
i:=1;
while i <= h do begin
if sl1^[i+1]=sl2^[i+1] then begin
summa^[i]:=sl1^[i]+sl2^[i];
summa^[i+1]:=sl1^[i+1];
i:=i+1;
end else begin
summa^[i]:=sl1^[i];
summa^[i+1]:=sl1^[i+1];
summa^[i+2]:=sl2^[i];
summa^[i+3]:=sl2^[i+1];
i:=i+3;
end;
inc(i); { <--- Это - аналог автоматического увеличения для For }
end;

Jimmy
Не могу понять почему сумма и произведение не работает..Помогите кто-нибудь пожалуйста
Код
program mnog;
const n=50;
type tmas=^mas;
     mas=array[1..n] of real;
var KL:integer;

function podc(sc:string):integer;{podschet razmera massiva mnogochlena}
var k,m,kol,i:integer;
begin
     k:=length(sc);
     m:=0; i:=1;
     while i<=k do begin
     if sc[i]='+' then inc(m);
     inc(i);
     end;
     kol:=m+1;
     podc:=2*kol;

end;

procedure readp(s:string; var a:tmas);{formatniy vvod}
const lim=['*','+','x','^'];
var i,j,k,code:integer; v:real; m:string;
begin
kl:=podc(s);
k:=length(s);
m:='';
j:=1;
  getmem(a,kl*sizeof(real));
  i:=1;
  while i <= k do begin
    while (i <= k) and not(s[i] in lim) do begin
      m:=m+s[i];
      inc(i);
    end;

    if m <> '' then begin
      val(m,v,code);
      a^[j]:=v;
      inc(j); m:='';
    end;
    inc(i);
  end;
kl:=podc(s);
end;





procedure formv(vh:tmas; var v:string);{formatnii vivod}
var i:integer; s:string;
begin

     str(vh^[1],s);
     v:=s+'*x^';
     str(vh^[2],s);
     v:=v+s;
     i:=3;
     while (i<=kl) do begin
     if (vh^[i]=0) and (vh^[i+1]=0) then break else
         str(vh^[i],s);
         v:=v+'+'+s+'*x^';
         str(vh^[i+1],s);
         v:=v+s;
         i:=i+2;
         end;
end;

procedure sum(sl1,sl2:tmas;kc1,kc2:integer; var summ:string);{summa}
var i,j,h,h1:integer; summa:tmas;
begin
     getmem(sl1,kc1*sizeof(real));
     getmem(sl2,kc2*sizeof(real));
     getmem(summa, 2*kc1*kc2*sizeof(real));
     if kc1>kc2 then h:=kc2 else h:=kc1;
     if kc1=kc2 then h:=kc1;
     i:=1;
while i<=h do begin
     if sl1^[i+1]=sl2^[i+1] then begin
     summa^[i]:=sl1^[i]+sl2^[i];
     summa^[i+1]:=sl1^[i+1];
     i:=i+2;
     end else begin
     summa^[i]:=sl1^[i];
     summa^[i+1]:=sl1^[i+1];
     summa^[i+2]:=sl2^[i];
     summa^[i+3]:=sl2^[i+1];
     i:=i+4;
     end;
     end;


     if kc1>kc2 then h1:=kc1 else h1:=kc2;
     while i<=h1 do begin
     if h1=kc1 then begin
     summa^[i]:=sl1^[i];
     i:=i+1;
     end
     else begin
     summa^[i]:=sl2^[i];
     i:=i+1;
     end;
end;
formv(summa,summ);
end;






procedure mult(mn1,mn2:tmas; kmn1,kmn2:integer; mul:string);{proizvedenie}
var i,j,k:integer; multi:tmas;
begin
     k:=1; i:=1; j:=1;
     getmem(mn1,kmn1*sizeof(real));
     getmem(mn2,kmn2*sizeof(real));
     getmem(multi, kmn1*kmn2*sizeof(real));
     while i<=kmn1 do begin
         while j<=kmn2 do begin
             multi^[k]:=mn1^[i]*mn2^[j];
             multi^[k+1]:=mn1^[i+1]+mn2^[j+1];
             j:=j+2;
             k:=k+2;
             end;
             i:=i+2;
             end;
formv(multi,mul);
end;



var ss,sk,sl1,sl2,sl3,sl4,kk1,kk2:string;
    ob,mn1,mn2,mn3,mn4:tmas;
    i,kl1,kl2,kl3,kl4:integer;
begin


     writeln('Vvedi mnogochlen ');
     readln(ss);
     readp(ss,ob);
     writeln('Vid');
     writeln;
     i:=1;
     while i<=kl do begin
     write(ob^[i],' ');
     inc(i);
     end;


     writeln;
     writeln;
     formv(ob,sk);
     writeln(sk);
     writeln;


     writeln('Vvedite mnogoch dlya summirovaniya ');



     writeln('Vvedite 1 ');
     readln(sl1);
     readp(sl1, mn1);
     kl1:=kl;

     writeln('Vvedite 2 ');
     readln(sl2);
     readp(sl2, mn2);
     kl2:=kl;

sum(mn1,mn2,kl1,kl2,kk1);


     writeln;
     writeln(kk1);
     writeln;

     writeln('Vvedite mnogoch dlya umnozh ');
     writeln('Vvedite 1 ');

     readln(sl3);
     readp(sl3, mn3);
     kl3:=kl;

     writeln('Vvedite 2 ');
     readln(sl4);
     readp(sl4, mn4);
     kl4:=kl;

     mult(mn3,mn4,kl3,kl4,kk2);
     writeln;
     writeln(kk2);



     readln;
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.