небольшие изменения

[rubik-nerubik]

Народ, кто поможет мне?
т.е. парень кинул мне готовую задачу, но разбираться нету сил уже...

program Snak3;
var ss,s:string;
n,i,k:longint;
read(n); ТУТ ругается что нет ':' это как? хм, может кто попробует исправить? спасибо, задача считает вида 1!+2!+3!+...+n!
s:=''; ss:='';
for i:=1 to n do
begin
for k:=1 to i do um(s,str(k),s);
sum(ss,s,ss);
end;


procedure um(a,b:string;var c:string);
var n,k,i,j,x,p:integer; d:string;
begin
n:=length(a);
k:=length(b);
c:=''; d:=''; p:=0;
for i:=1 to n+k do d:=d+'0';
for j:=k downto 1 do
begin
p:=0;
for i:=n downto 1 do begin
x:=(ord(a[i])-ord('0'))*(ord(b[j])-ord('0'))+p+ord(d[i+j])-ord('0');
d[i+j]:=chr((x mod 10)+ord('0'));
p:=x div 10;
end;
d[j]:=chr(ord(d[j])+p);
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;
procedure raz(a,b:string;var c:string);
var x,n,k,i,p,g:integer;
d:string;
begin
n:=length(a);
k:=length(b);
if k<n then for i:=k+1 to n do b:='0'+b;
d:=''; c:=''; p:=0;
for i:=n downto 1 do
begin
if a[i]<b[i] then
begin
a[i-1]:=chr(ord(a[i-1])-1);
x:=10+ord(a[i])-ord(b[i]);
d:=chr(x+ord('0'))+d;
end
else begin
x:=ord(a[i])-ord(b[i]);
d:=chr(x+ord('0'))+d;
end;
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;
function cmp(a,b:string):string;
var n,k,i:integer; c:string;
begin
n:=length(a);
k:=length(b);
c:='';
if n<k then c:='-' else
begin
if k<n then c:='+' else
begin
i:=1;
while ((a[i]=b[i])and(i<=n)) do inc(i);
if (a[i]<b[i]) then c:='-';
if (a[i]>b[i]) then c:='+';
if (i=n+1) then c:='=';
end;
end;
cmp:=c;
end;
procedure sum(a,b:string;var c:string);
var x,i,p,n,k:integer;
begin
n:=length(a);
k:=length(b);
p:=0;
c:='';
if n<k then begin
for i:=n+1 to k do
a:='0'+a;
end else
begin
for i:=k+1 to n do
b:='0'+b; end;
n:=length(a);
for i:=n downto 1 do
begin
x:=ord(a[i])-ord('0')+ord(b[i])-ord('0')+p;
c:=chr((x mod 10)+ord('0'))+c;
p:=x div 10;
end;
if p<>0 then
begin
inc(n);
c:='1'+c;
end;

[GlOFF]

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

Да щас у всех завал с учебой, никаких сил и возможностей. :((((

[rubik-nerubik]

хоть тут помогите!!!!!!

program one;
var s,dx,x1,x2:real;
q:array[1..20] of integer;
r:array[1..25] of integer;
i:integer; x,qq,kk:integer;
k:array[1..100] of integer;
function y(x:real):real;
begin
For i:=1 to 20 do begin
read(q[i]);
if ((q[i]>-1.2)and(q[i]<3.4)) then inc(qq);
end;
For i:=1 to 25 do
begin
read(k[i]);
if ((q[i]>2.2) and (q[i]<5.34)) then inc(kk);
end;
if qq<kk then
begin
qq:=qq+kk;
kk:=qq-kk;
qq:=qq-kk;
end;
y:=x/(sqrt(exp(x*ln(exp(1)))- exp((-x)*ln(exp(1)))));
begin
assign(output,'output1.txt');
rewrite(output);
i:=kk;
while i<=qq do
begin
x1:=y(q+i*dx); тут ругается type mismatch несоответствие типов!!!
x2:=y(q+i*dx+dx);
s:=s+(x1+x2)/2*dx;
i:=i+dx;
end;
writeln(s);
end.

[Sn@k3]

Вроде компилируется...

program one;
var dx:integer;
s,x1,x2:real;
q:array[1..20] of real;
r:array[1..25] of real;
k:array[1..100] of real;
i:integer;x,qq,kk:integer;
function y(x:real):real;
begin
For i:=1 to 20 do begin
read(q[i]);
if ((q[i]>-1.2)and(q[i]<3.4)) then inc(qq);
end;
For i:=1 to 25 do begin
read(k[i]);
if ((q[i]>2.2) and (q[i]<5.34)) then inc(kk);
end;
if qq<kk then begin
qq:=qq+kk;
kk:=qq-kk;
qq:=qq-kk;
end;
y:=x/(sqrt(exp(x*ln(exp(1)))- exp((-x)*ln(exp(1)))));
End;
begin
assign(output,'output1.txt');
rewrite(output);
i:=kk;
while i<=qq do begin
x1:=y(q[i]+i*dx);
x2:=y(q[i]+i*dx+dx);
s:=s+(x1+x2)/2*dx;
i:=i+dx;
end;
writeln(s);
end.

[.Slip]

program Snak3;
var ss,s:string;
n,i,k:longint;
read(n); ТУТ ругается что нет ':' это как? хм, может кто попробует исправить? спасибо, задача считает вида 1!+2!+3!+...+n!
s:=''; ss:='';
for i:=1 to n do
begin
for k:=1 to i do um(s,str(k),s);
sum(ss,s,ss);
end;

Эмм... Насколько я помню, в поцкале после окончания блока с переменными и их объявлениями, нужно писать begin.

[rubik-nerubik]

уже исправил, но он уже говорит на um(s,str(k),s); - на um говорит незнает!!!!!... но это же какая-то функция, пжл скопируйте в паскаль. исправьте до комеиляции пжл

[Xserg]

1.

program Snak3;

var ss,s:string;
n,i,k:longint;

procedure um(a,b:string;var c:string);
var n,k,i,j,x,p:integer;
d:string;
begin
n:=length(s);
k:=length(b);
c:=''; d:=''; p:=0;
for i:=1 to n+k do d:=d+'0';
for j:=k downto 1 do
begin
p:=0;
for i:=n downto 1 do begin
x:=(ord(a[i])-ord('0'))*(ord(b[j])-ord('0'))+p+ord(d[i+j])-ord('0');
d[i+j]:=chr((x mod 10)+ord('0'));
p:=x div 10;
end;
d[j]:=chr(ord(d[j])+p);
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;

procedure sum(a,b:string;var c:string);
var x,i,p,n,k:integer;
begin
n:=length(a);
k:=length(b);
p:=0;
c:='';
if n<k then begin
for i:=n+1 to k do
a:='0'+a;
end else
begin
for i:=k+1 to n do
b:='0'+b; end;
n:=length(a);
for i:=n downto 1 do
begin
x:=ord(a[i])-ord('0')+ord(b[i])-ord('0')+p;
c:=chr((x mod 10)+ord('0'))+c;
p:=x div 10;
end;
if p<>0 then
begin
inc(n);
c:='1'+c;
end;
end;


begin
write('Enter n');
readln(n);
ss:='';
for i:=1 to n do begin
s:='1';
for k:=1 to i do um(s,str(k),s);
sum(ss,s,ss);
end;
writeln('1!+2!+3!+..+n!=',ss);
read(n);
end.


2.

x1:=round(y(q+i*dx));

[rubik-nerubik]

for k:=1 to i do um(s,str(k),s); - Error in Expression

[Xserg]

for k:=1 to i do um(s,str(k),s); - Error in Expression
У меня нет паскаля, я использовал delphi:
um(s,inttostr(k),s);

кажется надо
Uses utilits или crt ??

[rubik-nerubik]

ну а так работает? стукни 350-659-776

всеровно неработает

вот собственно решение задачи, 2 #4

компилица вроде она, но не работает =\ хз

Вычислить значение интеграла на заданном отрезке[q;r] интегрирования методом средних прямоугольников при заданном числе разбиений отрезка интегрирования К. Подынтегральная функция: y:=x/(sqrt(exp(x*ln(exp(1)))- exp((-x)*ln(exp(1))))); . Значения q и r, соответственно равные числу элементов массива Q(20), находящихся в интервале от –1.2 до 3.4 и числу элементов массива К(25),находящихся в интервале от 2.2 до 5.34, вычислить в одной подпрограмме. Если q>r, значения поменять местами.

[Xserg]

так должно работать:

program Snak3;
uses Crt;

.....
c:='1'+c;
end;
end;

function IntToStr(a: Integer): string;
var s: string;
begin
Str(a, s);
IntToStr := s;
end;

begin
write('Enter n');
......
...... um(s,IntToStr(k),s);

[rubik-nerubik]

Всё, задача работоспособна....

Спасибо: Xerg, Sn@k3, .Slip
Вот собственно готовая задача
, считает 1!+2!+3!+..+n!

program Snak3;
uses crt;
var ss,s:string;
n,i,k:longint;

procedure um(a,b:string;var c:string);
var n,k,i,j,x,p:integer;
d:string;
begin
n:=length(s);
k:=length(b);
c:=''; d:=''; p:=0;
for i:=1 to n+k do d:=d+'0';
for j:=k downto 1 do
begin
p:=0;
for i:=n downto 1 do begin
x:=(ord(a[i])-ord('0'))*(ord(b[j])-ord('0'))+p+ord(d[i+j])-ord('0');
d[i+j]:=chr((x mod 10)+ord('0'));
p:=x div 10;
end;
d[j]:=chr(ord(d[j])+p);
end;
i:=1;
n:=length(d);
while (d[i]='0') and (i<n) do inc(i);
for k:=i to n do c:=c+d[k];
end;

procedure sum(a,b:string;var c:string);
var x,i,p,n,k:integer;
begin
n:=length(a);
k:=length(b);
p:=0;
c:='';
if n<k then begin
for i:=n+1 to k do
a:='0'+a;
end else
begin
for i:=k+1 to n do
b:='0'+b; end;
n:=length(a);
for i:=n downto 1 do
begin
x:=ord(a[i])-ord('0')+ord(b[i])-ord('0')+p;
c:=chr((x mod 10)+ord('0'))+c;
p:=x div 10;
end;
if p<>0 then
begin
inc(n);
c:='1'+c;
end;
end;

function IntToStr(a: Integer): string;
var s: string;
begin
Str(a, s);
IntToStr := s;
end;

begin
write('Enter n');

readln(n);
ss:='';
for i:=1 to n do begin
s:='1';
for k:=1 to i do um(s,IntToStr(k),s);
sum(ss,s,ss);
end;
writeln('1!+2!+3!+..+n!=',ss);
read(n);
end.

[Sn@k3]

хех мой пример разобрать не можете)))))))) я бы помог извини человек нет времени у самого. вон те чел поможет.

[rubik-nerubik]

Так, теперь осталось две беды: блок-схема к той:#12

и к #10 переделать вроде....