| program matrix_lab; uses crt; type st=array[1..20] of real; matr=array[1..20] of st; var n, m, j, i, k, l, r: integer; s,s1,s2,s3,ext:real; x,y:st; a:matr; {-------------------------------------} function summa(m:integer; x:st):real; var i:integer; s:real; begin s:=0; for i:=1 to m do s:=s+x[i]; summa:=s;end; {-------------------------------------} function summamod(m:integer; x:st):real; var i:integer; s:real; begin s:=0; for i:=1 to m do s:=s+abs(x[i]); summamod:=s; end; {-------------------------------------} procedure wwod(var a:matr); var i,j:integer; begin clrscr; write('k-vo strok=');readln(n); write('k-vo stolb=');readln(m); for i:=1 to n do begin for j:=1 to m do begin write('a[',i,',',j,']=');read(a[i,j]); end; writeln; end; end; {-------------------------------------} procedure wywod; var i,j:integer; begin for i:=1 to n do begin for j:=1 to m do write(a[i,j]:3:2,' '); writeln;end; writeln; end; {-------------------------------------} | procedure priswaiwanie; begin n:=3;m:=4; a[1,1]:=3; a[1,2]:=0; a[1,3]:=-5;a[1,4]:=3; a[2,1]:=-4; a[2,2]:=-1;a[2,3]:=-2; a[2,4]:=-3; a[3,1]:=1; a[3,2]:=3; a[3,3]:=0; a[3,4]:=8; end; {-------------------------------------} procedure znak(m:integer; var x:st); var i:integer; begin for i:=1 to m do x[i]:=-x[i]; end; {-------------------------------------} procedure maximum(m:integer; x:st; var max:real; var k:integer); var i:integer; begin max:=x[1];k:=1; for i:=2 to m do if x[i]>max then begin max:=x[i];k:=i;end; end; {-------------------------------------} procedure maximummod(m:integer; x:st; var max:real; var k:integer); var i:integer; begin max:=abs(x[1]);k:=1; for i:=2 to m do if abs(x[i])>max then begin max:=abs(x[i]);k:=i;end; end; {-------------------------------------} begin clrscr; wwod(a); wywod; for i:=1 to n do begin s:=summa(m,a[i]); writeln(i,'str. s=',s:3:2); end; end. |
Файл Polinom.pas
| program polinoms; uses crt; type polinom=array[0..50] of real; var a,b,c,d:polinom; n1,n2,n3,n4,i,j,k,n:integer; f,g,h,t,q,r:real; procedure intput(var n:integer; var p:polinom); var i:integer; begin write('Введите степень многочлена n=');readln(n); writeln('Введите коэффициенты многочлена, начиная со старшего.'); for i:=n downto 0 do readln(p[i]); end; procedure output(n:integer; p:polinom); var i:integer; begin for i:=n downto 0 do write(p[i]:3:2,' '); writeln; end; procedure sum(n:integer; p:polinom; k:integer; q:polinom; var m:integer; var r:polinom); var i:integer; begin if k<n then m:=n else m:=k; for i:=0 to m+n-k do r[i]:=p[i]+q[i]; if k<n then for i:=k+1 to n do r[i]:=p[i] else if k>n then for i:=n+1 to k do r[i]:=q[i]; end; procedure num_mult(n:integer; p:polinom; k:integer; var m:integer; var r:polinom); var i:integer; begin m:=n; for i:=0 to m do r[i]:=k*p[i]; end; procedure multiply(n:integer; p:polinom; k:integer; q:polinom; var m:integer; var r:polinom); var i,j:integer; begin m:=n+k; for i:=0 to m do r[i]:=0; for i:=0 to n do for j:=0 to k do r[i+j]:=r[i+j]+p[i]*q[j]; end; | procedure division(n:integer; p:polinom; m:integer; q:polinom; var k:integer; var c:polinom; var r:integer; var s:polinom); var i:integer; begin if n<m then begin k:=0;c[0]:=0; r:=n; for i:=0 to n do s[i]:=p[i]; end else begin k:=n-m; for i:=k downto 0 do begin c[i]:=p[m+i]/q[m]; for j:=m downto 0 do p[j+i]:=p[j+i]-c[i]*q[j]; end; r:=m-1; for j:=0 to r do s[j]:=p[j]; end; end; procedure derivation(n:integer; p:polinom; var m:integer; var r:polinom); var i:integer; begin m:=n-1; for i:=m downto 0 do r[i]:=(i+1)*p[i+1]; end; procedure value(n:integer; p:polinom; c:real; var m:real); var i,t:integer; b,r:polinom; begin i:=1;b[1]:=1;b[0]:=-c; division(n,p,i,b,t,r,i,b); m:=b[0]; end; begin clrscr; writeln('Введите первый многочлен');intput(n1,a); writeln(' Введите второй многочлен '); intput(n2,b); division(n1,a,n2,b,n3,c,n4,d); writeln('Частное равно'); output(n3,c); writeln('Остаток от деления'); output(n4,d); writeln('Сумма коэффициентов первого многочлена равна'); value(n1,a,1,f);writeln(f); end. |