Дублирование столбцов матрицы

[Nusen'ka]

Помогите пожалуйста! с решением! дублирование столбцов матрицы, являющихся перестановкой элементов последнего столбца.

 

[Vadik(R)]

Может я твою проблему понял не до конца, но код у меня получился такой:

program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;
type
stolb = Array [1..10] of Integer;
var
a,b : Array [1..10] of stolb;
c,d : Stolb;
i,j,n,m,m1 : Integer;
Procedure QSort(l,r : Integer; var z : stolb);
Var
i,j,x,y : Integer;
Begin
i:=l;
j:=r;
x:=Z[(l+r) Div 2];
While j>=i Do
Begin
While Z[i]<x Do Inc(i);
While x<Z[j] Do Dec(j);
If NOT (i>j) Then
Begin
y:=Z[i];
Z[i]:=Z[j];
Z[j]:=y;
Inc(i);
Dec(j)
End
End;
If l<j Then QSort(l,j,z);
If i<r Then QSort(i,r,z)
End;
Function Compare(x,y : stolb) : Boolean;
Var
i : Integer;
Begin
Compare:=True;
For i:=1 To n Do
If x[i]<>y[i] Then
Begin
Compare:=False;
Break
End
End;
begin
Write('m='); Read(m);
Write('n='); Read(n);
For j:=1 To m Do
For i:=1 To n Do
Begin
Write('A[',j,',',i,']=');
Read(A[j,i])
End;
{For i:=1 To n Do
Begin
For j:=1 To m Do
Write(A[j,i]:4);
WriteLn
End;
Read(i);}
d:=A[m];
{For i:=1 To n Do Write(d[i]);}
QSort(1,n,d);
{For i:=1 To n Do Write(d[i]);}
For j:=1 To m-1 Do
Begin
c:=A[j];
QSort(1,n,c);
If (NOT Compare(A[j],A[m])) AND (Compare(c,d)) Then
Begin
Inc(m1);
B[m1]:=A[j]
End;
End;
For i:=1 To n Do
Begin
For j:=1 To m1 Do
Write(B[j,i]:4);
WriteLn
End;
Read(i); {типа ReadKey}
end.

Где m - количество столбцов, n - количество элементов в столбце.
В комментариях я оставлял вывод массива, а то тут с индексами вообще легко запутаться.
Главное представлять массив не так
A[1,1] A[1,2]
A[2,1] A[2,2].
А вот так
A[1,1] A[2,1] ... A[m,1]
A[1,2] A[2,2] ... A[m,2];
....
A[1,n] A[2,n] ... A[m,n].