Здравствуйте, помогите пожалуйста с программой.
----------------------------------------------------------------
Задача:
Напечатать последовательно все различающиеся между собой столбцы символьной матрицы.
Мое решение:

program simv_massive;
uses crt;
const str=30;
      stp=40;
type MyArr=array[1..str,1..stp] of char;
     MyArrSp=array[1..str] of char;
var mas:MyArr;
    x:MyArrSp;
    i,j,k,n,m:byte;
    num:integer;

 procedure Matr_In(var mas1:MyArr; n1,m1:byte);
 var
  i,j:byte;
 begin
  for i:=1 to n1 do
   begin
    for j:=1 to m1 do
    read(mas1[i,j]);
    readln;
   end;
 end;

 procedure Matr_Out(var mas2:MyArr; n2,m2:byte);
 var
  i,j:byte;
 begin
  for i:=1 to n2 do
   begin
    for j:=1 to m2 do
     write(mas2[i,j]:5);
     writeln;
   end;
 end;

begin
 clrscr;
 Write('Введите количество строк:');
 Readln(n);
 Write('Введите количество столбцов:');
 Readln(m);
 Writeln('Заполните массив');
 Matr_In(mas,n,m);
 Writeln('Вы ввели массив');
 Matr_Out(mas,n,m);

 for j:=1 to m do
  begin
   num:=0;
   for i:=1 to n do
    if mas[i,j]=x[i] then
     num:=num+1;

   if num<>n then
    for i:=1 to n do
     writeln(mas[i,j]);

   for i:=1 to n do
    x[i]:=mas[i,j];
  end;
 writeln;
 readkey
end.

Начну сначала, подскажите вывести столбцы последовательно это так

или можно и так

моя программа естественно выводит во втором варианте...
-------------------------------------
дальше, у меня она не выводит одинаковые столбцы если только одинаковые столбцы идут друг за другом, подскажите пожалуйста как сделать чтобы работала полноценно.
буду очень благодарен
-------------------------------------
приветствуется критика по поводу процедур ввода вывода массива

надо проверить элементы столбца с элементами всех других столбцов.

uses crt;
const str=10;
      stp=10;

type
     MyArrSp = array[ 1..str] of char;
     MyArr = array [1..stp] of MyArrSp;

var mas : MyArr;
    x : MyArrSp;
    i, j, k, n, m : byte;
    num:integer;

 procedure Matr_In(var mas1:MyArr; n1,m1:byte);
 var
  i,j:byte;
 begin
  for i := 1 to n1 do
   begin
    for j := 1 to m1 do
    read (mas1 [i, j] );
   end;
 end;

 procedure Matr_Out(var mas2:MyArr; n2,m2:byte);
 var
  i,j:byte;
 begin
  for i:=1 to n2 do
   begin
    for j:=1 to m2 do
     write(mas2[i,j]:5);
    writeln;
   end;
 end;

 procedure find(var MyMas : MyArr; n1, m1 : byte);
 var
    i, j, k : byte;
    flag : boolean;
    mn : set of byte;
 begin
    mn := [];
    for i := 1 to m do begin

        for j := i+1 to m do begin
           flag := true;
           for k := 1 to n do
              if (MyMas[k, i] <> MyMas[k, j]) then flag := false;
           if flag then mn := mn + [i];
        end;
    end;
    for i := 1 to n do begin
        for j := 1 to m do
           if not (j in mn) then
              write( MyMas[i,j]:5);
        writeln;
    end;
 end;

begin
 clrscr;
 Write('Введите количество строк:');
 Readln(n);
 Write('Введите количество столбцов:');
 Readln(m);
 Writeln('Заполните массив');
 Matr_In(mas,n,m);
 Writeln('Вы ввели массив');
 Matr_Out(mas,n,m);
 writeln;
 find(mas, n, m);

 readkey
end.

Проверяй

Client
Большое спасибо за помощь, сейчас постараюсь разобраться...
Вы множества да использовали? Я тип множества еще не знаю, сейчас буду "узнавать", или может можно как-то без них справиться?
------------------------------
По поводу ввода массива, мне нельзя его вводить в одну строчку или по одному символу в каждой строке, с числовым массивом никаких проблем, а вот в символьном проблема! Есть у кого идеи?
------------------------------
Ну и еще можно глупый вопрос, просто интересно уже не первый раз встречаю в других программах идентификатор (flag) почему именно flag ? Есть этому объяснения?
Если глупость спрашиваю не пинайте
Буду благодарен за помощь)

Конечно, можно. Я бы сказал, даже нужно. Вообще не понимаю, зачем усложнять (и ограничивать) простые вещи..
------------------------------
А зачем вообще его вводить? В условии это не оговорено. Сделай ввод случайным процессом.
------------------------------
Совсем не глупость, наоборот - проявление здорового интереса в к вопросу (что так нечасто бывает..) Поднять флажок, опустить флажок, выставить флаг, убрать флаг - это все действия, которые моделируют реальную отметку, например, на карте (в генеральном штабе)), на почтовом ящике (в России не принято, а в остальных странах - сплошь и рядом: Нажмите для просмотра прикрепленного файла - почтальон кладет конверт и поднимает флаг (картинка отсюда) ). Мой массив f - тоже сокращение от этого слова. В данном слуяае флаг означает, что столбец с этим номером выводить НАДО. Сначала я поднимаю все флаги (f[i]:=true), а потом сбрасываю их по мере обработки.

Вот так будет малька попроще, думаю:

const
  m=10; // row length, or number of columns
  n=3; // number of rows, or column length

var
  a: array[1..n,1..m]of char;
  f: array[1..m]of boolean;
  i,j,k: integer;

begin
  for i:=1 to n do for j:=1 to m do a[i,j]:=Chr(Random(3)+65);
  for i:=1 to m do f[i]:=true;
  WriteLn('initial array:');
  for i:=1 to n do begin
    for j:=1 to m do Write(a[i,j]:2);
    WriteLn
  end;
  for i:=1 to m do if f[j] then
    for j:=i+1 to m do if f[j] then begin
      k:=1;
      while (a[k,i]=a[k,j]) and (k<n) do Inc(k);
      f[j]:=(k<n) or (a[k,i]<>a[k,j]);
      f[i]:=f[i] and f[j]   { < == убрать эту строку, чтобы выводить первую копию }
    end;
  WriteLn('developed array:');
  for i:=1 to n do begin
    for j:=1 to m do if f[j] then Write(a[i,j]:2);
    WriteLn
  end;
  ReadLn
end.

P.S.
Прогнал прогу Client'а и подумал, что кто-то из нас неверно трактует условие. Клиент, похоже, выводит хотя бы один из повторяющихся столбцов. А я вообще не вывожу столбец, если у него есть дубль. sum42, пожалуйста, уточни условие.

Кстати, мое решение легко модифицировать, чтоб оно выдавало хотя бы одну копию (выбросить дубли, оригиналы оставить). Достаточно убрать одну строку (я пометил в коде).

P.P.S.
При всем моем уважении, просьба к тебе:
- старайся более аккуратно форматировать коды для новичков - пусть привыкают (да и ты заодно));
- не надо подавать новичкам дурной пример постоянного сования юнита CRT где ни попадя только для того, чтоб сделать задержку (а если он уже есть в проге, лучше выкинуть на фиг )

имхо, он засунут ради очистки экрана.

а мне надо чуть меньше действий

if flag then mn := mn + [i];

тут добавить еще и [j] в множество.
И еще. Я лишь добавил процедуру и убрал немного кода. Так что почти все тут от автора осталось

... что само по себе есть неправильное и вредное действие..

Lapp
Большое спасибо за помощь, сейчас буду разбираться.

Мне с именно клавиатуры ввести нужно.

один раз выводит надо, последующие копии (если будут) нет...

Lapp
Разбираю ваш код
Вроде где-то не совсем правильно(выводит одинаковые столбцы)
Нажмите для просмотра прикрепленного файла
думаю как поправить
------------------------------------------------
добавлено позже
кажется нашел ошибку

for i:=1 to m do if f[j] then
    for j:=i+1 to m do if f[j] then begin
      k:=1;
      while (a[k,i]=a[k,j]) and (k<n) do Inc(k);
      f[j]:=(k<n) or (a[k,i]<>a[k,j]);
      f[i]:=f[i] and f[j]   { < == убрать эту строку, чтобы выводить первую копию }
    end;

в первой строчке f[i] а не f[j]??
поправьте если что...
------------------------------------------------------
продолжаю разбираться дальше...

for i:=1 to m do if f[
 i ] then

попробуй так

Да, конечно )). Извиняюсь..


Добавлено через 4 мин.
sum42, а как насчет уточнения условия? Вопрос пропущен мимо ушей? Смотри, твои следующие могут пойти тем же путем, диалог есть диалог..

ну я вроде ответил выше

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