Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Программирование [игнор отключен] [закрыт для гостей] / модуль на паскале / 9 сообщений из 9, страница 1 из 1
28.03.2009, 13:13:59
    #35897877
Ivan_!!
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
Здравствуйте, можете посмотреть или исправить если че не итак сделал... выводит чет не те результаты(
задание:
Составить библиотеку, реализующую следующие алгоритмы для обработки матриц:
- определить скалярное произведение L строки на K столбец (матрица квадратная);
- определить, является ли целая квадратная матрица ортонормированной, т.е. такой, в которой скалярное произведение каждой пары различных строк равно 0, а скалярное произведение каждой строки на себя равно 1;
- вычислить норму матрицы:
а) норма матрицы - это наибольшее значение из модулей элементов,
б) норма матрицы - это наибольшее значение из сумм модулей элементов строк.
- определить наименьший элемент в столбце.

-----------------------------------------------------------------
модуль
unit dd;
interface
const n=2;
m=2;
type masiv=array[1..n,1..m] of real ;
var
i,j :byte;
min,jmin,s,imax,max,k,f,g:real;
procedure ckalyarnoe(mas:masiv);
procedure ortonormirovannay(mas:masiv);
procedure norma1(mas:masiv);
procedure norma2(mas:masiv);
procedure minimal(mas:masiv);
implementation
procedure norma1;
begin
max:=mas[1,1];imax:=1;

for i:=1 to n do
for j:=1 to m do
if abs(mas[i,j])>max then
begin
max:=mas[i,j] ;
imax:=i ;
writeln('Max element ',imax:2:2);
end;
end;

procedure ckalyarnoe;
begin
for i:=1 to m do
begin
f:=f+mas[1,j]*mas[i,1];
writeln('Ckalarnui ',f);
end;
end;

procedure ortonormirovannay ;
begin
for i:=1 to m do
g:=f+mas[1,j]*mas[2,j];
k:=k+mas[1,j]*mas[1,j];
if (g=0) and (k=1) then writeln('Matrica ortonormirovannay ');

end;

procedure norma2;
begin
s:=0 ;
for j:=1 to m do;
s:=s+abs(j);
writeln('Summa ',s);
end;

procedure minimal;
begin
min:=mas[1,1] ; jmin:=1 ;
for i:=1 to n do
for j:=1 to m do
if mas[i,j] < min then
begin
min:=mas[i,j];
jmin:=j;
writeln('Minimal ',jmin);
end;
end;
end.
------------------------------------------------------------
вызывающая программа
program g4;
uses crt,DD;
const n=2 ;
m=2 ;

var mas:masiv;
i,j: byte;
min,jmin,max,imax,s,f,g,k:real;
begin
clrscr;
randomize ;
for i:=1 to n do
for j:=1 to m do
mas[i,j]:=random(10);
for i:=1 to n do
begin
for j:=1 to m do
write(mas[i,j]:2:2,' ');
writeln;
end;
writeln;
norma1(mas);
ckalyarnoe(mas);
ortonormirovannay(mas);
minimal(mas);
norma2(mas);
end.
...
Рейтинг: 0 / 0
28.03.2009, 13:21:53
    #35897884
BION
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
Ivan_!!,

Ну неуже ли трудно код заключать в "[src][/SRC]". Он же не читабелен!
...
Рейтинг: 0 / 0
28.03.2009, 13:53:32
    #35897927
Ivan_!!
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
unit dd;
interface
const n= 2 ;
m= 2 ;
type masiv=array[ 1 ..n, 1 ..m] of real ;
var
i,j :byte;
min,jmin,s,imax,max,k,f,g:real;
procedure ckalyarnoe(mas:masiv);
procedure ortonormirovannay(mas:masiv);
procedure norma1(mas:masiv);
procedure norma2(mas:masiv);
procedure minimal(mas:masiv);
implementation
procedure norma1;
begin
max:=mas[ 1 , 1 ];imax:= 1 ;

for i:= 1  to n do
for j:= 1  to m do
if abs(mas[i,j])>max then
begin
max:=mas[i,j] ;
imax:=i ;
writeln('Max element ',imax: 2 : 2 );
end;
end;

procedure ckalyarnoe;
begin
for i:= 1  to m do
begin
f:=f+mas[ 1 ,j]*mas[i, 1 ];
writeln('Ckalarnui ',f);
end;
end;

procedure ortonormirovannay ;
begin
for i:= 1  to m do
g:=f+mas[ 1 ,j]*mas[ 2 ,j];
k:=k+mas[ 1 ,j]*mas[ 1 ,j];
if (g= 0 ) and (k= 1 ) then writeln('Matrica ortonormirovannay ');

end;

procedure norma2;
begin
s:= 0  ;
for j:= 1  to m do;
s:=s+abs(j);
writeln('Summa ',s);
end;

procedure minimal;
begin
min:=mas[ 1 , 1 ] ; jmin:= 1  ;
for i:= 1  to n do
for j:= 1  to m do
if mas[i,j] < min then
begin
min:=mas[i,j];
jmin:=j;
writeln('Minimal ',jmin);
end;
end;
end.


--------------------------------
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
program g4;
uses crt,DD;
const n= 2  ;
m= 2  ;

var mas:masiv;
i,j: byte;
min,jmin,max,imax,s,f,g,k:real;
begin
clrscr;
randomize ;
for i:= 1  to n do
for j:= 1  to m do
mas[i,j]:=random( 10 );
for i:= 1  to n do
begin
for j:= 1  to m do
write(mas[i,j]: 2 : 2 ,' ');
writeln;
end;
writeln;
norma1(mas);
ckalyarnoe(mas);
ortonormirovannay(mas);
minimal(mas);
norma2(mas); 
end.
...
Рейтинг: 0 / 0
28.03.2009, 14:28:43
    #35897968
Aklin J
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
кликаем ЦИТИРОВАТЬ, копируем код, потом отвечаем заключив код в SRC
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
unit dd;
interface
          const n= 2 ;
               m= 2 ;
           type masiv=array[ 1 ..n, 1 ..m] of real ;
             var
               i,j :byte;
          min,jmin,s,imax,max,k,f,g:real;
              procedure ckalyarnoe(mas:masiv);
              procedure ortonormirovannay(mas:masiv);
              procedure norma1(mas:masiv);
              procedure norma2(mas:masiv);
              procedure minimal(mas:masiv);
implementation
        procedure norma1;
        begin
          max:=mas[ 1 , 1 ];imax:= 1 ;

                   for i:= 1  to n do
                   for j:= 1  to m do
                   if abs(mas[i,j])>max then
                   begin
                   max:=mas[i,j] ;
                   imax:=i ;
                   writeln('Max element ',imax: 2 : 2 );
                   end;
              end;

        procedure ckalyarnoe;
        begin
          for i:= 1  to m do
          begin
            f:=f+mas[ 1 ,j]*mas[i, 1 ];
          writeln('Ckalarnui ',f);
        end;
         end;

        procedure ortonormirovannay ;
         begin
            for i:= 1  to m do
                g:=f+mas[ 1 ,j]*mas[ 2 ,j];
                k:=k+mas[ 1 ,j]*mas[ 1 ,j];
           if (g= 0 ) and (k= 1 ) then writeln('Matrica ortonormirovannay ');

           end;

           procedure norma2;
           begin
           s:= 0  ;
           for j:= 1  to m do;
           s:=s+abs(j);
           writeln('Summa ',s);
           end;

           procedure minimal;
           begin
   min:=mas[ 1 , 1 ] ; jmin:= 1    ;
  for i:= 1  to n do
  for j:= 1  to m do
  if mas[i,j] < min then
 begin
 min:=mas[i,j];
 jmin:=j;
 writeln('Minimal ',jmin);
 end;
 end;
 end.
------------------------------------------------------------
вызывающая программа
program g4;
uses  crt,DD;
const n= 2  ;
      m= 2  ;

var mas:masiv;
i,j: byte;
min,jmin,max,imax,s,f,g,k:real;
 begin
  clrscr;
           randomize ;
           for i:= 1  to n do
               for j:= 1  to m do
                  mas[i,j]:=random( 10 );
              for i:= 1  to n do
                 begin
                    for j:= 1  to m do
                       write(mas[i,j]: 2 : 2 ,' ');
                       writeln;
                   end;
               writeln;
               norma1(mas);
               ckalyarnoe(mas);
               ortonormirovannay(mas);
               minimal(mas);
               norma2(mas); 
end.
...
Рейтинг: 0 / 0
28.03.2009, 14:29:17
    #35897969
Aklin J
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
P/S оригинальная орфиграция сохранена

а ты что думал, в cказку попал?(с)
4 8 15 16 23 42
...
Рейтинг: 0 / 0
28.03.2009, 20:11:27
    #35898232
Ivan_!!
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
я что так и не догнал как считать( результаты ваще не те. может кто-нибудь подскажет. Зарание спасибо!
Aklin J спасибо за правильно выложенный код.
...
Рейтинг: 0 / 0
28.03.2009, 20:42:33
    #35898256
mayton
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
Для модульного теста надо брать не randomize значения, а заранее расчитанные, т.е. те по которым можно сказать, что тест успешно пройден. Или ты думаешь, что мы все тут будем в уме матрицы вычислять?

Возьми решебник по матрицам с готовыми примерами и ответами.
...
Рейтинг: 0 / 0
23.03.2010, 18:06:57
    #36537898
Mantikor123
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
такае же проблема помогите Где-та ошибка а где и какая не могу разабрать

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
unit dz;
interface uses crt;

procedure max_elment;
procedure ser_arifm;
procedure ser_geomet;

const n= 3 ;m= 4 ;
var
    a:array[ 1 ..n, 1 ..m] of integer;
    maxm,sym:array[ 1 ..n] of integer;
    serge,serar:array[ 1 ..n] of real;
    i,j,max,w,nom,syma:integer;
    sergea:real;


implementation

procedure max_element;
begin
for i:= 1  to n do begin maxm[i]:=a[i, 1 ];
    for j:= 1  to m do begin
if a[i,j]>maxm[i] then maxm[i]:=a[i,j];
                     end;
                  end;
for i:= 1  to n do begin
write('max= ',maxm[i]); writeln;
                 end;
end;




procedure ser_arifm;
begin
for i:= 1  to n do begin
    nom:= 0 ;
    for j:= 1  to m do
        if odd(i) then begin sym[i]:=sym[i]+a[i,j]; nom:=nom+ 1 ;end;
    if odd(i) then begin serar[i]:=sym[i]/nom;
                         write('ser arifm radoka= ',serar[i]: 0 : 2 ); writeln;
                   end;
                 end;
end;


procedure ser_geomet;
begin
for i:= 1  to n do begin
    nom:= 0 ; sym[i]:= 1 ;
    for j:= 1  to m do
        if not odd(i) then begin sym[i]:=sym[i]*a[i,j]; nom:=nom+ 1 ;end;
    if not odd(i) then begin serge[i]:=exp(( 1 /nom)*(ln(sym[i])));
                         write('ser geomet radoka= ',serge[i]: 0 : 2 ); writeln;
                   end;
                 end;
end;

end.
...
Рейтинг: 0 / 0
02.04.2010, 11:52:16
    #36557348
=NIk=
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
модуль на паскале
Mantikor123такае же проблема помогите Где-та ошибка а где и какая не могу разабрать

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
unit dz;
interface uses crt;

procedure max_elment;
procedure ser_arifm;
procedure ser_geomet;

const n= 3 ;m= 4 ;
var
    a:array[ 1 ..n, 1 ..m] of integer;
    maxm,sym:array[ 1 ..n] of integer;
    serge,serar:array[ 1 ..n] of real;
    i,j,max,w,nom,syma:integer;
    sergea:real;


implementation

procedure max_element;
begin
for i:= 1  to n do begin maxm[i]:=a[i, 1 ];
    for j:= 1  to m do begin
if a[i,j]>maxm[i] then maxm[i]:=a[i,j];
                     end;
                  end;
for i:= 1  to n do begin
write('max= ',maxm[i]); writeln;
                 end;
end;




procedure ser_arifm;
begin
for i:= 1  to n do begin
    nom:= 0 ;
    for j:= 1  to m do
        if odd(i) then begin sym[i]:=sym[i]+a[i,j]; nom:=nom+ 1 ;end;
    if odd(i) then begin serar[i]:=sym[i]/nom;
                         write('ser arifm radoka= ',serar[i]: 0 : 2 ); writeln;
                   end;
                 end;
end;


procedure ser_geomet;
begin
for i:= 1  to n do begin
    nom:= 0 ; sym[i]:= 1 ;
    for j:= 1  to m do
        if not odd(i) then begin sym[i]:=sym[i]*a[i,j]; nom:=nom+ 1 ;end;
    if not odd(i) then begin serge[i]:=exp(( 1 /nom)*(ln(sym[i])));
                         write('ser geomet radoka= ',serge[i]: 0 : 2 ); writeln;
                   end;
                 end;
end;

end.


heiftv
решаем ручками, и по ф8 погнали.
после 2 - 3-х прогонов найдешь
...
Рейтинг: 0 / 0
Форумы / Программирование [игнор отключен] [закрыт для гостей] / модуль на паскале / 9 сообщений из 9, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]