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

Выпуск № 634
от 16.04.2008, 10:35

Вопрос № 131.524

Здравствуйте, уважаемые эксперты! Сегодня вот тут две взаимосвязанных задачки: 1. Необходимо циклически сдвинуть элементы массива влево на k позиций. Число k задаётся после числовой последовательности. 7 1 2 3 4 5 6 7 3 4 5 6 7 1 2 3 2. Решите предыдущую задачу так, чтобы общее количество парных обменов элементов не превосходило n. 9 2 7 2 9 8 3 4 1 7 6 4 1 7 2 7 2 9 8 3 Первую задачу я решил, а вторую не могу. Помогите пожалуйста. Код первой программы в приложении. Приложение: Var x: Array[1..100] Of Integer; i, j, n, k, t: Integer; Begin ReadLn(n); For i := 1 To n Do Begin Read(x[i]); End; ReadLn(k); For i := 1 To k Do Begin For j := 1 To n-1 Do Begin t := x[j]; x[j] := x[j+1]; x[j+1] := t; End; End; For i := 1 To n Do Begin Write(x[i], ' '); End; WriteLn; ReadLn; End.

Отправлен: 10.04.2008, 15:32 Вопрос задал: Хощенко Артём Владимирович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Хощенко Артём Владимирович! Чтобы количество парных перестановок не превышало n, нужно разделить код на две части, при k<=n div 2 и k> n div 2 и делать немного по-разному. Код для решения этой задачи в общем виде в приложении, думаю легко разберетесь. Приложение: uses crt; var x:array[1..20]of integer; n,k,i,j:integer; r:integer; begin clrscr; randomize; write('n=');readln(n); write('k=');readln(k); writeln('Ischodny massiv:'); for i:=1 to n do begin x[i]:=random(10); write(x[i],' '); end; readln; if k<=n div 2 then for j:=1 to k do begin r:=x[1]; for i:=1 to 9 do begin x[i]:=x[i+1]; end; x[10]:=r; end else if k>n div 2 then for j:=1 to n-k do begin r:=x[n]; for i:=n downto 2 do begin x[i]:=x[i-1]; end; x[1]:=r; end; writeln; writeln('Sdvinutyj massiv:'); for i:=1 to 10 do write(x[i],' '); readln; end.

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

Вопрос № 131.538

Здравствуйте! помогите подалуйста подправить одну программу и решить вторую. 1) Написать функцию TASK_1_5(St:string):byte, подсчитывающую в строке st количество слов от символа "," до конца строки. Программа у меня есть, но она считает количество букв, подскажите как сделать что б она считала слова. Код в приложении. 2) Задан текстовый файл 'a.txt'. Написать программу, которая суммирует значения слов, являющихся вещественными числами. Помогите решить пожалуйста. Приложение: program count; uses crt; function TASK_l_5(St: string): byte; var v, i,len,n: integer; begin clrscr; v := 0; len := length(st); v:=Pos (',',st); n:=len-v; writeln(n) ; end; var s: string; begin writeln('vvedite stroku: '); readln(s); writeln('Bukv posle zapyatoi: ', TASK_l_5(s)); readln end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Doridori! Первая задача в приложении. Удачи! Приложение: program count; const {множество букв} A:set of char=['A'..'Z','a'..'z']; {функция считает символы} function TASK_L_5(St: string): byte; begin TASK_L_5:=(length(St)-Pos(',',St))*ord(Pos(',',St)>0); end; {фунция считает слова} function TASK_K_5(st:string):byte; var i,j,z:integer; begin i:=Pos(',',St)+1; z:=0; repeat {прокручиваем пробелы} while (St[i]=' ')and(i<=length(St))do inc(i); j:=0; {считаем прокручиваем слово} while (St[i+j] in A)and((i+j)<=length(St))do inc(j); {изменяем счетчик} inc(i,j); inc(z,(ord(j>0))); until i>length(St); TASK_K_5:=ord(Pos(',',St)>0)*z; end; var s: string; begin write('vvedite stroku: '); readln(s); writeln('После запятой ', TASK_L_5(s),' символов в ',TASK_K_5(s),' словах'); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 11.04.2008, 16:50

Вопрос № 131.540

Здравствуйте еще раз! Прошу помочь подкорректировать мне программу. Составить программу для обучения переводу чисел из десятичной системы счисления в двоичную и обратно. Программа должна предлагать десятичное (двоичное) число, выбранное с помощью датчика случайных чисел, обучающийся - назвать число в двоичной (десятичной) системе счисления. Программа есть но из двоичной системы в десятичную не хочет переводить.. Помогите исправить и задействовать датчик случайных чисел. И если не сложно подписать комментарии. Приложение: Program perevod; uses crt; var rez:string; num,i:integer; begin clrscr; writeln('Vvedite chislo'); read(num); while(num<>0)do begin rez:=chr((num mod 2)+48)+rez; num:=num div 2; end; writeln(rez); num:=0; for i:=1 to length(rez) do begin num:=num+(ord(rez[i])-48)*trunc(exp((length(rez)-i)*ln(2))); end; readln(num); end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Doridori! Переделал Вашу программу. Ваша ошибка в строке readln(num); -зачем вводит только что сформированное число. Удачи! Приложение: Program perevod; uses crt; var rez:string; num,i:integer; begin clrscr; write('Vvedite chislo'); readln(num); {пока не 0 повторяем} while(num<>0)do begin {формируем 2-е число} rez:=chr((num mod 2)+48)+rez; {корректируем число} num:=num div 2; end; {перевод в 10-ю систему} writeln('Bin:',rez); num:=0;{строка не нужна т.к. num уже равно 0} for i:=1 to length(rez) do begin {переводим в число} num:=num+(ord(rez[i])-48)*trunc(exp((length(rez)-i)*ln(2))); end; writeln('Dec:',num); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 10.04.2008, 18:37

Отвечает: SHERRY Здравствуйте, Doridori! В приложении функция по переводу из двоичной ситемы в десятичную. Приложение: function ToNormal(var x: string): integer; var y: string; rez: real; i,t: integer; begin y := x; rez := 0; for i:=0 to length(y)-1 do begin t := StrToInt(y[Length(y) - i]); rez := rez + t * Exp(i * ln(2)); end; ToNormal := Round(int(rez)); end; --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 9-ый класс) Ответ отправлен: 11.04.2008, 12:17

Вопрос № 131.548

Доброго времени суток вам!!!! Я уже отправлял этот вопрос, но не указал условие. Помогите пожалуйста решить задачку! Спасибо... Решите задачу, используя рекурсивную подпрограмму. Составить программу вычисления наибольшего общего делителя двух натуральных чисел.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Денисов Игорь Александрович! Примите пожалуйста рекурсивный вариант этой функции. Код в приложении. Исправлена кодировка русского текста в программе. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 10.04.2008, 20:26 Приложение: uses crt; var a,b:longint; function NOD(x,y:longint):longint; begin if x<>0 then NOD:=NOD(y mod x,x) else NOD:=y; end; begin clrscr; readln(a,b); writeln( 'НОД этих чисел = ', NOD(a,b) ); readln end.

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

Вопрос № 131.551

Здравствуйте, эксперты!!! Подскажите решение задачки по теме "строка"... Написать программу, которая добавляет во введенную строку после каждого пробела символ ‘#’.

Отправлен: 10.04.2008, 18:33 Вопрос задал: Денисов Игорь Александрович (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Денисов Игорь Александрович! Программа в приложении. В программе используются строковые функции и процедуры. Функция Pos ищет первое вхождение подстроки в строке, и возвращает либо индекс первого символа, либо 0 - если не найдено, именно поэтому все найденые пробелы удаляются процедурой Delete. после этого запускается рекурсивная (рекурсия - вызов самой себя) процедура Change c новыми значениями, и так до тех пор пока не будут удалены все пробелы. После этого процедурой Insert вставляется построка состоящая из пробела и знака "#", в том месте где раньше был пробел. Приложение: var a:string; procedure change(var b:string;c:integer); begin if c>0 then begin {удаляем пробел для поиска остальных} delete(b,c,1); {вызываем сами себя с новыми значениями} change(b,pos(' ',b)); {вставляем пробел и знак} insert(' #',b,c); end; end; begin {вводим строку} write('Enter string:'); readln(a); {вызываем функцию замены} change(a,pos(' ',a)); {выводим результат} write('Result:',a); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 10.04.2008, 19:46 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович !!! Здравствуйте, Денисов Игорь Александрович! Мне кажется у меня покороче вариант. Смотрите код в приложении. Вариант-то покороче, НО он НЕВЕРНЫЙ. Достаточно в качестве исходной строки ввести: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 И убедитесь в том что ответ не соответствует условию задачи. Для правильного решения достаточно заменить оператор цикла FOR на WHILE. Видоизменённый правильный код будет такой: var s:string; i:integer; begin write(Stroka: );readln(s); i:=1; while i<=length(s) do begin if s[i]= then begin insert(#,s,i+1); end; inc(i); end; writeln(s); readln end. ----- ∙ Отредактировал: Gh0stik (Акад емик) ∙ Дата редактирования: 10.04.2008, 20:21 Приложение: uses crt; var s:string; i:integer; begin clrscr; write('Stroka: ');readln(s); for i:=1 to length(s) do if s[i]=' 'then begin insert('#',s,i+1); end; writeln(s); readln end.

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

Отвечает: Шемет Станислав Васильевич Здравствуйте, Денисов Игорь Александрович! Программа в приложении. Удачи!!! Приложение: Var S:string; Buf:string; I:byte; Begin Readln(s); j:=0; For i:=1 to length(s) do if s[i]<>#32 then buf:=buf+s[i] else buf:=buf + s[i]+'#'; s:=buf; Writeln(s); REadln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 5-ый класс) Ответ отправлен: 10.04.2008, 20:14

Вопрос № 131.552

Здравствуйте вам!!! Помогите пожалуйста решить задачку по теме "файлы". За ранее спасибо!!! Дан файл, содержащий произвольный текст. Проверить, правильно ли в нем расставлены круглые скобки (т.е. находится ли правее каждой открывающейся скобки закрывающаяся, и левее закрывающейся — открывающаяся).

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Денисов Игорь Александрович! Программа в приложении. Алгоритм простой: посимвольно читается файл и если втретилась скобка счетчик увеличивается(уменьшается). Как только счетчик станет меньше нуля цикл чтения завершается т.к. закрывающая скобка опередила открывающую. Когда файл прочитан полностью и скобки раставлены правильно, то счетчик должен быть равен нулю. Удачи! Приложение: var a:text;{файловая переменная} b:integer;{счетчик скобок} c:char;{читаемый из файла символ} begin assign(a,'q131552.txt'); reset(a); b:=0; repeat read(a,c); case c of '(':inc(b); ')':dec(b); end; until (eof(a))or(b<0); close(a); write('Result:',b=0); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 14.04.2008, 15:16 Оценка за ответ: 5

Вопрос № 131.554

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

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

Отвечает: Delph Здравствуйте, Денисов Игорь Александрович! В приложении решение Вашей задачки. Если файл подготовлен заранее, то процедуру File_Create и её вызов можно исключить из программы. Приложение: Program Pr131554; Uses CRT; Const FileName = 'pr131554.dat'; Procedure File_Create(Const N: Integer); var f: File of Real; i: Integer; begin Randomize; Assign(f, FileName); ReWrite(f); for i := 1 to N do Write(f, Random * 100); {пишем в файл N чисел от 0 до 100} Close(f); end; Var Min, Max, r: Real; f : File of Real; i, N : Integer; Begin ClrScr; Write('N = '); ReadLn(N); WriteLn('Содержимое файла <', FileName, '>:'); File_Create(N); Assign(f, FileName); Reset(f); Read(f, r); Min := r; Max := r; Write(r:10:5); for i := 2 to N do begin Read(f, r); Write(r:10:5); if r < Min then Min := r; if r > Max then Max := r; if i mod 8 = 0 then WriteLn; end; WriteLn; WriteLn; WriteLn('Минимальное число: ', Min:10:5); WriteLn('Максимальное число: ', Max:10:5); WriteLn('Сумма (Min + Max) = ', (Min + Max):10:5); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 11.04.2008, 08:39 Оценка за ответ: 5

Вопрос № 131.577

Помогите пожалуйста! Мне нужно написать программу! Итарационные циклы с рекурентными соотношениями. Вычислить предел последовательности {Yn} при n->бесконечности, где Yn вычисляется по формуле: Yn=(Y(n-2)+0.5*Y(n-3))/(Y^2(n-2)+2*Y^4(n-3) +1.5) ; n=3,4,5,.... Значения Y0,Y1,Y2 вводиться с клавиатуры. Вычисления прекращают при выполнении условия |Yn-Y(n-1)|<E

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Azsergey! Программа в приложении. Удачи! Приложение: {$N+} const e=0.00000001; var a,b,c,d:real; f:comp; {формула} function Yx(x,y:real):real; begin Yx:=(y + 0.5*x)/(y*y + 2*x*x*x*x + 1.5); end; begin {вводим значения} write('Y0:');readln(a); write('Y1:');readln(b); write('Y2:');readln(c); {счетчик последовательности} f:=2; while abs(Yx(a,b)-Yx(b,c))>e do begin {вычисляем новые значения} d:=Yx(a,b); a:=b; b:=c; c:=d; {увеличиваем счетчик} f:=f+1; end; {выводим результат} write('N:=',f:10:0,' Yn:=',d:20:10); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 11.04.2008, 13:10

Вопрос № 131.578

Помогите пожалуйста написать программу. Построить квадратную матрицу D(m*m) |w 0 0 ... 0 Am | |-1 w 0 ... 0 A(m-1) | D=|0 -1 w ... 0 A(m-2) | |0 0 -1 ... 0 A(m-3) | |... .... .... .... ... ........ | |0 0 0 ..... -1 A1+w |

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Azsergey! Поскольку Вы условие точно не знаете, а делать что-то надо, я сам допридумал это условие. Если не понравится, легко переделаете, ведь для вас главное алгоритм построения матрицы. Предположим что А это линейный массив размерности m. W- какая-то характеристика этого массива, например максимальный элемент, это не суть важно, вам ведь главое матрицу запрлнить по условию. Тогда создаем линейный массив, находим максимум и заполняем матрицу. Приложение: uses crt; type mas=array[1..20]of integer; matr=array[1..20]of mas; var a:mas; d:matr; m,i,j,w,k:integer; begin clrscr; randomize; write('m=');readln(m); Writeln('Massiv A:'); {создаем массив и ищем в нем максимальный элемент} w:=a[1]; for i:=1 to m do begin a[i]:=random(m)+1; write(a[i],' '); if a[i]>w then w:=a[i]; end; writeln; writeln('w=',w); {Заполняем матрицу по условию} for i:=1 to m do for j:=1 to m do begin if i=j then d[i,j]:=w {главная диагональ} else if j=i-1 then d[i,j]:=-1 {на 1 ниже главной} else if j=m then {последний столбец} begin for k:=1 to m do d[k,j]:=a[m-k+1]; end else d[i,j]:=0; {все прочие элементы} d[m,m]:=w+a[1]; {последний элемент} end; writeln('Matrica D:'); for i:=1 to m do begin for j:=1 to m do write(d[i,j]:3); writeln; end; readln end.

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

Вопрос № 131.580

Помогите пожалуйста написать программу! Вычислить наименьшее значение функции F(x) при шести заданных значениях аргумента X=(1.9;2.8;3.7;4.6;5.5;6.4) F(x)=ln(x*Σ j^2 * e^(X-j)) {сумма послед. от 1 до 6}

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Azsergey! Я понял формулу так F(x)=ln(x*(Σ j^2 * e^(X-j))), т.е. х умножается не сумму произведений. Если все так, то код в приложении. Для нахождения суммы сделал отдельную функцию. Приложение: uses crt; var x,y:array[1..6] of real; ymin:real; i:integer; function Summ(j:byte;x:real):real; var sum:real; begin sum:=0; for j:=1 to 6 do sum:=sum+sqr(j)*exp(x-j); Summ:=sum; end; begin clrscr; x[1]:=1.9;x[2]:=2.8;x[3]:=3.7;x[4]:=4.6;x[5]:=5.5;x[6]:=6.4; ymin:=1000; {здесь обычное min:=y[1]не подходит, так тогда нужно начинать поиск со второго элемента, т.е. создавать дополнительно цикл. Так тоже можно. 1000 это просто большое число, можно и другое} for i:=1 to 6 do begin y[i]:=ln(x[i]*Summ(i,x[i])); writeln('x=',x[i]:4:1,' y=',y[i]:4:1); if y[i]<=ymin then ymin:=y[i]; end; writeln; writeln('Naimenshee znachenie funkcii=',ymin:4:1); readln end.

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

Вопрос № 131.594

Здравствуйте. Необходима помощь в решении задач: 1. В двумерном массиве поменять местами строки, содержащие наи- большее и наименьшее значения, предположив, что такие строки – единственные. 2. В данной действительной матрице размера 6*9 поменять местами строку, содержащую элемент с наибольшим значением, со строкой, содержащей элемент с наименьшим значением. Предполагается, что эти элементы единственны. Отсортировать матрицу по убыванию. Заранее спасибо. Приложение: Решить с помощью двумерных массивов.

Отправлен: 10.04.2008, 22:44 Вопрос задала: Десятова Ксения Сергеевна (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Marked One Здравствуйте, Десятова Ксения Сергеевна! Первая задача в приложении. Удачи!!! Приложение: const N=10; H=5; var a:array [1..H, 1..N] of Integer; Buf:array [1..N] of Integer; maxx, minx, max, min, i, j:integer; begin randomize; WriteLn('Начальный массив: '); for i:=1 to H do begin for j:=1 to N do begin a[i, j]:=random(100)-50; write(a[i, j], ' '); end; writeln; end; minx:=1; maxx:=1; max:=a[1, 1]; min:=a[1, 1]; for i:=1 to H do for j:=1 to N do begin if a[i, j]>max then begin max:=a[i, j]; maxx:=i; end else if a[i, j]<min then begin min:=a[i, j]; minx:=i; end; end; for i:=1 to N do begin buf[i]:=a[maxx, i]; a[maxx, i]:=a[minx, i]; a[minx, i]:=buf[i]; end; WriteLn('Рез-тат: '); for i:=1 to H do begin for j:=1 to N do write(a[i, j], ' '); writeln; end; readln; end.

Ответ отправил: Marked One (статус: 7-ой класс) Ответ отправлен: 10.04.2008, 23:13

Отвечает: Пупорев Юрий Борисович Здравствуйте, Десятова Ксения Сергеевна! Привожу решение второй задачи. Первая ее половина-повторение первой задачи, но я сделал ввод по другому. Чтобы макс и мин гарантированно не попали в одну строку и чтобы такие строки были единственными, матрицу надо набивать вручную. Поскольку по условию числа действительные, значит могут встречаться не только целые, но и дробные, поэтому применяем тип Real. Но вводить можно только целые числа, чтоб быстрее, только вывод нужно форматировать как для вещественных чисел. Сортировку матрицы я сделал с помощью линейного массива. Сначала матрицу разворачиваем в линейнй массив, который легко сортировать, а затем, после сортировки, снова собираем массив в матрицу. Код с пояснениями в приложении. Кстати,если в первой задаче не хотите получить проблем, не поленитесь, организуйте ввод с клавиатуры(вручную). Удачи! Приложение: Задача 2. uses crt; var M:array[1..6,1..9]of real; a:array[1..54]of real; i,j,imax,imin,k:integer; max,min,x:real; begin clrscr; writeln('Vvedite 54 elementa matricy:'); for i:=1 to 6 do for j:=1 to 9 do read(M[i,j]); {вводим элементы матрицы} readln; clrscr; {очищаем экран} writeln('Ishodnaia matrica:'); for i:=1 to 6 do begin for j:=1 to 9 do {выводим матрицу} write(M[i,j]:4:1); writeln; end; readln; {находим мин, макс и номера строк} max:=M[1,1];min:=M[1,1];imax:=1;imin:=1; for i:=1 to 6 do for j:=1 to 9 do if M[i,j]>max then begin max:=M[i,j]; imax:=i; end else if M[i,j]<min then begin min:=M[i,j]; imin:=i; end; writeln('max=',max:4:1,' imax=',imax); writeln('min=',min:4:1,' imin=',imin); readln; {меняем строки} for j:=1 to 9 do begin x:=M[imin,j]; M[imin,j]:=M[imax,j]; M[imax,j]:=x; end; writeln('Perestanovka:'); for i:=1 to 6 do begin for j:=1 to 9 do begin write(M[i,j]:4:1); end; writeln; end; readln; writeln; {разворачиваем матрицу в массив размером [1..54]} k:=0; for i:=1 to 6 do for j:=1 to 9 do begin k:=k+1; a[k]:=M[i,j]; end; {сортируем массив обменом ("пузырьком")} for i:=1 to k-1 do for j:=1 to k-1 do if a[j]<a[j+1]then begin x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x; end; writeln; {превращаем массив обратно в матрицу и выводим на экран} writeln('Sortironka:'); for i:=1 to 6 do begin for j:=1 to 9 do begin M[i,j]:=a[j+9*(i-1)]; write(M[i,j]:4:1); end; writeln; end; readln; end.

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

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