HELP!!!

[Sheka]

сделаю за бутылку пива. 255507394

[Newbie]

у меня не получается программа помогите позязя!!!!! тема: 0.3. Оператор перехода GOTO. Цикл. Метки.
34) Напечатать 1 2 3 4 . . . 99 100 99 . . . 3 2 1.
вот моя программа:
program pr8;
label m1, m2, m3, m4, m5;
var f: integer;
begin
f:= 1;
m1: if f>100 then goto m2 else goto m3
m3:f:=f+1;
goto m1;
m2:f:=f-1;
m5: if f>1 then goto m2 else goto m4;
m4: writeln;
readln;
end.

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

Код: Выделить всё

program mgoto;

uses crt;

var
   m_inc: boolean;
   f: integer;
   needstop: boolean;

label incr, decr, mexit, body;

begin
clrscr;
f := 0;
m_inc := true;
needstop := false;

body:
while(not needstop) do
 if (m_inc) then
  goto incr
 else
  goto decr;
 goto mexit;

incr:
  inc(f);
  write(f, ' ');
  if(f = 100) then
   m_inc := false;
  goto body;

decr:
  dec(f);
  write(f, ' ');
  if(f = 1) then
   needstop := true;
  goto body;

mexit:
readkey;
end.

ЗЫ inc\dec встроенные функции паскаля аналогично i := i + 1\i := i - 1

[Suslik]

Всё, прога готова..

Program Suslik;
Uses crt;
Const
_COUNT = 20;
type
maxArr = record
index,value: integer;
end;
var
i,b_len,num:integer;
A:array[0.._COUNT] of integer;
B:array[0.._COUNT] of maxArr;

procedure fillArr(var A:array of integer);

begin
randomize;
for i:=0 to _COUNT do A:=random(100);
end;

procedure Compare(number:integer; A:array of integer;
var b_len:integer; var B:array of maxArr);
var
index:integer;
begin
for i:=0 to _COUNT-1 do
if A > number then
begin
B[b_len].value:=A;
B[b_len].index:=i;
inc(b_len);
end;
end;

procedure sortSwap(var x,y: maxArr);
var t:integer;
begin
{Value}
t:=x.value;
x.value:=y.value;
y.value:=t;
{Index}
t:=x.index;
x.index:=y.index;
y.index:=t;
end;

procedure Sort(var B:array of maxArr);
var
i,j: integer;
begin
for i:=0 to b_len-1 do
for j:=i+1 to b_len-1 do
if B.value > B[j].value then
sortSwap(B, B[j]);
end;

procedure writeA(A:array of integer);
var i:integer;
begin
writeln('====>>Posledovatelnost "A"<<====');
for i:=0 to _COUNT-2 do
write(A,', ');
write(A[_COUNT-1]);
writeln;
writeln;
end;

procedure writeB(B:array of maxArr);
var i:integer;
begin
writeln('====>>Posledovatelsnost "B"<<====');
for i:=0 to b_len-1 do
write(B.value,' ');
writeln;
writeln;
end;

procedure writeElements(B:array of maxArr);
begin
writeln('====>>NUMBERS<<====');
writeln('Nomer pervogo elem: ', B[0].index+1);
writeln('Nomer poslednego elem: ', B[b_len-1].index+1);
end;

BEGIN
ClrScr;
fillArr(A);
writeA(A);
write('Vvedite 4islo dlya sravneniya: ');
read(num);
b_len:=0;
Compare(num, A, b_len, B);
Sort(B);

writeB(B);
writeElements(B);
{writeln('Dlina B: ', b_len);}
readln;
readln;

END.

[Хыиуду]

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

Код: Выделить всё

program mgoto;

uses crt;

var
   m_inc: boolean;
   f: integer;
   needstop: boolean;

label incr, decr, mexit, body;

begin
clrscr;
f := 0;
m_inc := true;
needstop := false;

body:
while(not needstop) do
 if (m_inc) then
  goto incr
 else
  goto decr;
 goto mexit;

incr:
  inc(f);
  write(f, ' ');
  if(f = 100) then
   m_inc := false;
  goto body;

decr:
  dec(f);
  write(f, ' ');
  if(f = 1) then
   needstop := true;
  goto body;

mexit:
readkey;
end.

ЗЫ inc\dec встроенные функции паскаля аналогично i := i + 1\i := i - 1

Ну вы понаписали...

Код: Выделить всё

label l1;
var i,d: shortint;
begin
  k:=1;
  i:=1;
l1:writeln(i)
  inc(i,k);
  if i=100 then k:=-1;
  if i<>1 then goto l1;
end.

Все.

[Suslik]

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

[Newbie]

Всё, прога готова..

В час ночи после рабочего дня мозг отдыхает)))

Знаю токо 2) вот они:
рекурсия:
[syntax="pascal"]
function factorial( i : integer) : integer;
begin
if (i < 0) then exit;
if (i = 0) or (i = 1) then
begin
factorial := 1;
exit;
end;
factorial := i * factorial(i - 1);
end;

и цикл:
val := 1;
for i := 1 to j do
val := val * i;
[/syntax]
как еще можно посчитать факториал?)))

[atavin-ta]

Ещё можно перевернуть цикл. Или это не считается?

[ylika]

помогите кто-нибудь завтра нужно сдать а я не шарю абсолютно(((((((
«Сортировка одномерных массивов»
1. Даны действительные числа А1, ..., Аn, Р, натуральное число k (A1<=...<=An, k<=n). Удалить из А1, ..., Аn элемент с номером k (т.е. Ak) и вставить элемент. равный Р, так, чтобы не нарушилась упорядоченность .


2. Даны действительные числа С1, ..., Сp, D1, ..., Dq. (С1<=C2<=...<=Сp, D1<=D2<=...Dq). Ввести единицу упорядоченности, получив F1, F2, ..., Fp+q, что F1<=F2<=...<=Fp+q. Число сравнений не должно превосходить p+q.

3. Даны натуральное число n, целые числа А1, ..., Аn. Найти наибольшее значение, встречающееся в последовательности А1, ..., Аn, после выбрасывания одного из членов со значением max(A1, ..., An).
Заранее спасибо!!!

[Хыиуду]

1.

Код: Выделить всё

if A[k]<p then
while p<a[k+1] do 
begin
   a[k]:=a[k+1];
   inc(k);
end
else
while p>a[k-1] do
begin
   a[k]:=a[k-1];
   dec(k);
end;
a[k]:=p;

2.

Код: Выделить всё

ib:=1; ic:=1;
while ib+ic<p+q do
if C[ic]<B[ib] then begin F[ic+ib-1]:=C[ic]; inc(ic); end
else begin F[ic+ib-1]:=B[ib]; inc(ib); end;

3. Раздел "Алгоритмы", поиск максимума. После нахождения максимума пройти по последовательности еще раз, произвести поиск максимума, но если новый равен ранее найденному - не учитывать его.

[Suslik]

а кто может рассказать, что такое "maxArr" и с чем его едят??