/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 627
от 09.04.2008, 07:05

Вопрос № 130.316

Уважаемые эксперты,не могу решить задачу. помогите. вот текст: дана матрица размерностью N на M. Найти столбец, в котором максимальный элемент минимален в соответствующей строке. Спасибо за внимание.

Отправлен: 03.04.2008, 07:50 Вопрос задала: Залилова Регина Рафиковна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Залилова Регина Рафиковна! Решение задачи с подробными комментариями в приложении. Приложение: uses crt; {берем маленький размер матрицы чтобы быстрее ее набрать} {с клавиатуры, через рандом практически невозможно } const n=3; m=4; var a:array[1..n,1..m]of integer; i,j,k,max,imax,min,jmin:integer; begin clrscr; randomize; writeln('Vvedite elemebty matricy:'); for i:=1 to n do {вводим элементы матрицы} for j:=1 to m do read(a[i,j]); clrscr; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do {выводим матрицу на экран} write(a[i,j]:3); writeln; end; readln; for j:=1 to m do {ищем максимальный элемент в столбце} max:=a[1,j];imax:=1; for i:=1 to n do if a[i,j]>max then begin max:=a[i,j]; imax:=i; {нужная строка} end; min:=a[imax,1];jmin:=1; for k:=1 to m do if a[imax,j]<min then begin min:=a[imax,j]; {в строке с найденным элементом} jmin:=j; {ищем минимальный} end; if min=max then {если элементы совпадают, заканчиваем поиск} begin writeln('#stroki=',imax); writeln('#stolbca=',jmin); readln; exit; end { если до конца не нашли такого элемента} else if (j=m)and(min<>max) then writeln('Takogo stolbca net.'); {выводим сообщение} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 03.04.2008, 08:47

Вопрос № 130.332

Здраствуйте! Помогите решить задачу используя масивы информации, элементами которых есть записи: вывести список студентов которые живут на левом берегу Днепра и имеют больше 3 чем 4 или 5, по результатам сесии. В начале программы вводятся данные про студентов (проверочный вариант - 5 человек). Не нужно вводить все данные - только Ф.И.О, берег днепра на котором живёт и оценки за сесию.

Отправлен: 03.04.2008, 09:08 Вопрос задал: Щербаков Евгений Николаевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Щербаков Евгений Николаевич! Программа с необходимыми комментариями и, надеюсь, соответствующая Вашим требованиям, в приложении. Приложение: uses crt; const n=5; type student=record {тип запись} fio:string[20]; ber:string[20]; oc1,oc2,oc3:byte; end; var sp:array[1..n]of student; {массив записей-список} i:integer; begin clrscr; for i:=1 to n do begin {заполняем список данными} writeln('Zapis ',i); write('FIO:');readln(sp[i].fio); write('Bereg Dnepra:');readln(sp[i].ber); write('Kolichestvo 3=');readln(sp[i].oc1); write('Kolichestvo 4=');readln(sp[i].oc2); write('Kolichestvo 5=');readln(sp[i].oc3); end; writeln; writeln('Bolshe troek:'); {по заданному условию выводим данные} for i:=1 to n do if (sp[i].ber='levy')and(sp[i].oc1>sp[i].oc2)and(sp[i].oc1>sp[i].oc3) {нужно в одну строчку} then begin writeln(sp[i].fio,' ',sp[i].ber,' 3=',sp[i].oc1,' 4=',sp[i].oc2,' 5=',sp[i].oc3); {нужно в одну строчку} end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 03.04.2008, 10:24 Оценка за ответ: 5

Вопрос № 130.341

Здравствуйте, уважаемые эксперты! Просим вас помочь нам решить задачу по модулям. Дана вещественная матрица размерности n * m. По матрице получить логический вектор, присвоив его k-ому элементу зна-чение True, если выполнено указанное условие и значение False иначе: а)элементы k строки матрицы упорядочены по убыванию; б)k строка массива симметрична. Заранее СПАСИБО!

Отправлен: 03.04.2008, 09:52 Вопрос задала: Шелуфина Екатерина Викторовна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Шелуфина Екатерина Викторовна! В приложении модуль проекта и сама программа. В модуль я убрал процедуры проверки строк на упорядоченность и на симметричность. Ввод матрицы оставил в основной программе, поскольку про это не говорилось. Если нужно, можете сами составить процедуру ввода и убрать ее в модуль, или мне напишете, сделаю, хотя это вряд ли понадобится, гланое процедуры, оговоренные в условии. Когда наберете текст модуля (буквально как написано), сохраните его под тем же именем, что и название модуля. Нажмете Ctrl+F9, выйдет окно с сообщением «Cannot run a unit». Нажмете OK и у вас автоматически создастся файл с таким же именем, но с расширением *.TPU. Это и будет модуль. Затем набираете в новом окне текст программы и работаете. Модуль и программу я тестировал, все работает. Короче, удачи Вам! Приложение: Модуль. unit q0341md; interface type matr=array[1..50,1..50]of real; mass=array[1..50]of boolean; procedure Ubyv(n,m:integer;mt:matr;var b:mass); procedure Simmetr(n,m:integer;mt:matr;var c:mass); implementation procedure Ubyv(n,m:integer;mt:matr;var b:mass); var i,j,k:integer; begin for i:=1 to n do begin k:=0; for j:=1 to m-1 do {проверяем сортировку} begin if mt[i,j]>mt[i,j+1]then k:=k+1; end; if k=m-1 then b[i]:=true {если убывает} else b[i]:=false; {если не убывает} end; writeln('Porjadok:'); for i:=1 to n do write(b[i],' '); {выводим на экран} end; procedure Simmetr(n,m:integer;mt:matr;var c:mass); var i,j,k:integer; begin for i:=1 to n do begin k:=0; for j:=1 to m div 2 do {проверяем на симметричность} begin if mt[i,j]=mt[i,m-j+1]then k:=k+1; end; if k=m div 2 then c[i]:=true {симметрично} else c[i]:=false; {не симметрично} end; writeln('Simmetria:'); for i:=1 to n do write(c[i],' '); {выводим на экран} end; end. Программа. uses crt,q0341md; const n=4; m=4; var i,j:integer; a:matr; b,c:mass; begin clrscr; writeln('Vvedite elementy matricy:'); for i:=1 to n do for j:=1 to m do read(a[i,j]); clrscr; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do begin write(a[i,j]:5:2); end; writeln; end; readln; Ubyv(n,m,a,b); writeln; Simmetr(n,m,a,c); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 03.04.2008, 15:12

Вопрос № 130.345

Здраствуйте уважаемые эксперты!! Сделайте очередное одолжение, решите пожалуйста данную задачу. Организовать текстовый файл состоящий из N строк. Заменить в нем одну из строк новой строкой. Номер заменяемой строки и содержимое новой строки запрашивается и вводится с клавиатуры.

Отправлен: 03.04.2008, 10:39 Вопрос задала: Ahmadullina Mila Raufovna (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Костя Симанович Здравствуйте, Ahmadullina Mila Raufovna! В приложении вариант решения. Файл создаётся из программы. Приложение: uses crt; var f : text; s : array[1..50]of string; s1, named :string; n,i,k:integer; begin clrscr; assign(f,'stroka.txt'); rewrite(f); writeln('введите строку (или 0 для завершения)'); readln(named); while named <> '0' do //заполняем файл begin writeln(f, named); writeln('введите строку (или 0 для завершения)'); readln(named); end; close(f); write('введите новую строку. '); readln(s1); write('Номер заменяемой строки = '); readln(k); reset(f);n:=0; while not eof(f)do begin n:=n+1; readln(f,s[n]); end; close(f); s[k]:=s1; rewrite(f); for i:=1 to n do begin writeln(f,s[i]); end; close(f); end.

Ответ отправил: Костя Симанович (статус: 3-ий класс) Ответ отправлен: 03.04.2008, 10:58

Вопрос № 130.360

Здравствуйте. Помогите вычислить значение функции 3 2 u= (x+y-z) - (x-y+z) +√│x+y+z│ _______________________ log (tg(2)) 2 Исходные данные ввести с клавиатуры: x,y,z

Отправлен: 03.04.2008, 12:45 Вопрос задал: Козырев Сергей Андреевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 9)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Козырев Сергей Андреевич! Вот предлагаю два варианта решения задачи. В первом 2 заменил на 4 (можете другое число подобрать). Во втором предполозил, что это не 2 радиана, а два градуса. Так что выбирайте. Оба варианта в приложении. Приложение: 1 вариант. uses crt; var x,y,z,u:double; begin clrscr; write('x=');readln(x); write('y=');readln(y); write('z=');readln(z); u:=(sqr(x+y-z)*(x+y-z)-sqr(x-y+z)+sqrt(abs(x+y+z)))/(ln(sin(4)/cos(4))/ln(2)); {нужно в одну строчку} write('u=',u:6:3); readln end. 2 вариант. uses crt; var x,y,z,u:double; begin clrscr; write('x=');readln(x); write('y=');readln(y); write('z=');readln(z); u:=(sqr(x+y-z)*(x+y-z)-sqr(x-y+z)+sqrt(abs(x+y+z)))/(ln(sin(2*pi/180)/cos(2*pi/180))/ln(2)); {нужно в одну строчку} write('u=',u:6:3); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 03.04.2008, 15:47

Вопрос № 130.431

я уже облазила весь интернет и не могу нигде найти информацию про операторы Турбо Паскаль. мне нужна информация что делает или что означает каждый оператор. помогите пожалуйста найти

Отправлен: 03.04.2008, 20:20 Вопрос задала: Лиза (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Лиза ! Скачайте учебник. Удачи! --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 03.04.2008, 20:39 Оценка за ответ: 5 Комментарий оценки: спасибо большое

Отвечает: Coupler Здравствуйте, Лиза ! В прикрепленном файле учебник по Turbo Pascal 5.0, но различия с например, седьмым, практически отсутствуют.Объяснены все функции и процедуры Pascal. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 04.04.2008, 05:08 Оценка за ответ: 5

Вопрос № 130.435

Здравствуйте. Помогите пожалуйста с решением этих задач. №1 Дана символьная строка, среди символов которой есть двоеточие. Получить все символы, расположенные: а) до первого двоеточия включительно; б) после первого двоеточия; №2 Даны следующие описания переменных: type M=set of 0..99; Описать функцию card (А), подсчитывающую количество элементов во множестве А типа М. (Например, card [5, 8, 23])=3.) №3 Дан файл f, элементы которого являются действительными числами. Найти: наименьшее из значений элементов с четными номерами. №4 Дан файл f, элементы которого являются целыми числами. Найти: количество удвоенных нечетных чисел среди элементов. №5 Описать функцию, которая: подсчитывает количество пустых строк в текстовом файле t.

Отправлен: 03.04.2008, 20:32 Вопрос задал: Otokit (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Marked One Здравствуйте, Otokit! Первая и пятая задача в приложении. Удачи!!! Приложение: {№1} var str:string; i:integer; begin ReadLn(Str); for i:=1 to Pos(':', str) do write(str[i]); WriteLn; for i:=pos(':', str)+1 to Length(str) do write(str[i]); ReadLn; end. {№5} function CountEmptyStrings(FileName:string):integer; var f:text; tmpstr:string; count:integer; begin assign(f, FileName); reset(f); count:=1; While not EOF(f) do begin readLn(f, tmpstr); if tmpstr='' then inc(count); end; CountEmptyStrings:=count; close(f); end;

Ответ отправил: Marked One (статус: 10-ый класс) Ответ отправлен: 03.04.2008, 21:50 Оценка за ответ: 5 Комментарий оценки: Большое спасибо.

Вопрос № 130.446

здраствуйте уважаемые эксперты!помогите пожалуйста сделать задачу. дан некоторый текст. переставить в нём все буквы <а> в начало, а буквы <я> в конец.

Отправлен: 03.04.2008, 21:31 Вопрос задал: Ильин Дмитрий (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ильин Дмитрий! Решение задачи в приложении. Проходим в цикле по всей строке. Если встречаем букву а, удпляем ее и вставляем на первое место. Если встречаем букву я, удаляем ее и вставляем на последнее место. Используются процедуры delete и insert. Приложение: uses crt; var s:string; n,i:integer; begin clrscr; write('s:');readln(s); n:=length(s); for i:=1 to n do begin if s[i]='а' then begin delete(s,i,1); insert('a',s,1) end else if s[i]='я' then begin delete(s,i,1); insert('я',s,n); end; end; write(s); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 03.04.2008, 22:04 Оценка за ответ: 5

Отвечает: Шемет Станислав Васильевич Здравствуйте, Ильин Дмитрий! Программа в приложении. Удачи !!!! Приложение: Var s:string; Y,A,Buf:string; Begin Readln(s); For i:=1 to 255 do Begin If s[i]='а' then a:=a+'a' else If s[i]='я' then y:=y+'я' else buf:=buf+s[i]; end; S:=a+buf+y; Writeln(s); Readln end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 5-ый класс) Ответ отправлен: 03.04.2008, 22:21 Оценка за ответ: 5

Вопрос № 130.451

Дан линейный массив A[1...N], содержащий целые числа. Определить: а) имеется ли в массиве хотя бы одна пара соседних чисел одного знака, причем модуль первого должен быть больше модуля второго а найти индеск первого элемента первой пары. б) посчитать количество пар соседних чисел, причем модуль первого должен быть больше модуля второго Приложение: Ипользовать case of. Сделать, что бы разные виды создания массивов:а) только положительные числа, б) только отриц. числа, в) знакочередование, г)одна пара(певая, последняя, на любом месте),д) множество таких пар

Отправлен: 03.04.2008, 22:02 Вопрос задала: KATERINKA (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, KATERINKA! Вроде бы написал вашу программу, запутался с условиями, но все-таки вроде все выполнил. Для нахождения первой пары сделал процедуру, а для определения количества пар - функцию. Это для того, чтобы создавая разные массивы, можно было сразу получать по ним результаты. Один принципиальный момент: парой считаются два числа, удовлетворяющие условию и они не могут создавать пару с другими соседними числами, например 1 6 5 4 9 здесь одна пара 6 и 5. Если вы хотите считать что здесь две пары 6-5,5-4, то в описании функции Kol(b) там где написано i:=i+2, написать i:=i+1. Если что-то непонятно, пишите, будем разбираться. Всего Вам хорошего. Приложение: uses crt; type mass=array[1..50]of integer; var a:mass; n,i,k:integer; c:char; label 1; procedure Perv(b:mass);{процедура ищет первую пару} begin for i:=1 to n-1 do {если произведение элементов >0, то знаки элементов одинаковые} {массивы создаются так, что нолей в них нет} if (b[i]*b[i+1]>0)and(abs(b[i])>abs(b[i+1])) then begin writeln('Takaia para est! index 1-go el=',i); break; end else if i=n-1 then writeln('Takoi pary net!'); end; function Kol(b:mass):integer;{функция определяет количество пар} var k:integer; begin i:=1;k:=0; while i<=n do if (b[i]*b[i+1]>0)and(abs(b[i])>abs(b[i+1]))then begin k:=k+1;{если пара, то считаем} i:=i+2; {и перескакиваем через элемент } end {искать следущую пару} else i:=i+1; Kol:=k; end; begin clrscr; randomize; write('Vvedite razmernost massiva n=');readln(n); 1: {создаем типа меню для выбора вида массива} writeln('Vvedite massiv:P-a[i]>0; M-a[i]<0; H- +/-; O-odna para; Q-mnogo'); {нужно в одну строчку} Readln(c); c:=Upcase(c);{переводим в верхний регистр} case c of 'P':for i:=1 to n do a[i]:=random(10)+1; [1,10] 'M':for i:=1 to n do a[i]:=(-1)*(random(10)+1);[-10,-1] 'H':for i:=1 to n do if i mod 2<>0 then a[i]:=(-1)*(random(10)+1){чередуются} else a[i]:=random(10)+1; 'O':for i:=3 to n do begin if i mod 2<>0 then {все чередуются} a[i]:=(-1)*(random(10)+1) else a[i]:=random(10)+1; a[1]:=random(10)+2; {а первый и второй -пара} a[2]:=a[1]-1; end; 'Q':for i:=2 to n do if i mod 2=0 then {если n четное, то n/2 пар } begin a[i]:=random(10)+1; a[i-1]:=a[i]+1; end; end; for i:=1 to n do write(a[i],' '); writeln; Perv(a); writeln; writeln('Kol-vo par=',Kol(a)); readln; writeln('Vvesti drugoi massiv? Y/N'); Readln(c); c:=Upcase(c); case c of 'Y': goto 1; 'N': exit; end; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 05.04.2008, 18:04

Вопрос № 130.454

Люди мучаюсь уже 3 часа и не могу понять где ошибка, в программе. Пишет немоответствие типов в строке trash(A,B) курсор на запятой останавлявается. Помогите пожалуйста завтра сдавать прогу... Приложение: program lab8; {Romanchuk A.S. 03-103} type gop=array[1..7,1..5] of integer; var A:array[1..7,1..5] of integer; B:array[1..5,1..5] of integer; C:array[1..3,1..5] of integer; D:array[1..5,1..5] of integer; inp,out:text; a1,a2,b1,b2,t,n,m,i,j:integer; procedure trash(N,M,V:gop); var g,h,k:byte; begin for g:=1 to a1 do begin for h:=1 to b2 do begin for k:=1 to b1 do begin t:=N[g,k]*M[k,h]+t; end; V[g,h]:=t; write(C[g,h],' '); t:=0; end; end; end; begin assign(inp,'C:SashamatrixA.txt');reset(inp); for n:=1 to 7 do for m:=1 to 5 do read(inp,A[n,m]); close(inp); assign(inp,'C:SashamatrixB.txt'); reset(inp); for m:=1 to m do read(inp,B[m,m]); close(inp); trash(A,B); assign(out,'C:SashamatrixAB.txt'); rewrite(out); for n:=1 to n do for m:=1 to m do write(out,V[n,m],' '); close(out); end.

Отправлен: 03.04.2008, 22:12 Вопрос задал: Польских Дмитрий Иванович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Louken Здравствуйте, Польских Дмитрий Иванович! Во-первых, gop - это array[1..7,1..5] of integer, а В - array[1..5,1..5] of integer. Несоответствие в диапазоне (7 и 5). Во-вторых, для trash требуется три параметра.

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 03.04.2008, 22:43 Оценка за ответ: 5

Вопрос № 130.463

Построить график функции y=f(x) в заданном диапазоне изменения аргумента x. Предусмотреть выведение осей координат х и y, с нанесением шкалы делений, точек графика, названия функции y=f(x), фамилии автора и масштабных коэффициентов по каждой из осей координат. Вид функции: Y=sin x + cos x +1 Диапазон изменения аргумента х: -р до р Число точек графика: 400

Отправлен: 03.04.2008, 23:16 Вопрос задал: Чечуженко Льоша (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Евчик Сергей Александрович Здравствуйте, Чечуженко Льоша! В приложении код посторения графика sin(x). Остальное делается по аналогии. Удачи. Приложение: Program z1; uses crt, graph; var s:string; i,intsn,xcoord,ycoord:word; sn:real; procedure init; var grDriver : Integer; grMode : Integer; ErrCode : Integer; Begin grDriver:=Detect; InitGraph(grDriver, grMode, 'c: urbogi'); ErrCode:=GraphResult; end; begin init; SetBkColor(0); SetColor(10); line(10,5,10,GetMaxY-5); Line(10,getMaxY div 2,getMaxX-10,getmaxY div 2); moveto(20,getmaxY div 2); for i:=0 to 360 do begin sn:=sin(2*Pi*i/(getmaxx-10)); intsn:=round(sn*(getmaxy div 2)-5); lineto(i+10,getmaxy div 2-intsn); end; readln; closegraph; end.

Ответ отправил: Евчик Сергей Александрович (статус: 3-ий класс) Ответ отправлен: 04.04.2008, 17:44

Вопрос № 130.465

Здраствуйте помогите пожалуйста в составлении программы.. на данный момент имею код, указанный в приложении, но программ надо еще причесывать...возникают ошибки несоответсвия типов, которые я не знаю как поправить, очень прошу помочь, завтра сдача этой программы... Условие "с помощью подпрограммы умножения матрицы на матрицу найти произведение матрицы А, размерности nxm, на матрицу В, размерности mxm, и матрицы С, размерности ixj на матрицу D, размерности jxj(n=7,m=5, i=3,j=5). Элементы матриц и векторов- целые числа, вводимые из файла и выводимые в файл. " Приложение: program lab8; {Romanchuk A.S. 03-103} type gop=array[1..7,1..5] of integer; var A:array[1..7,1..5] of integer; B:array[1..5,1..5] of integer; C:array[1..3,1..5] of integer; D:array[1..5,1..5] of integer; inp,out:text; a1,a2,b1,b2,t,n,m,i,j:integer; V: procedure trash(a1,b2,b1:integer; N,M:gop); var g,h,k:byte; begin for g:=1 to a1 do begin for h:=1 to b2 do begin for k:=1 to b1 do begin t:=N[g,k]*M[k,h]+t; end; V[g,h]:=t; write(V[g,h],' '); t:=0; end; end; end; begin assign(inp,'C:SashamatrixA.txt');reset(inp); for n:=1 to 7 do for m:=1 to 5 do read(inp,A[n,m]); close(inp); assign(inp,'C:SashamatrixB.txt'); reset(inp); for m:=1 to m do read(inp,B[m,m]); close(inp); trash(7,5,5,A,B); assign(out,'C:SashamatrixAB.txt'); rewrite(out); for n:=1 to n do for m:=1 to m do write(out,V[n,m],' '); close(out); end.

Отправлен: 03.04.2008, 23:20 Вопрос задал: Польских Дмитрий Иванович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Польских Дмитрий Иванович! Наверное немного запоздал с ответом, но на всякий случай. Если вы создаете процедуру для определения произведения разных матриц любого размера, то в параметрах не надо указывать конкретный размер матрицы, иначе процедура не поймет, сколько строк и столбцов. Если процедура универсальная, ее надо оформить так: type matr=array[1..30,1..30]of integer; Раздел Var …………………………………….. Поскольку у вас в каждом случае только два разных размера, то их и указываем в параметрах Procedure trash(p,q:integer;T,R:matr:var Н:matr); Здесь p,q-размеры всех участвующих в одном вызове процедуры (а их будет два), например в первом случае A[7.,5]xB[5,5]=V[7x5] p=7, q=5, во втором случае C[3,5]xD[5,5]=U[3,5] p=3 q=5; T,R-перемножаемые матрицы, H-получаемая матрица (для всех случаев), В первом случае вызов: trash(7,5,A,B,V); Во втором случае вызов: trash(3,5,C,D,U); В приложении рабочий код на умножение ваших матриц с использованием процедуры, правда без файлов, они у вас похоже уже сделаны. Приложение: uses crt; type matr=array[1..30,1..30] of integer; var A,B,V,C,D,U:matr; inp,out:text; i,j:integer; procedure trash(p,q:integer;T,R:matr;var H:matr); var k:byte; begin for k:=1 to p do for j:=1 to q do begin H[k,j]:=0; for i:=1 to q do begin H[k,j]:=H[k,j]+T[k,i]*R[i,j]; end; end; end; begin clrscr; writeln('Matrica A:'); for i:=1 to 7 do begin for j:=1 to 5 do begin A[i,j]:=random(10)+1; write(A[i,j]:3); end; writeln; end; readln; writeln('Matrica B:'); for i:=1 to 5 do begin for j:=1 to 5 do begin B[i,j]:=random(10)+1; write(B[i,j]:3); end; writeln; end; readln; writeln('Matrica V:'); trash(7,5,A,B,V); for i:=1 to 7 do begin for j:=1 to 5 do write(V[i,j]:6); writeln; end; readln; writeln('Matrica C:'); for i:=1 to 3 do begin for j:=1 to 5 do begin C[i,j]:=random(10)+1; write(C[i,j]:3); end; writeln; end; readln; writeln('Matrica D:'); for i:=1 to 5 do begin for j:=1 to 5 do begin D[i,j]:=random(10)+1; write(D[i,j]:3); end; writeln; end; readln; writeln('Matrica U:'); trash(3,5,C,D,U); for i:=1 to 3 do begin for j:=1 to 5 do write(U[i,j]:6); writeln; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 04.04.2008, 10:12 Оценка за ответ: 5

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 4.72.8 от 05.04.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru