10.12.2009, 23:10 | #22 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Так, ну отладил я Вашу программу. Ошибок очень много, но ничего страшного, научитесь. Пара замечаний общего характера:
1. Вы, похоже, не разобрались с заданием параметров процедур и функций, тех, что идут в скобках после имени подпрограммы. Тут так. Слово "var" при перечислении параметров ФУНКЦИИ вообще ставить не надо; в то же время в ПРОЦЕДУРЕ оно играет ключевую роль: ВХОДНЫЕ параметры перечисляются БЕЗ "var", ВЫХОДНЫЕ - с "var". 2. Не обязательно, но ОЧЕНЬ желательно - пользуйтесь при написании программы паскалевскими "лесенками"! Без них читать текст программы очень трудно. А у Вас на вид прямо не Паскаль, а Фортран какой-то. Теперь сама программа: Код:
Program Tipovik; uses crt; Type MAS=Array [1..10,1..10] of Real; Vec=Array [1..10] of Real; Var A,B,A1,B1:MAS; W:Vec; N,M,k:Byte; Q1,Q2:real; Procedure VVOD (var x:mas; C:Byte); Var i,j:Byte; Begin For i:=1 to C do For j:=1 to C do begin WriteLn ('vvedite element s indeksom',i,' ',j); ReadLn (x[i,j]); end; end; Procedure VYVOD (x:mas; C:Byte); Var i,j:Byte; Begin For i:=1 to C do begin For j:=1 to C do Write (x[i,j]:6:2); WriteLn; end; end; Procedure VYVOD_Vec (y:vec; C:Byte); Var j:Byte; begin For j:=1 to C do Write (y[j]:6:2); WriteLn; end; Function Up (x:mas; C:Byte):Real; Var i,j,T:byte; Fl:boolean; Begin T:=0; For i:=1 to C do begin Fl:=true; For j:=1 to C-1 do If x[i,j]<x[i,j+1] then Fl:=false; if Fl then T:=T+1; end; Up:=T; End; Procedure perestanovka (x:mas; C,z:Byte; var y:mas); Var i,j,m,Jfix:Byte; Fl:boolean; dub:real; v:Vec; Begin For j:=1 to C do v[j]:=x[z,j]; For m:=1 to C do begin dub:=1000000.0; For j:=1 to C do if v[j]<dub then begin dub:=v[j]; Jfix:=j; end; v[Jfix]:=1000000.0; For i:=1 to C do y[i,m]:=x[i,Jfix]; end; End; Procedure FV (x:mas; var y:vec; C:Byte); Var i,j:Byte; max:Real; Begin For i:=1 to C do begin max:=x[i,1]; For j:=1 to C do If Abs(x[i,j])>max then begin max:=x[i,j]; W[i]:=max; end; end; End; Begin clrscr; WriteLn ('Vvedite kol-vo strok i stolbcov matrici A '); ReadLn (N); WriteLn ('Vvedite kol-vo strok i stolbcov matrici B'); ReadLn (M); If (N<=0) or (N>10) or (M<=0) or (M>10) then WriteLn ('neverno vvedeni znacheniy') else begin WriteLn ('Vvod matrici A'); VVOD (A,N); WriteLn ('Vvod matrici B'); VVOD (B,M); clrscr; WriteLn ('Isxodniy massiv A'); VYVOD (A,N); WriteLn; WriteLn ('Isxodniy massiv B'); VYVOD (B,M); WriteLn; WriteLn ('Vvedite K-yu stroku'); ReadLn (k); WriteLn; Q1:=Up(A,N); WriteLn ('Kol-vo uporyd strok A',' ',Q1:6:2); WriteLn; Q2:=Up(B,M); WriteLn ('Kol-vo uporyd strok B',' ',Q2:6:2); WriteLn; If Q1>Q2 then begin perestanovka (A,N,k,A1); WriteLn ('konechnay matrica'); VYVOD (A1,N); WriteLn; FV (B,W,M); VYVOD_Vec (W,N); end else begin perestanovka (B,M,k,B1); WriteLn ('konechnay matrica'); VYVOD (B1,M); WriteLn; FV (A,W,N); VYVOD_Vec (W,N); end; WriteLn ('Enter'); ReadLn; end; end. |
11.12.2009, 00:06 | #23 (permalink) |
Member
Регистрация: 29.09.2009
Сообщений: 32
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
огромное Вам спасибо!!! Насчет Var я и вправду не разобрался, теперь все понял,
Единственное, что я не понял, так это как работает Procedure perestanovka .. что там за индексы новые появились и почему мы дублеру присваиваем такое странное значение dub:=1000000.0; |
11.12.2009, 10:10 | #24 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
Код:
Procedure perestanovka (x:mas; C,z:Byte; var y:mas); Var i,j,m,Jfix:Byte; dub:real; v:Vec; Begin For j:=1 to C do v[j]:=x[z,j]; For m:=1 to C do begin dub:=1000000.0; For j:=1 to C do if v[j]<dub then begin dub:=v[j]; Jfix:=j; end; v[Jfix]:=1000000.0; For i:=1 to C do y[i,m]:=x[i,Jfix]; end; End; Вводится вспомогательный вектор v, куда вначале копируется выбранная строка матрицы х. Далее нам надо С раз найти минимальное значение компонентов вектора v, при этом каждый раз исключая результат предыдущего поиска. Это делается в цикле по m. Алгоритм перестановок такой: Параметру dub присваивается некое очень большое значение (например, 1000000.0). Используется стандартный алгоритм поиска минимума, т.е. для каждого компонента вектора v проверяется выполнение условия v[j]<dub, и если условие выполнено, то параметру dub присваивается значение v[j], а номер j сохраняется путем операции Jfix:=j. Таким образом, в результате цикла по j мы находим номер наименьшего из компонентов вектора v, равный Jfix. Чтобы исключить найденный минимальный компонент из поиска при проведении следующего цикла (поиска следующего по величине компонента v), значение найденного минимального компонента в векторе v заменяется опять же очень большим числом 1000000.0. Далее копируем столбец матрицы х с найденным номером Jfix в столбец новой матрицы у с номером m. Процедура повторяется С раз. P.S. Идентификатор dub я использовал просто потому, что был такой у Вас. Лучше бы, конечно, переименовать его в Min. P.P.S. Да, и булевскую переменную Fl можно убрать - она не используется. |
|
17.12.2009, 19:49 | #25 (permalink) |
Member
Регистрация: 29.09.2009
Сообщений: 32
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Vladimir_S
спасибо большое, но ксати у меня получилось сделать это без дополнительного вектора, что тоже правильно)) теперь проблема в другом, не совсем корректно работает вот эта часть программы Код HTML:
Function Up (x:mas; C:Byte):Real; Var i,j,T:byte; Fl:boolean; Begin T:=0; For i:=1 to C do begin Fl:=true; For j:=1 to C-1 do If x[i,j]<x[i,j+1] then Fl:=false; if Fl then T:=T+1; end; Up:=T; End; |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
17.12.2009, 21:28 | #27 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
Код:
Function Up ( x:mas; C:Byte):real; Var i,j,T:byte; Fl:boolean; Begin T:=0; i:=1; Fl:=true; While (i<=C) and (Fl) do begin j:=1; While (j<=C-1) and (Fl) do begin If x[i,j]>x[i,j+1] then begin T:=T+1; j:=j+1; end else Fl:=false end; i:=i+1; end; Up:=T; end; P.S. А что, обязательно нужно было прерывание цикла организовывать? Просто иногда есть смысл допустить выполнение лишних операций ради упрощения алгоритма. На современных компьютерах это не имеет большого значения. |
|
17.12.2009, 22:10 | #28 (permalink) | |
Member
Регистрация: 29.09.2009
Сообщений: 32
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Цитата:
Насчет досрочного выхода..как нам говорят "С точки зрения программириования нужно делать все наиболее рационально и эффективно." поэтому требуют досрочный выход из циклов. А не могли бы Вы сказать, как с паскаля скопировать текст в ворд например, и наоборот? |
|
17.12.2009, 22:17 | #29 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Пожалуйста.
Цитата:
|
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|