Помогите пожалуйста оформить программу в виде модуля

Агнесса · 01.06.2016, 08:51

Помогите пожалуйста оформить программу ввиде модуля

program ex_8_16_v;
type Vector = array of integer;
Matrix = array of Vector;

var A : Matrix;
B : Vector;
l, n : integer;
f1 : text;

Procedure FormMatr(var X:Matrix);
var i, j : integer;
begin
for i := 0 to n-1 do
for j := 0 to n-1 do
X[i,j] := random(1,5);
end;

Procedure WriteMatr(var X:Matrix);
var i, j : integer;
begin
For i := 0 to n-1 do
begin
for j := 0 to n-1 do
Write(X[i,j]:4);
Writeln;
end;
end;

Function F(X : Matrix;i : integer):integer;
var j, S : integer;
begin
S := 1;
for j := 0 to n-1 do
S := S*X[j,i];
F := S;
end;

Procedure Selection(var X : Vector);
var i,j, nom, min : integer;
BEGIN
for i := 0 to n-2 do
begin
nom := i;
min := X[i];
for j := i+1 to n-1 do
if X[j] < min then
begin
min := X[j];
nom := j;
end;
X[nom] := X[i];
X[i] := min;
end;
END;

Procedure Exchange(var X : Vector);
var i, j, c : integer;
BEGIN
for i := 1 to n-1 do
for j := n-1 downto i do
if X[j-1] > X[j] then
begin
c := X[j-1];
X[j-1] := X[j];
X[j] := c;
end;
END;

Procedure Insertion2(var X : Vector);
var i, j, k, c : integer;
BEGIN
for i := 1 to n-1 do
begin
c := X[i];
j := i-1;
k := 0;
While j > -1 do
if X[i] > X[j] then
begin
k := j + 1;
j := -1;
end
else j := j - 1;
for j := i downto k + 1 do
X[j] := X[j-1];
X[k] := c;
end;
END;

begin
Assign(f1,'Otsortirovan.txt');
Rewrite(f1);
Write('Vvedite poryadok matricy n = ');
Readln(n);
Setlength(A,n);
For l := 0 to n-1 do
Setlength(A[l],n);
Setlength(B,n);
FormMatr(A);
// WriteMatr(A);
for l := 0 to n-1 do
// begin
B[l] := F(A,l);
// Write(B[l],' ');
// end;
Setlength(A,0);
Writeln('Kakim metodom osyshestvit sortirovky ?');
Writeln('1 - prostoi obmen.');
Writeln('2 - prostoi vybor.');
Writeln('3 - prostaya vstavka.');
Write('l = ');
Readln(l);
Case l of
1 : Exchange(B);
2 : Selection(B);
3 : Insertion2(B);
end;
for l := 0 to n-1 do
Write(f1,B[l],' ');
Close(f1);
Setlength(B,0);
end.

Vladimir_S · 01.06.2016, 11:57

Цитата:

Сообщение от Агнесса

Помогите пожалуйста оформить программу ввиде модуля

Пожалуйста.

Модуль:

Код:

Unit My_Unit;

Interface

const
 Nmax=100;

type
 Vector = array[0..Nmax-1] of integer;
 Matrix = array[0..Nmax-1] of Vector;

Procedure FormMatr(m:Integer; var X:Matrix);
Procedure WriteMatr(m:Integer; var X:Matrix);
Function F(m:Integer; X : Matrix;i : integer):integer;
Procedure Selection(m:Integer; var X : Vector);
Procedure Exchange(m:Integer; var X : Vector);
Procedure Insertion2(m:Integer; var X : Vector);

Implementation

Procedure FormMatr(m:Integer; var X:Matrix);
var i, j : integer;
begin
 for i := 0 to m-1 do
  for j := 0 to m-1 do
   X[i,j] := 1+random(5);
end;

Procedure WriteMatr(m:Integer; var X:Matrix);
var i, j : integer;
begin
 For i := 0 to m-1 do
  begin
   for j := 0 to m-1 do
   Write(X[i,j]:6);
   Writeln;
  end;
end;

Function F(m:Integer; X : Matrix;i : integer):integer;
var j, S : integer;
begin
 S := 1;
 for j := 0 to m-1 do
  S := S*X[j,i];
 F := S;
end;

Procedure Selection(m:Integer;var X : Vector);
var i,j, nom, min : integer;
BEGIN
 for i := 0 to m-2 do
  begin
   nom := i;
   min := X[i];
   for j := i+1 to m-1 do
   if X[j] < min then
    begin
     min := X[j];
     nom := j;
    end;
   X[nom] := X[i];
   X[i] := min;
  end;
END;

Procedure Exchange(m:Integer; var X : Vector);
var i, j, c : integer;
BEGIN
 for i := 1 to m-1 do
  for j := m-1 downto i do
   if X[j-1] > X[j] then
    begin
     c := X[j-1];
     X[j-1] := X[j];
     X[j] := c;
    end;
END;

Procedure Insertion2(m:Integer; var X : Vector);
var i, j, k, c : integer;
BEGIN
 for i := 1 to m-1 do
  begin
   c := X[i];
   j := i-1;
   k := 0;
   While j > -1 do
    if X[i] > X[j] then
     begin
      k := j + 1;
      j := -1;
     end else
      j := j - 1;
   for j := i downto k + 1 do
    X[j] := X[j-1];
   X[k] := c;
  end;
END;

End.

Программа:

Код:

program ex_8_16_v;

Uses My_Unit;

var
 A : Matrix;
 B : Vector;
 l,n : integer;
 f1 : text;

begin
 Randomize;
 Assign(f1,'Otsort.txt');
 Rewrite(f1);
 Write('Vvedite poryadok matricy n = ');
 Readln(n);
 FormMatr(n,A);
 WriteMatr(n,A);
 for l := 0 to n-1 do
  begin
   B[l] := F(n,A,l);
   Write(B[l]:6);
  end;
 Writeln;
 Writeln('Kakim metodom osyshestvit sortirovky ?');
 Writeln('1 - prostoi obmen.');
 Writeln('2 - prostoi vybor.');
 Writeln('3 - prostaya vstavka.');
 Readln(l);
 Case l of
  1 : Exchange(n,B);
  2 : Selection(n,B);
  3 : Insertion2(n,B);
 end;
 for l := 0 to n-1 do
  Write(f1,B[l]:6);
 for l := 0 to n-1 do
  Write(B[l]:6);
 Close(f1);
 Readln
end.

Несколько замечаний:
1. Имя файла модуля, имя самого модуля и, естественно, имя в строке программы в разделе USES должны строго совпадать. В данном случае модуль следует сохранить в файле MyUnit.pas. Хотите изменить имя - меняйте в трёх местах.
2. Несколько изменил программу под свой DOS-Паскаль (укоротил длинное имя файла, ввел диапазоны в векторный и матричный тип - без них мой Паскаль не понимает). Но это непринципиально.
3. Убрал эти Setlength - и без них работает. К тому же первая из них, когда применяется к матрице, - ошибочна.

Агнесса · 01.06.2016, 13:03

Подскажите пожалуйста ,верно ли я оформила программу ввиде модуля.
вот программа:
program Sortirovka_massiva_part_two;

const stlb = 5;
str = 5;

type Vector = array[1..stlb] of real;
Massiv = array[1..str] of Vector;

VAR B : Massiv;
v, l : integer;
F1, F2 : text;

procedure FormMassiv(var A : Massiv);
var i, j : integer;
begin
for i := 1 to str do
for j := 1 to stlb do
A[i,j] := random(-1000,1500);
end;

function F(Y : vector):Real;
var j : integer;
S : real;
begin
S := 0;
for j := 1 to stlb do
S := S + Y[j];
F := S;
end;

procedure StraightSelection;
VAR
i, j,
nom : integer ;
min : Vector;
Begin
for i := 1 to str-1 do
begin
nom := i;
min := B[i];
for j := i + 1 to str do
if F(B[j]) > F(min) then
begin
min := B[j];
nom := j;
end;
B[nom] := B[i];
B[i] := min;
end;
end;

begin
Assign(F1,'Result_of_sortirovka_Matrix.txt');
Assign(F2,'Result_pervichnaya_Matrix.txt');
Rewrite(F1);
Rewrite(F2);
FormMassiv(B);
For v := 1 to str do
begin
for l := 1 to stlb do
Write(F2,B[v,l]:6,' ');
Writeln(F2);
end;
StraightSelection;
For v := 1 to str do
begin
for l := 1 to stlb do
Write(F1,' ',B[v,l]:6,' ');
Writeln(F1);
Write(F(B[v]),' ');
// Write(F(v),' ');
end;
Close(F1);
Close(F2);
end.
вот модуль:
unit sortmas;
interface
const stlb = 5;str = 5;
type Vector = array[1..stlb] of real;
Massiv = array[1..str] of Vector;
VAR B : Massiv;
procedure FormMassiv(var A : Massiv);
function F(Y : vector):Real;
procedure StraightSelection;
implementation
procedure FormMassiv;
var i, j : integer;
begin
for i := 1 to str do
for j := 1 to stlb do
A[i,j] := random(-1000,1500);
end;
function F:Real;
var j : integer;S : real;
begin
S := 0;
for j := 1 to stlb do
S := S + Y[j];
F := S;
end;
procedure StraightSelection;
VAR i, j,nom : integer ;min : Vector;
Begin
for i := 1 to str-1 do
begin
nom := i;
min := B[i];
for j := i + 1 to str do
if F(B[j]) > F(min) then
begin
min := B[j];
nom := j;
end;
B[nom] := B[i];
B[i] := min;
end;
end;
program ex_1;
uses sortmas;
VAR v, l : integer;F1, F2 : text;
begin
Assign(F1,'Result_of_sortirovka_Matrix.txt');
Assign(F2,'Result_pervichnaya_Matrix.txt');
Rewrite(F1);
Rewrite(F2);
FormMassiv(B);
For v := 1 to str do
begin
for l := 1 to stlb do
Write(F2,B[v,l]:6,' ');
Writeln(F2);
end;
StraightSelection;
For v := 1 to str do
begin
for l := 1 to stlb do
Write(F1,' ',B[v,l]:6,' ');
Writeln(F1);
Write(F(B[v]),' ');
// Write(F(v),' ');
end;
Close(F1);
Close(F2);
end.

Debianer · 02.06.2016, 05:29

Что-то не увидел в программе указание использовать модуль. Вот это:
uses sortmas;

AlexZir · 02.06.2016, 10:43

Точно, в основной программе нет после заголовка строки uses sortmas;

01.06.2016, 08:51	#1 (permalink)
Агнесса Новичок Регистрация: 06.05.2016 Сообщений: 5 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Помогите пожалуйста оформить программу в виде модуля Помогите пожалуйста оформить программу ввиде модуля program ex_8_16_v; type Vector = array of integer; Matrix = array of Vector; var A : Matrix; B : Vector; l, n : integer; f1 : text; Procedure FormMatr(var X:Matrix); var i, j : integer; begin for i := 0 to n-1 do for j := 0 to n-1 do X[i,j] := random(1,5); end; Procedure WriteMatr(var X:Matrix); var i, j : integer; begin For i := 0 to n-1 do begin for j := 0 to n-1 do Write(X[i,j]:4); Writeln; end; end; Function F(X : Matrix;i : integer):integer; var j, S : integer; begin S := 1; for j := 0 to n-1 do S := SX[j,i]; F := S; end; Procedure* Selection(var X : Vector); var i,j, nom, min : integer; BEGIN for i := 0 to n-2 do begin nom := i; min := X[i]; for j := i+1 to n-1 do if X[j] < min then begin min := X[j]; nom := j; end; X[nom] := X[i]; X[i] := min; end; END; Procedure Exchange(var X : Vector); var i, j, c : integer; BEGIN for i := 1 to n-1 do for j := n-1 downto i do if X[j-1] > X[j] then begin c := X[j-1]; X[j-1] := X[j]; X[j] := c; end; END; Procedure Insertion2(var X : Vector); var i, j, k, c : integer; BEGIN for i := 1 to n-1 do begin c := X[i]; j := i-1; k := 0; While j > -1 do if X[i] > X[j] then begin k := j + 1; j := -1; end else j := j - 1; for j := i downto k + 1 do X[j] := X[j-1]; X[k] := c; end; END; begin Assign(f1,'Otsortirovan.txt'); Rewrite(f1); Write('Vvedite poryadok matricy n = '); Readln(n); Setlength(A,n); For l := 0 to n-1 do Setlength(A[l],n); Setlength(B,n); FormMatr(A); // WriteMatr(A); for l := 0 to n-1 do // begin B[l] := F(A,l); // Write(B[l],' '); // end; Setlength(A,0); Writeln('Kakim metodom osyshestvit sortirovky ?'); Writeln('1 - prostoi obmen.'); Writeln('2 - prostoi vybor.'); Writeln('3 - prostaya vstavka.'); Write('l = '); Readln(l); Case l of 1 : Exchange(B); 2 : Selection(B); 3 : Insertion2(B); end; for l := 0 to n-1 do Write(f1,B[l],' '); Close(f1); Setlength(B,0); end.

01.06.2016, 08:51
Helpmaster Member Регистрация: 08.03.2016 Сообщений: 0	Подскажу вам, что решение проблемы может крыться в аналогичных обсуждениях Реализовать в виде модуля набор подпрограмм Имя модуля с ошибкой: StackHash_c2c0, Помогите пожалуйста.

01.06.2016, 13:03	#3 (permalink)
Агнесса Новичок Регистрация: 06.05.2016 Сообщений: 5 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Подскажите пожалуйста ,верно ли я оформила программу ввиде модуля. вот программа: program Sortirovka_massiva_part_two; const stlb = 5; str = 5; type Vector = array[1..stlb] of real; Massiv = array[1..str] of Vector; VAR B : Massiv; v, l : integer; F1, F2 : text; procedure FormMassiv(var A : Massiv); var i, j : integer; begin for i := 1 to str do for j := 1 to stlb do A[i,j] := random(-1000,1500); end; function F(Y : vector):Real; var j : integer; S : real; begin S := 0; for j := 1 to stlb do S := S + Y[j]; F := S; end; procedure StraightSelection; VAR i, j, nom : integer ; min : Vector; Begin for i := 1 to str-1 do begin nom := i; min := B[i]; for j := i + 1 to str do if F(B[j]) > F(min) then begin min := B[j]; nom := j; end; B[nom] := B[i]; B[i] := min; end; end; begin Assign(F1,'Result_of_sortirovka_Matrix.txt'); Assign(F2,'Result_pervichnaya_Matrix.txt'); Rewrite(F1); Rewrite(F2); FormMassiv(B); For v := 1 to str do begin for l := 1 to stlb do Write(F2,B[v,l]:6,' '); Writeln(F2); end; StraightSelection; For v := 1 to str do begin for l := 1 to stlb do Write(F1,' ',B[v,l]:6,' '); Writeln(F1); Write(F(B[v]),' '); // Write(F(v),' '); end; Close(F1); Close(F2); end. вот модуль: unit sortmas; interface const stlb = 5;str = 5; type Vector = array[1..stlb] of real; Massiv = array[1..str] of Vector; VAR B : Massiv; procedure FormMassiv(var A : Massiv); function F(Y : vector):Real; procedure StraightSelection; implementation procedure FormMassiv; var i, j : integer; begin for i := 1 to str do for j := 1 to stlb do A[i,j] := random(-1000,1500); end; function F:Real; var j : integer;S : real; begin S := 0; for j := 1 to stlb do S := S + Y[j]; F := S; end; procedure StraightSelection; VAR i, j,nom : integer ;min : Vector; Begin for i := 1 to str-1 do begin nom := i; min := B[i]; for j := i + 1 to str do if F(B[j]) > F(min) then begin min := B[j]; nom := j; end; B[nom] := B[i]; B[i] := min; end; end; program ex_1; uses sortmas; VAR v, l : integer;F1, F2 : text; begin Assign(F1,'Result_of_sortirovka_Matrix.txt'); Assign(F2,'Result_pervichnaya_Matrix.txt'); Rewrite(F1); Rewrite(F2); FormMassiv(B); For v := 1 to str do begin for l := 1 to stlb do Write(F2,B[v,l]:6,' '); Writeln(F2); end; StraightSelection; For v := 1 to str do begin for l := 1 to stlb do Write(F1,' ',B[v,l]:6,' '); Writeln(F1); Write(F(B[v]),' '); // Write(F(v),' '); end; Close(F1); Close(F2); end.

02.06.2016, 05:29	#4 (permalink)
Debianer Member Регистрация: 07.08.2012 Адрес: Находка, Приморский край Сообщений: 336 Сказал(а) спасибо: 14 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 1671	Что-то не увидел в программе указание использовать модуль. Вот это: uses sortmas;

02.06.2016, 10:43	#5 (permalink)
AlexZir support Регистрация: 19.08.2007 Адрес: Зея Сообщений: 15,797 Записей в дневнике: 71 Сказал(а) спасибо: 166 Поблагодарили 203 раз(а) в 86 сообщениях Репутация: 75760	Точно, в основной программе нет после заголовка строки uses sortmas;

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070