IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Досрочный выход из цикла(while)
Engl
сообщение 15.01.2010 21:15
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Мужской
Реальное имя: Женя

Репутация: -  0  +


Здравствуйте,преподаватель заставил доделать 3 задачи,то есть заменить циклы for на while,у меня с этим туго получается..
Вот коды задачек:
1)Дана матрица и массив,нужно удалить эл-ты тех столбцов,которые присутствуют в массиве и вычислить сумму оставшихся столбцов

program abc;
 uses crt;
 const
  N=5; M=5; K=5;
var
 A: array[1..N,1..5] of integer;
 B: array[1..K] of integer;
 i,j,p,sum:integer;
Procedure zadan(p:integer); // 
 begin
  for j:=1 to M do
   A[j,p]:=0;
 end;
Procedure summa(p:integer);    //
 begin
  sum:=0;
  for i:=1 to N do
   sum:=sum+a[i,p];
   writeln('summa ',p,'-ro stlobza=',sum);
 end;                                //

begin
 clrscr;
 writeln('Vvodite elementbI matrizi A:');
 for i:=1 to N do
   for j:=1 to M do
    begin
     write('a[',i,',',j,']=');
     readln(a[i,j]);
    end;
 writeln('Vvodite elementbI massiva B:');
 for i:=1 to K do begin
  write('B[',i,']=');
  readln(b[i]);
  end;
  writeln;
  writeln('Na4alnii massiv:');
  for i:=1 to N do begin
   for j:=1 to M do
    write(a[i,j],', ');
    writeln; end; writeln;

 for p:=1 to M do begin   //    
  for i:=1 to K do
   if B[i]=p then begin zadan(p);end;
   if B[i]<>p then summa(p);
  end; writeln;            //
  writeln('Obrabotanna9 matriza: ');
    for i:=1 to N do begin
   for j:=1 to M do
    write(a[i,j],', ');
    writeln; end;
 readln;
end.

В этой задаче нужно заменить на while в этом месте


 for p:=1 to M do begin   //    
  for i:=1 to K do
   if B[i]=p then begin zadan(p); end;
   if B[i]<>p then summa(p);

Вот,что я попытался сделать:

p:=1;
i:=1;
while (p<>m) and (i<>k) do begin
if B[i]=p then begin zadan(p); end;
   if B[i]<>p then summa(p);
inc(p);
inc(i);


2) Дана матрица и массив,нужно сортировать методом пузырька по убыванию тех строк,которые присутствуют в массиве

program ABC;
 uses crt;
 const
   N=5; M=5; K=5;
 var
   C: array[1..N,1..M] of integer;
   D: array[1..K] of integer;
   i,j,o: integer;

Procedure Sort(o:integer);
  {Procedura sortirovki massiva, pereda4a globalnogo parametra "O"}
 var tmp,p:integer;
begin
 for p:=1 to M do                //  
  for j:=2 to M do
   if C[o,j]>C[o,j-1] then
    begin
      tmp:=C[o,j-1];
      C[o,j-1]:=C[o,j];
      C[o,j]:=tmp;
    end;                     //
end;
begin
 clrscr;
 writeln('Vvedite elementbI massiva C:'); {}
 for i:=1 to N do
   for j:=1 to M do
     begin
      write('C[',i,',',j,']=');
      readln(C[i,j]);
     end;
 writeln('Vvedite elementbI massiva D:');
 for i:=1 to K do
     begin
      write('D[',i,']=');
      readln(D[i]);
      if D[i]<=N then begin O:=D[i]; Sort(o); end;    
     end;
writeln;writeln('Otsortirovanna9 matriza:');writeln;
for i:=1 to 5 do begin
 for j:=1 to 5 do
   write(C[i,j],', ');
   writeln;
   end;
readln;
end.



В этой задаче нужно заменить на while в этом месте

for i:=1 to K do
     begin
      write('D[',i,']=');
      readln(D[i]);
      if D[i]<=N then begin O:=D[i]; Sort(o); end;    
     end;


Вот,что я попытался сделать:

i:=1
while i<>k do begin
 begin
      write('D[',i,']=');
      readln(D[i]);
      if D[i]<=N then begin O:=D[i]; Sort(o); end;    
     end;
inc(i);


3)Дана матрица и массив,нужно сортировать по убыванию методом установки эл-ты тех столбцов,которые присутствуют в массиве
program abc;
 uses crt;
 const
  N=5; M=5; k=7;
var
 C:array[1..n,1..n] of integer;
 d:array[1..k] of integer;
 zna4:boolean;
 i,j,p: integer;
procedure zadan(j:integer);  //      

var
tmp,h:integer;
 begin
 writeln('sortirovka stolbza ü ',j);
  for h:=1 to N do
   for i:=2 to N do
    if c[i-1,j]<c[i,j] then
     begin
      tmp:=c[i-1,j];
      c[i-1,j]:= c[i,j];
      c[i,j]:=tmp;
     end;
 end;             //
begin
 clrscr;
 writeln('Vvodite massiv C:');
 for i:=1 to N do
  for j:=1 to M do begin
   write('C[',i,',',j,']=');
   readln(c[i,j]);
  end;
 writeln('vvodite elementbI massiva D:');
   for i:=1 to K do
    begin
       write('D[',i,']=');
       readln(d[i]);
    end;

  writeln('Na4aln99 matriza: ');
  for i:=1 to N do begin
    for j:=1 to M do
      write(c[i,j],', ');
      writeln;
    end; writeln;
  for j:=1 to M do   
  
   begin
     for i:=1 to N do
       begin
        zna4:=false;
         for p:=1 to K  do
           if c[i,j]=D[p] then begin zna4:=true; break; end;
           if zna4=false then begin break; break end;
       end;
      if zna4=true then zadan(j);
   end;                           


 writeln;writeln('Obrabotanna9 matriza:');
   for i:=1 to N do begin
    for j:=1 to N do
      write(c[i,j],', ');
      writeln;
    end; writeln;
  readln;
end.

В этой задаче нужно заменить на while в этом месте
 for j:=1 to M do   
  
   begin
     for i:=1 to N do
       begin
        zna4:=false;
         for p:=1 to K  do
           if c[i,j]=D[p] then begin zna4:=true; break; end;
           if zna4=false then begin break; break end;
       end;
      if zna4=true then zadan(j);
   end;                           


Сообщение отредактировано: Engl - 15.01.2010 21:43
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 29.07.2025 17:36
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"