одномерный массив, массивы Опции

[электрик]

помогиет решить задачу!! срочно, не могу зачет здать!
вот она:
Составьте прогу, проверяющую, можно ли, меняя местами элементы одномерного массива А, получить одномерный массив В

[volvo]

klem4
специально для тебя:

flag := true;
for i := 1 to n do begin
  flag := flag and (a[i] = b[i]);
  if not flag then break;
end;

if flag then writeln('Можно') else writeln('Нельзя');

и сколько сравнений тебе понадобится? И где ты видел Exit? Кстати, мне как-то все равно, что преподы любят, а что нет.

[электрик]

klem4
специально для тебя:

flag := true;
for i := 1 to n do begin
  flag := flag and (a[i] = b[i]);
  if not flag then break;
end;

if flag then writeln('Можно') else writeln('Нельзя');

и сколько сравнений тебе понадобится? И где ты видел Exit? Кстати, мне как-то все равно, что преподы любят, а что нет.

и Как лучше закончить?

[электрик]

короче посидел подумал и вот задача:

Program laba7;

uses
 crt;

type
 matr=array [1..7,1..7] of real;

var
 ma:matr;
 n,m:byte;
 pol:integer;

Procedure Zastavka;

const
x=40;
y=10;
c=9;
var
 i:byte;

Begin
 clrscr;
 gotoxy(x,y);
 textcolor©;
 write('Программа');
 gotoxy(wherex-21,wherey+1);
 write('‚Вычисление математических функций');
 gotoxy(wherex-26,wherey+1);
 textcolor(15);
 write('Автор: Макаев А,Р,');
 textcolor(15);
 for i:=1 to 2 do
 delay(65535);
 clrscr;
end;


Procedure xread(var ma:matr; var n,m:byte);

var
 i,j:byte;
Begin
 Writeln('Vvedite kolichestvo strok');
 readln(n);
 Writeln('Vvedite kolichestvo stolbcov');
 readln(m);
 for i:=1 to n do
  begin
   Writeln('Vvedite ',i,' stroku');
   for j:=1 to m do
   read(ma[i,j]);
  end;
end;

Function pol1(ma:matr;n,m:byte):integer;

Var
i,j:byte;
pol2:integer;

begin
 pol2:=0;
 for i:=1 to n do
  for j:=1 to m do
   if ma[i,j]>=0 then
     pol2:=pol2+1;pol1:=pol2;
end;


BEGIN
  zastavka;
  Xread(ma,n,m);
  pol:=pol1(ma,n,m);
  writeln ('Количество положительных элементов ',pol);
  readln;
  readln;
end.

Сообщение отредактировано: volvo - 5.06.2005 21:59

[электрик]

ИЗВИНИТЕ СКИНУЛ НЕ ТУ ЗАДАЧУ:( ТА ЗАДАЧАЧА ВЫДАЕТ СНАЧАЛА ЗАСТАВКУ ,А ПОТОМ СЩИТАЕТ В ВАШЕЙ МАТРИЦЕ ЧИСЛО ПОЛОЖИТЕЛЬНЫХ ЭЛЕМЕНТОВ, ПРИЧЕМ ВСЕ СДЕЛАННО ЧЕРЕЗ ПРОЦЕДУРЫ),А ЭТО ВОТ ТА САМААЯ ЗАДАЧА!!!

Исходный код

Program rgz2;
uses crt;
const
n = 10;
type
t = array[1..n] of integer;
v = array[1..n] of integer;

var
a : t;
b : v;
flag : boolean;

j:integer;
procedure massiv(n:integer; var a:t);
var j:integer;
begin

for j:=1 to n do begin
writeln( 'ўўҐ¤ЁвҐ',j,'-© н«Ґ¬Ґ­в 1-Ј® ¬ ббЁў ='); readln(a[j]);end;
writeln;
end;

procedure massiv1(n:integer; var b:v);
var j:integer;
begin

for j:=1 to n do begin
writeln( 'ўўҐ¤ЁвҐ',j,'-© н«Ґ¬Ґ­в 2-Ј® ¬ ббЁў ='); readln(b[j]);end;
writeln;
end;

Procedure bubble(n : integer; var a : t);
var
i, j, p : integer;
begin
for i := 2 to n do
for j := n downto i do
if a[j] < a[j-1] then
begin
p := a[j];
a[j] := a[j-1];
a[j-1] := p
end;
writeln('гЇ®а冷з­л© Ї®­ҐгЎлў ­Ёо 1 ¬ ббЁў');
for i := 1 to n do write(a[i], ' ');
writeln
end;
Procedure bubble1(n : integer; var b : v);
var
i, j, p : integer;
begin
for i := 2 to n do
for j := n downto i do
if b[j] < b[j-1] then
begin
p := b[j];
b[j] := b[j-1];
b[j-1] := p
end;
writeln('гЇ®а冷з­л© Ї®­ҐгЎлў ­Ёо 1 ¬ ббЁў');
for i := 1 to n do write(b[i], ' ');
writeln
end;

begin
massiv(n, a);
massiv1(n, B);
bubble(n, a);
bubble1(n, B);
begin
flag:=true;
for j:=1 to n do
flag:=flag and (a[j]=b[j]);
if flag then writeln('yes')else writeln('no'); end;
readln;
end.

KLEM4,А ТЫ ГОВОРИШЬ, ЧТО САМ НЕ РЕШАЮ....ПРОСТО Я ЭЛЕКТРИК В ПРЯМОМ СМЫСЛЕ УЧУСЬ НА ЭЛЕКТРОЭНЕРГЕТИЧЕСКОМ, И НЕ ШАРЮ В ВАШИХ ЯЗЫКАХ, ДА ЕЩЕ ПРЕПОД, НЕ ДАЙ БОГ ВАМ ТАКОГО.... ВОТ И ДОСТАЮ ВАС, ИЗВИНИТЕ КОНЕЧНО....

Вот только кричать не надо...

Сообщение отредактировано: volvo - 6.06.2005 14:17