Объединить программы в подпрограммы(использование procedure) и нарисовать блок схему. - Паскаль, Turbo Pascal, PascalABC.NET

Camelot_2012 · 15.04.2012, 20:22

Код:

program zadachka;
uses crt;
const
n=3;
Var
a: array [1..n,1..n] of integer;
i,j,d,p1,p2:integer;
begin Clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']=');
readln(a[i,j]);
end;
for i:=1 to n do begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i:=1 to n do
begin
p1:=a[1,1]*a[2,2]*a[3,3]+a[1,2]*a[2,3]*a[3,1]+a[2,1]*a[3,2]*a[1,3];
p2:=a[1,3]*a[2,2]*a[3,1]+a[1,2]*a[2,1]*a[3,3]+a[2,3]*a[3,2]*a[1,1];
d:=p1-p2;
end;
writeln;
writeln('det=',d:6);
end.

Код:

Program zadacha;
Uses crt;
const 
     n=3;    
var a:array[1..n,1..n] of integer;
    i,j,k:integer;
begin clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']: ');
read(a[i,j]);
end;
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i := 1 to n- 1 do 
for j := i + 1 to n do
if abs(a[i,i]) > abs(a[j,j]) then
begin
k := a[i,i];
a[i,i] := a[j,j];
a[j,j] := k;
end;
writeln;
for i:=1 to n do
write(a[i,i], ' ');
end.

Код:

uses crt;
var x,tg: real;
begin clrscr;
write('x= ');
readln(x);
tg:=(exp(x)-exp(-x))/(exp(x)+exp(-x));
writeln('tg(x)= ',tg:2:2);
end.

Код:

uses crt;
const
  e = 0.0001;
var
  x, t, s, n, c: real; 
begin
x:=-1;
while x<=1 do
begin
if x < 0.5 then begin
s := 0; 
n := 0; 
c := 1; 
t := 1; 
while (t / c) > e do 
begin
n := n + 1; 
s := s + t / c; 
t := t * x * x; 
c := 1 + 4 * n; 
end; 
s := (x * x + 3 * x + 4) * s / (5 * x + 1);	 
end
else
begin
s := 0; 
n := 1; 
t := x; 
while n <= 10 do 
begin
s := s + t / n; 
t := t * x; 
n := n + 1; 
end; 
s := x * s / 3;    
end;
writeln('x= ',x:2:1,'  y=: ', s:2:3);
x:=x+0.1;
end;
readln;
end.

Poma][a · 15.04.2012, 20:35

1) Где здрасте?
2) Где просьба помочь?
3) Где горизонтальное форматирование текста ("система вложенности")?

Camelot_2012 · 15.04.2012, 21:08

Цитата:

Сообщение от Poma][a

1) Где здрасте?
2) Где просьба помочь?
3) Где горизонтальное форматирование текста ("система вложенности")?

1)Привет!
2)Так вроде бы запрещено писать помогите!
3)Это как?

Serge_Bliznykov · 16.04.2012, 09:55

Цитата:

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

1)Привет!

лучше поздно, чем никогда!

Цитата:

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

2)Так вроде бы запрещено писать помогите!

только в заголовке темы.
а в тексте не только можно, но и НУЖНО!!

Цитата:

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

3)Это как?

это так:

Код:

ses crt;
const
  e = 0.0001;
var
  x, t, s, n, c: real;
begin
  x := -1;
  while x <= 1 do
  begin
    if x < 0.5 then begin
      s := 0;
      n := 0;
      c := 1;
      t := 1;
      while (t / c) > e do
      begin
        n := n + 1;
        s := s + t / c;
        t := t * x * x;
        c := 1 + 4 * n;
      end;
      s := (x * x + 3 * x + 4) * s / (5 * x + 1);
    end
    else
    begin
      s := 0;
      n := 1;
      t := x;
      while n <= 10 do
      begin
        s := s + t / n;
        t := t * x;
        n := n + 1;
      end;
      s := x * s / 3;
    end;
    writeln('x= ', x: 2: 1, '  y=: ', s: 2: 3);
    x := x + 0.1;
  end;
  readln;
end.

Camelot_2012 · 16.04.2012, 15:31

Цитата:

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

лучше поздно, чем никогда!

только в заголовке темы.
а в тексте не только можно, но и НУЖНО!!

это так:

Код:

ses crt;
const
  e = 0.0001;
var
  x, t, s, n, c: real;
begin
  x := -1;
  while x <= 1 do
  begin
    if x < 0.5 then begin
      s := 0;
      n := 0;
      c := 1;
      t := 1;
      while (t / c) > e do
      begin
        n := n + 1;
        s := s + t / c;
        t := t * x * x;
        c := 1 + 4 * n;
      end;
      s := (x * x + 3 * x + 4) * s / (5 * x + 1);
    end
    else
    begin
      s := 0;
      n := 1;
      t := x;
      while n <= 10 do
      begin
        s := s + t / n;
        t := t * x;
        n := n + 1;
      end;
      s := x * s / 3;
    end;
    writeln('x= ', x: 2: 1, '  y=: ', s: 2: 3);
    x := x + 0.1;
  end;
  readln;
end.

Ясно! В следующий раз учту! =) Кто нить помогите пожалуйста!

Poma][a · 16.04.2012, 16:47

Код:

Uses crt;
const 
     n=3;
     e= 0.0001;
  
procedure zadachka;
Var
a: array [1..n,1..n] of integer;
i,j,d,p1,p2:integer;
begin Clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']=');
readln(a[i,j]);
end;
for i:=1 to n do begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i:=1 to n do
begin
p1:=a[1,1]*a[2,2]*a[3,3]+a[1,2]*a[2,3]*a[3,1]+a[2,1]*a[3,2]*a[1,3];
p2:=a[1,3]*a[2,2]*a[3,1]+a[1,2]*a[2,1]*a[3,3]+a[2,3]*a[3,2]*a[1,1];
d:=p1-p2;
end;
writeln;
writeln('det=',d:6);
end;

procedure zadacha;
  
var a:array[1..n,1..n] of integer;
    i,j,k:integer;
begin clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']: ');
read(a[i,j]);
end;
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i := 1 to n- 1 do 
for j := i + 1 to n do
if abs(a[i,i]) > abs(a[j,j]) then
begin
k := a[i,i];
a[i,i] := a[j,j];
a[j,j] := k;
end;
writeln;
for i:=1 to n do
write(a[i,i], ' ');
end;

procedure Task;

var x,tg: real;
begin clrscr;
write('x= ');
readln(x);
tg:=(exp(x)-exp(-x))/(exp(x)+exp(-x));
writeln('tg(x)= ',tg:2:2);
end;

procedure Task2;
var
  x, t, s, n, c: real; 
begin
x:=-1;
while x<=1 do
begin
if x < 0.5 then begin
s := 0; 
n := 0; 
c := 1; 
t := 1; 
while (t / c) > e do 
begin
n := n + 1; 
s := s + t / c; 
t := t * x * x; 
c := 1 + 4 * n; 
end; 
s := (x * x + 3 * x + 4) * s / (5 * x + 1);	 
end
else
begin
s := 0; 
n := 1; 
t := x; 
while n <= 10 do 
begin
s := s + t / n; 
t := t * x; 
n := n + 1; 
end; 
s := x * s / 3;    
end;
writeln('x= ',x:2:1,'  y=: ', s:2:3);
x:=x+0.1;
end;
readln;
end;


begin
         Zadachka;
         Zadacha;
         Task;
         Task2
end.

Camelot_2012 · 16.04.2012, 22:16

Цитата:

Сообщение от Poma][a

Код:

Uses crt;
const 
     n=3;
     e= 0.0001;
  
procedure zadachka;
Var
a: array [1..n,1..n] of integer;
i,j,d,p1,p2:integer;
begin Clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']=');
readln(a[i,j]);
end;
for i:=1 to n do begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i:=1 to n do
begin
p1:=a[1,1]*a[2,2]*a[3,3]+a[1,2]*a[2,3]*a[3,1]+a[2,1]*a[3,2]*a[1,3];
p2:=a[1,3]*a[2,2]*a[3,1]+a[1,2]*a[2,1]*a[3,3]+a[2,3]*a[3,2]*a[1,1];
d:=p1-p2;
end;
writeln;
writeln('det=',d:6);
end;

procedure zadacha;
  
var a:array[1..n,1..n] of integer;
    i,j,k:integer;
begin clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']: ');
read(a[i,j]);
end;
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i := 1 to n- 1 do 
for j := i + 1 to n do
if abs(a[i,i]) > abs(a[j,j]) then
begin
k := a[i,i];
a[i,i] := a[j,j];
a[j,j] := k;
end;
writeln;
for i:=1 to n do
write(a[i,i], ' ');
end;

procedure Task;

var x,tg: real;
begin clrscr;
write('x= ');
readln(x);
tg:=(exp(x)-exp(-x))/(exp(x)+exp(-x));
writeln('tg(x)= ',tg:2:2);
end;

procedure Task2;
var
  x, t, s, n, c: real; 
begin
x:=-1;
while x<=1 do
begin
if x < 0.5 then begin
s := 0; 
n := 0; 
c := 1; 
t := 1; 
while (t / c) > e do 
begin
n := n + 1; 
s := s + t / c; 
t := t * x * x; 
c := 1 + 4 * n; 
end; 
s := (x * x + 3 * x + 4) * s / (5 * x + 1);	 
end
else
begin
s := 0; 
n := 1; 
t := x; 
while n <= 10 do 
begin
s := s + t / n; 
t := t * x; 
n := n + 1; 
end; 
s := x * s / 3;    
end;
writeln('x= ',x:2:1,'  y=: ', s:2:3);
x:=x+0.1;
end;
readln;
end;


begin
         Zadachka;
         Zadacha;
         Task;
         Task2
end.

Спасибо большое! Но почему-то 1,2 не выводит!

Camelot_2012 · 16.04.2012, 22:31

Код:

Uses crt;
const 
     n=3;
     e= 0.0001;

procedure one;
Var a: array [1..n,1..n] of integer;
    i,j,d,p1,p2:integer;
begin Clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']=');
readln(a[i,j]);
end;
for i:=1 to n do begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i:=1 to n do
begin
p1:=a[1,1]*a[2,2]*a[3,3]+a[1,2]*a[2,3]*a[3,1]+a[2,1]*a[3,2]*a[1,3];
p2:=a[1,3]*a[2,2]*a[3,1]+a[1,2]*a[2,1]*a[3,3]+a[2,3]*a[3,2]*a[1,1];
d:=p1-p2;
end;
writeln;
writeln('det=',d:6);
readln;
end;

procedure two;
var a:array[1..n,1..n] of integer;
    i,j,k:integer;
begin clrscr;
for i:=1 to n do
for j:=1 to n do
begin
write('vvedite a[', i, ',', j, ']: ');
read(a[i,j]);
end;
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(a[i,j]:6);
end;
for i := 1 to n- 1 do 
for j := i + 1 to n do
if abs(a[i,i]) > abs(a[j,j]) then
begin
k := a[i,i];
a[i,i] := a[j,j];
a[j,j] := k;
end;
writeln;
for i:=1 to n do
writeln(a[i,i], ' ');
readln;
end;

procedure three;
var x,tg: real;
begin clrscr;
write('x= ');
readln(x);
tg:=(exp(x)-exp(-x))/(exp(x)+exp(-x));
writeln('tg(x)= ',tg:2:2);
readln;
end;

procedure four;
var x, t, s, n, c: real; 
begin clrscr;
x:=-1;
while x<=1 do
begin
if x < 0.5 then begin
s := 0; 
n := 0; 
c := 1; 
t := 1; 
while (t / c) > e do 
begin
n := n + 1; 
s := s + t / c; 
t := t * x * x; 
c := 1 + 4 * n; 
end; 
s := (x * x + 3 * x + 4) * s / (5 * x + 1);	 
end
else
begin
s := 0; 
n := 1; 
t := x; 
while n <= 10 do 
begin
s := s + t / n; 
t := t * x; 
n := n + 1; 
end; 
s := x * s / 3;    
end;
writeln('x= ',x:2:1,'  y=: ', s:2:3);
x:=x+0.1;
end;
readln;
end;

begin
         one;
         two;
         three;
         four
end.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Нарисовать блок схему	PascalABC	Помощь студентам	5	29.01.2012 20:12
Нарисовать блок схему	izi2000	Помощь студентам	3	12.02.2011 10:44
Нарисовать блок-схему программы	prikolist	Общие вопросы C/C++	4	20.05.2009 19:46
Не могу нарисовать блок-схему маленькой программы	prikolist	Паскаль, Turbo Pascal, PascalABC.NET	4	25.11.2008 23:40
Помогите нарисовать блок-схему на ооочень маленький кусочек программы!!!!!	metamfetamin	Помощь студентам	1	24.11.2007 22:55

15.04.2012, 20:35	#2
Poma][a Новичок Джуниор Регистрация: 11.10.2011 Сообщений: 3,882	1) Где здрасте? 2) Где просьба помочь? 3) Где горизонтальное форматирование текста ("система вложенности")?