Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.11.2008, 21:15   #1
TheKnyazz
Пользователь
 
Регистрация: 26.10.2008
Сообщений: 40
По умолчанию Задачка на уплотнение матрицы

Добрый вечер, господа программеры))Хотелось бы услышать от вас подсказку или хотя бы совет по решению задачки.
Вот собственно она:
"1. Уплотнить заданную матрицу, удаляя из нее строки и столбцы, заполненные ну-
лями.
2.Найти номер первой из строк, содержащих хотя бы один положительный
элемент."
Вот мои наброски, но я никак не пойму как решить условие 1
Код:
Program matrix;
Const nrow=3;
      ncol=3;
Type matrix=array[1..nrow,1..ncol] of Integer;
vector=array[1..nrow] of LongInt;
Var
a:matrix;
v:vector;

Procedure Vvod (Var a:matrix);
Var i,j:Integer;
Begin
Writeln('Введите элементы массива:');
For i:=1 to nrow do
For j:=1 to ncol do
Readln(a[i,j]);
End;

Procedure Vyvod (Const a:matrix; Const v:vector);
Var i,j:Integer;
Begin
For i:=1 to nrow do
Begin
For j:=1 to ncol do
Write(a[i,j]);
Writeln;
End;
End;


Procedure sort(var a: matrix;);
var i,j,k,z:integer;
Begin
k:=0;
for i:=1 to nrow do 
for j:=1 to ncol do
if a[i]=0 then 
  begin 
  k:=k+1;
  if k=nrow then 
  begin
  for i:=1 to nrow do
  for j:=1 to ncol
  do
  a[i,j]:=a[i+1,j];
  break;
  end;
  

if a[i,j]=0 then k:=k+1
 procedure plus(var a:matrix;);
 var i,j,z:integer;
 begin
 for i:=1 to nrow do
 for j:=1 to ncol do
 if A[i,j]>0 then
 begin
 k:=i;
 break;
 end
 end;

begin
vvod(a);
vyvod(a,v)
end.
Никак не могу разобраться с удалением и строк и столбцов сразу. Почему то в голову лезут только схемы убираня строки или столбца. путем создания новой таблицы и вписывания в новую таблицу всех значений кроме 0 строки или столбца.
TheKnyazz вне форума Ответить с цитированием
Старый 16.11.2008, 22:18   #2
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Вот программа по удалению строк и столбцов, содержащих ноли. Ее надо немного переделать, попробуй сам, а то у меня поздно, голова не варит. Процедуры сам напишешь. Если запутаешься, пиши.
Код:
uses crt;
var n,i,j,k,p,m,t,g:integer;
    a,b:array[1..50,1..50]of integer;
begin
clrscr;
write('n=');readln(n);
p:=n;  //запомним размер матрицы, т.к. будем его менять
randomize;
Writeln('Ishodnaja matrica:');
for i:=1 to n do
   begin
      for j:=1 to n do
         begin
           a[i,j]:=random(10);
           write(a[i,j]:4);
         end;
      writeln;
   end;
readln;
b:=a; //запомним исходную матрицу, будем ее 2 раза калечить
{Udalenie stroki s 0}
i:=1;
while i<=n do
   begin
     k:=0;
     for j:=1 to p do
     if a[i,j]=0 then
       begin
         k:=k+1;
       end;
     if k>0 then //здесь переделать
       begin
         for t:=1 to p do
         for m:=i to n-1 do
           begin
             a[m,t]:=a[m+1,t];
           end;
         n:=n-1;
       end
     else i:=i+1;
    end;
{Udalenie stolbca s 0}
writeln('Rezultat:');
g:=0;
for j:=1 to p do
   begin
     k:=0;
     for i:=1 to p do
     if b[i,j]=0 then
       begin
         k:=k+1;
       end;
     if k>0 then //здесь переделать
       begin
         for m:=1 to n do
         for t:=j-g to p-1 do
           begin
             a[m,t]:=a[m,t+1];
           end;
         g:=g+1;
       end
    end;
for i:=1 to n do
   begin
     for j:=1 to p-g do
     write(a[i,j]:4);
     writeln;
   end;
readln;
end.
puporev вне форума Ответить с цитированием
Старый 16.11.2008, 22:30   #3
TheKnyazz
Пользователь
 
Регистрация: 26.10.2008
Сообщений: 40
По умолчанию

Конечно, огромное спасибо) ща займусь!))
TheKnyazz вне форума Ответить с цитированием
Старый 16.11.2008, 23:21   #4
TheKnyazz
Пользователь
 
Регистрация: 26.10.2008
Сообщений: 40
По умолчанию

Посмотрите пожалуйста, на мои чудачества) Я наверно не правильно понял как именно нужно было подправить. Чего то я наверно не понял..
uses crt;
type matrix=array [1..50,1..50] of integer;
var n,i,j,p:integer;
a,b:matrix;

procedure U_s_s_0 (a,b:matrix; n,p:integer);
var i,j,k,t,m:integer;
begin
{Udalenie stroki s 0}
i:=1;
while i<=n do
begin
k:=0;
for j:=1 to p do
if a[i,j]=0 then
begin
k:=k+1;
end;
if k=n then //здесь переделать
begin
for t:=1 to p do
for m:=i to n-1 do
begin
a[m,t]:=a[m+1,t];
end;
n:=n-1;
end
else i:=i+1;
end;
end;

procedure U_st_s_0(var a,b:matrix;p:integer);
var i,j,m,t,g,k:integer;
{Udalenie stolbca s 0}
begin
writeln('Rezultat:');
g:=0;
for j:=1 to p do
begin
k:=0;
for i:=1 to p do
if b[i,j]=0 then
begin
k:=k+1;
end;
if k=p then //здесь переделать
begin
for m:=1 to n do
for t:=j-g to p-1 do
begin
a[m,t]:=a[m,t+1];
end;
g:=g+1;
end
end;
end;
Procedure vyvod(a:matrix; n:integer);
var i,j,g:integer;
begin
for i:=1 to n do
begin
for j:=1 to p-g do
write(a[i,j]:4);
writeln;
end;
readln;
end;

begin
clrscr;
write('n=');readln(n);
p:=n; //запомним размер матрицы, т.к. будем его менять
Writeln('Введите элементы массива:');
For i:=1 to n do
For j:=1 to n do
Readln(a[i,j]);
Writeln('Ishodnaja matrica:');
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:4);
writeln;
end;
readln;
b:=a; //запомним исходную матрицу, будем ее 2 раза калечить
U_s_s_0 (a,b,n,p);
U_st_s_0(a,b,p);
vyvod( a,n);
end.
TheKnyazz вне форума Ответить с цитированием
Старый 16.11.2008, 23:52   #5
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Ты зря обработку матрицы разбил на две процедуры, это одна процедура и здесь менять местами удаление строк и столбцов нельзя, а если отдельные процедуры, то можно. Здесь матрица преобразовывается постепенно, сначала строки, потом столбцы. Можно наоборот, но это всю процедуру переписывать надо. Когда код публикуешь, оформляй тегами, плохо читать. Кнопка в виде решетки над окном сообщений.
puporev вне форума Ответить с цитированием
Старый 16.11.2008, 23:55   #6
TheKnyazz
Пользователь
 
Регистрация: 26.10.2008
Сообщений: 40
По умолчанию

Вопрос, а там где править циклы, я правильно Вас понял?)
TheKnyazz вне форума Ответить с цитированием
Старый 16.11.2008, 23:58   #7
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Да, правильно. Я тоже посмотрю, надо еще кое-что поправить. Я это давно писал, там есть немного лишнее.
puporev вне форума Ответить с цитированием
Старый 17.11.2008, 00:25   #8
TheKnyazz
Пользователь
 
Регистрация: 26.10.2008
Сообщений: 40
По умолчанию

Код:
i:=1;
while i<=n do
   begin
     k:=0;
     for j:=1 to p do
     if a[i,j]=0 then
       begin
         k:=k+1;
       end;
     if k>0 then //здесь переделать
       begin
         for t:=1 to p do
         for m:=i to n-1 do
           begin
             a[m,t]:=a[m+1,t];
           end;
         n:=n-1;
       end
     else i:=i+1;
    end;
Вот не могу понять и все( В вашем примере if k>0 then и тд. На сколько я понимаю моей задачей есть поставить другую границу сравнения, чтобы замена шла только в случае if k=n then, так как теоретически это будет будет случаться только в случае когда все элементы равны 0. Но почему то у меня такая замена приводит к тому, что с матрицей ничего не происходит...скорей всего это низ-за неправильного указания параметров процедуры....
TheKnyazz вне форума Ответить с цитированием
Старый 17.11.2008, 00:37   #9
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

Вот, все поправил.
Код:
uses crt;
type matrix=array [1..50,1..50] of integer;
procedure Vvod(n:integer;var a:matrix); //входной-размер матрицы, выходной-сама матрица
var i,j:integer;
begin
Writeln('Введите элементы массива:');
For i:=1 to n do
For j:=1 to n do
Readln(a[i,j]);
clrscr;
Writeln('Исходная матрица:');
for i:=1 to n do
   begin
     for j:=1 to n do
     write(a[i,j]:4);
     writeln;
   end;
end;
Procedure vyvod(n,p:integer;var a:matrix); //Вывод результата. Входные-количество строк и столбцов, выходной-переделанная матрица
var i,j:integer;
begin
writeln('Результат:');
for i:=1 to n do
   begin
    for j:=1 to p do
    write(a[i,j]:4);
    writeln;
   end;
readln
end;
procedure U_s_s_0 (var n:integer;var p:integer; var a:matrix);//на входе начальный размер матрицы, сама матрица, на выходе измененное количество строк (n) и столбцов (р), измененная матрица
var i,j,k,t,m,g:integer;
    b:matrix;
begin
{Udalenie stroki s 0}
b:=a;p:=n;
i:=1;
while i<=n do
   begin
     k:=0;
     for j:=1 to p do
     if a[i,j]=0 then k:=k+1;
     if k=p then
        begin
          for t:=1 to p do
          for m:=i to n-1 do
          a[m,t]:=a[m+1,t];
          n:=n-1;  //итоговое количество строк
        end
     else i:=i+1;
   end;
{Udalenie stolbca s 0}
g:=0;
for j:=1 to p do
   begin
     k:=0;
     for i:=1 to p do
     if b[i,j]=0 then k:=k+1;
     if k=p then
       begin
         for m:=1 to n do
         for t:=j-g to p-1 do
         a[m,t]:=a[m,t+1];
         g:=g+1;
       end;
    end;
 p:=p-g;//итоговое количество столбцов
end;
var n,p:integer; //раздел переменных красивее сюда, чтобы параметры процедур были формальными
    a:matrix;
begin
clrscr;
write('n=');readln(n);
Vvod(n,a);
U_s_s_0 (n,p,a);
writeln('n=',n,'  p=',p);
vyvod(n,p,a);
end
puporev вне форума Ответить с цитированием
Старый 17.11.2008, 06:49   #10
TheKnyazz
Пользователь
 
Регистрация: 26.10.2008
Сообщений: 40
По умолчанию

Не поверите, когда я сам делал у меня получалось нечто похожее(именнно в цикле сортировки, я там изначально тоже пытался считать количество нулей и сравнивать с эталоном), только я зашел в тупик из-за того, забыл о замечательном цикле while, да и еще руки кривоваты правильно использовать в процедурах параметры - переменные, параметры-ф-ции. И поэтому у меня и данные тупили с переходом из процедуры в процедуры.
А почему вложенность допустим
Код:
begin
k:=k+1;
end;
Так влияла на результат?
TheKnyazz вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Обращение матрицы методом союзной матрицы dofmat Помощь студентам 6 03.10.2011 15:01
Матрицы FatalX Помощь студентам 21 17.04.2009 22:50
Матрицы Сапфира Помощь студентам 4 21.09.2008 16:10
Задачка в паскале на матрицы Марик Помощь студентам 2 25.06.2008 00:18
матрицы chelsi Паскаль, Turbo Pascal, PascalABC.NET 13 25.04.2008 10:07