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

Выпуск № 632
от 14.04.2008, 09:35

Вопрос № 131.150

здраствуйте уважаемые эксперты! помогите пожалуйста проверить правильность задачи. дана действительная квадратная матрица порядка n. вычислить сумму тех её элементов, расположенных на главной диагонали и выше её, которые превосходят по величине все элементы, расположенные ниже,главной диагонали.если на главной диагонали и выше нет элементов с указанным св-вом,то вывести соответствующее сообщение. Приложение: program ZET; uses crt; var max:integer; M:array [1..10,1..10] of integer; sum:integer; i,j:integer; n:integer; begin clrscr; textcolor(14); gotoxy(28,2); writeln ('ЪДДДДДДДДДДДДДДДДДДДДДДДДДДї '); gotoxy(28,3); writeln ('і vvedite razmer matrici: і '); gotoxy(28,4); writeln ('АДДДДДДДДДДДДДДДДДДДДДДДДДДЩ'); gotoxy(54,3); readln(n); for i:=1 to n do for j:=1 to n do begin write('m[',i,',',j,']='); readln(M[i,j]); end; for i:=1 to n do begin for j:=1 to n do write(m[i,j]:4); writeln; end; for i:=2 to n do for j:=1 to i-1 do if (i=2) or (M[i,j]>max) then max:=M[i,j]; sum:=0; for i:=1 to n do for j:=i to n do if M[i,j]>max then Sum:=Sum+M[i,j]; writeln(Sum); readln; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ильин Дмитрий! Поправил вашу программу, ничего в ней не меняя, кроме ошибок, поэтому вы легко разберетесь в своих ошибках. Главное: условие ниже главной диагонали for i:=2 to n do for j:=1 to n-1 do if ( j < i ) условие выше и равно главной диагонали for i:=1 to n do for j:=i to n do if ( j > = i ) К этому условию добавляете отношение с max и все. Удачи! Исправлено написание знаков в условии. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 09.04.2008, 15:05 Приложение: program ZET; uses crt; var max:integer; M:array [1..10,1..10] of integer; sum:integer; i,j:integer; n:integer; begin clrscr; textcolor(14); gotoxy(28,2); writeln ('ЪДДДДДДДДДДДДДДДДДДДДДДДДДДї '); gotoxy(28,3); writeln ('і vvedite razmer matrici: і '); gotoxy(28,4); writeln ('АДДДДДДДДДДДДДДДДДДДДДДДДДДЩ'); gotoxy(54,3); readln(n); for i:=1 to n do for j:=1 to n do begin write('m[',i,',',j,']='); readln(M[i,j]); end; for i:=1 to n do begin for j:=1 to n do write(m[i,j]:4); writeln; end; max:=M[2,1]; for i:=2 to n do for j:=1 to n-1 do if (j<i) and (M[i,j]>max) then begin max:=M[i,j]; end; sum:=0; for i:=1 to n do for j:=i to n do if (j>=i)and(M[i,j]>max) then begin Sum:=Sum+M[i,j]; end; writeln('Sum=',sum); readln; end.

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

Вопрос № 131.154

Здравствуйте! Я не пойму в чем ошибка или почему. Сколько пробовал по другому никак. Может вы скажете, почему? Задание №1: Дана символьная строка, содержащая двоеточия. Получить все символы, расположенные между первым и вторым двоеточием. Если второго двоеточия нет, то получить все символы, расположенные после единственного имеющегося двоеточия. Задание №2: Сформировать запись "Книга", содержащую сведения: наименование книги, фамилию автора, название издательства и годе издания книги. Вывести на экран: - количество и список книг, выпущенных указанным издательством; - количество и список книг, выпущенных в текущем тысячелетии; - по автору данные о книге. По 2-му заданию не знаю что делать дальше. Помогите!!! Приложение: Задание №1: program PosledSymbol; var p:array[1..100] of byte; i,j,k:integer; S:string; begin writeln('Введите последовательность символов: '); readln(S); j:=1; for i:=1 to length(S) do case S[i] of ':':begin k:=k+1; S[i]:=':'; end; end; if S[i]=':' then begin p[j]:=i; j:=j+1; end; if j>1 then copy(S,p[1],p[2]-p[1]-1) else copy(S,p[3]-p[2]-p[1]-1); writeln('Кол-во двоеточии в строке: ',k); writeln('Преобразованная последовательность символов: '); writeln(S); readln; end. Задание №2: program herol; type book=record name,avtor,izdat:string; good:word; end; var kniga:book; i,n:word; f:text; begin writeln('---Введите данные.---'); with book(kniga) do begin write('Название книги: '); readln(name); write('Фамилия автора: '); readln(avtor); write('Издательство книги: '); readln(izdat); write('Год издания книги: '); readln(good); end;

Отправлен: 08.04.2008, 12:24 Вопрос задал: Pusja Kosin Barkovich (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Костя Симанович Здравствуйте, Pusja Kosin Barkovich! По первой задаче рискну предложить вариант в приложении. Приложение: program stroki; {программа получает все символы от двоеточия до следующего двоеточия или до конца строки} var s, pod : string; l, a : integer; i : integer; begin a := 0; writeln('введите строку.'); readln(s); a := pos(':' , s); if a = 0 then writeln('двоеточия не обнаружено.') else begin if a = length(s) then writeln('Двоеточие последний символ') else begin i := a + 1; l := length(s); repeat if copy(s, i, 1) = ':' then i := l+1 else begin pod := pod + copy(s, i, 1); i := i + 1; end; until i = l+1; writeln('новая подстрока = ', pod); end; end; readln; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Pusja Kosin Barkovich! Прочитал ваше задание и код. В первой задаче вы сильно перемудрили. Строка символов это тип String, для работы с которым есть несколько процедур и функций. Вам в частности нужны только функция Pos('sb',st), определяющая первое появление подстроки в строке, у нас это двоеточие, и процедура Delete(s,i,count), удаляющая из строки символы начиная с индекса i в количестве count штук. Короче код в приложении. Вторую задачу вы тоже начали все на свете перепутав. Я сделал программу, которая выполняет условия задания, но обычно записи хранят и выводят для чтения в файлах. Какие файлы использовать и как организовать работу с базой данных дело вкуса и я в эти дебри не полез. Для начала вам хватит понимания как работает тип Record. Код в приложении. Приложение: Задача 1. uses crt; var s,s1:string; i:integer; begin clrscr; write('s= ');readln(s); delete(s,1,pos(':',s)); delete(s,pos(':',s),length(s)-pos(':',s)+1); writeln; write('s: ',s); readln end. Задача 2. program herol; uses crt; type book=record nam,avt,izd:string; god:word; end; var kn:array[1..20]of book;{массив записей} n,i,kol:integer; st:string; begin clrscr; write('Vvedite razmer spiska:'); readln(n); writeln('Vvedite dannye:'); for i:=1 to n do begin writeln('Zapis ',i); write('Kniga: ');readln(kn[i].nam); write('Avtot: ');readln(kn[i].avt); write('Izdatelstvo: ');readln(kn[i].izd); write('God izdania: ');readln(kn[i].god); end; clrscr; writeln('Izdatelstvo:'); readln(st); kol:=0; for i:=1 to n do if kn[i].izd= st then begin writeln(kn[i].avt,' ',kn[i].nam); kol:=kol+1; end; writeln('Kol knig izd ',st,'=',kol); readln; writeln; writeln('Knigi izdannye posle 2000 doda:'); kol:=0; for i:=1 to n do if kn[i].god>2000 then begin writeln(kn[i].avt,' ',kn[i].nam); kol:=kol+1; end; writeln('Kol knig izd posle 2000 goda=',kol); readln; writeln; writeln('Avtor:'); readln(st); for i:=1 to n do if kn[i].avt=st then begin writeln(kn[i].nam,' ',kn[i].izd,' ',kn[i].god); end; readln end.

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

Вопрос № 131.215

CONST N=100; VAR X:ARRAY[1..N] OF REAL; Преобразовать массив Х по следующему правилу (Х(к) - значение к-го элемента массива после преобразования): а) x(к)=max(x(i)) при 1<=i<=k; б) элементы массива расположить в обратном порядке; в) x(1)=x(1) ,x(n)=x(n) ,x(k)=(x(k)-1+x(k)+x(k)+1)/3 при k=2,3,...,n-1; г) элементы массива циклически сдвинуть на одну пози- цию влево:x(n)=x(1) ,x(k)=x(k+1) при k=1,2,...,n-1; д) элементы массива циклически сдвинуть на две позиции влево. Приложение: и блок схему пожалуста на kolliian@mail.ru спасибо!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Dolgopolov! Посмотрел я разные варианты оформления задачи и решил, что лучше и понятней сделать все пять по отдельности. Код в приложении, блок-схемы завтра. Еще резко убавил const n=100; Такой массив очень плохо тестировать. Я сделал n=15, если нужно, увеличь. Приложение: Задача а) uses crt; const n=15; var x:array[1..n] of real; k,i:integer; max:real; begin clrscr; randomize; for k:=1 to n do begin x[k]:=random(10)+random; write(x[k]:4:1); end; writeln; for k:=1 to n do begin max:=x[1]; for i:=1 to k do if x[i]>max then max:=x[i]; x[k]:=max; end; for k:=1 to n do write(x[k]:4:1); readln; end. Задача б) uses crt; const n=15; var x:array[1..n] of real; k:integer; r:real; begin clrscr; randomize; for k:=1 to n do begin x[k]:=random(10)+random; write(x[k]:4:1); end; writeln; for k:=1 to n div 2 do begin r:=x[k];x[k]:=x[n-k+1];x[n-k+1]:=r; end; for k:=1 to n do write(x[k]:4:1); readln; end. Задача в) uses crt; const n=15; var x:array[1..n] of real; k:integer; begin clrscr; randomize; for k:=1 to n do begin x[k]:=random(10)+random; write(x[k]:4:1); end; writeln; for k:=2 to n-1 do begin x[k]:=(x[k-1]+x[k]+x[k+1])/3; end; for k:=1 to n do write(x[k]:4:1); readln; end. Задача г) uses crt; const n=15; var x:array[1..n] of real; k:integer; r:real; begin clrscr; randomize; for k:=1 to n do begin x[k]:=random(10)+random; write(x[k]:4:1); end; writeln; r:=x[1]; for k:=1 to n-1 do begin x[k]:=x[k+1]; end; x[n]:=r; for k:=1 to n do write(x[k]:4:1); readln; end. Задача д) uses crt; const n=15; var x:array[1..n] of real; k,j:integer; r:real; begin clrscr; randomize; for k:=1 to n do begin x[k]:=random(10)+random; write(x[k]:4:1); end; writeln; for j:=1 to 2 do begin r:=x[1]; for k:=1 to n-1 do begin x[k]:=x[k+1]; end; x[n]:=r; end; for k:=1 to n do write(x[k]:4:1); readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 08.04.2008, 21:48 Оценка за ответ: 5 Комментарий оценки: спс

Отвечает: Denisss Здравствуйте, Dolgopolov! В приложении пример решения задачи (правила разделены между собой комментариями). К ответу прикреплен файл [16K], содержащий блок-схемы правил а)-д). Правила выполнены в отдельных блок-схемах, а не в одной, как в приведенном примере. Основные отличия примера, приведенного мной, от первого ответа на вопрос: 1. Правило а) Нет лишнего вложенного цикла с поиском максимума. Данный цикл только увеличивает количество итераций в 5050 раз (при N = 100). 2. Правила г) и д) Вместо цикла используется встроенная функция Move. Данная функция копирует содержимое памяти из первого параметра во второй. Объем копируемой памяти указывается в третьем параметре функции. Прим.: (N shr 1) - тоже, что и (N div 2); Pred(N) - тоже, что и (N - 1); Succ(N) - тоже, что и (N + 1). Удачи! Приложение: program q131215; uses Crt; const N = 100; var X: array[1..N] of Real; i: Integer; fMax, t, t1: Real; begin {Очистка экрана} ClrScr; {Подготавливаем генератор случайных чисел} Randomize; {Заполняем массив случайными значениями} for i:= 1 to N do begin X[i]:= random; {Вывод значений массива} write('[', i:2, ']: ', X[i]:6:3, ' '); end; writeln; { Правило a} fMax:= X[1]; for i:= 2 to N do begin if (fMax < X[i]) then fMax:= X[i]; X[i]:= fMax; {Здесь можно организовать вывод значений элементов массива} {write('[', i:2, ']: ', X[i]:6:3, ' ');} end; {Правило б} for i:= 1 to (N shr 1) do begin t:= X[i]; X[i]:= X[N + 1 - i]; X[N + 1 - i]:= t; end; {Здесь можно организовать вывод значений элементов массива} {for i:= 1 to N do write('[', i:2, ']: ', X[i]:6:3, ' ');} {Правило в} for i:= 2 to Pred(N) do begin X[i]:= (X[Pred(i)] + X[i] + X[Succ(i)])/3; {Здесь можно организовать вывод значений элементов массива} {write('[', i:2, ']: ', X[i]:6:3, ' ');} end; {Правило г} t:= X[1]; Move(X[2], X[1], Pred(N)*SizeOf(Real)); X[N]:= t; {Здесь можно организовать вывод значений элементов массива} {for i:= 1 to N do write('[', i:2, ']: ', X[i]:6:3, ' ');} {Правило д} t:= X[2]; t1:= X[1]; Move(X[3], X[1], (N - 2)*SizeOf(Real)); X[N]:= t; X[Pred(N)]:= t1; {Вывод массива} for i:= 1 to N do write('[', i:2, ']: ', X[i]:6:3, ' '); end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 09.04.2008, 21:39 Оценка за ответ: 5

Вопрос № 131.241

Помогите пожалуйста составитьещё вот такую программу Вычислить значение x=корень(а) a, используя рекуррентную формулу xn=1/2(xn-1+a/xn-1 ) в качестве начального приближения использовать значение x0=0. 5(1 +a). Спасибо

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Saillo Виталий Николаевич ! Программа в приложении. Удачи! Приложение: const e=0.0000001; var b:real; function sq_rt(c:real):real; begin {пока очередное приращение превышает точность - вызываем саму себя} if abs((c+b/c)/2-c)>e then sq_rt:=sq_rt((c+b/c)/2) {иначе завершаем рекурсию} else sq_rt:=(c+b/c)/2; end; begin write('X:'); readln(b); writeln('S:',sq_rt(1):15:10); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 131.268

В соревнованиях по бегу принимают участие 10 спортсменов.Вводя по очереди их фамилии и результаты участников в ЭВМ,определить,сколько их них выполнили норму ГТО,и напечатать их фамилии.Решить эту задачу с помощью одномерных массивов и подпрограмм.

Отправлен: 09.04.2008, 06:39 Вопрос задала: Лиманская Юлия Вадимовна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимовна! Решение задачи, надеюсь соответствующее условию, в приложении. Соревнования будь-то бы в беге на 60 м, норматив 13,00 сек. Условие выполнения рез<13. Можете поменять норматив и условия, только если это например прыжки или метания, то выполняется условие рез>норматива. Приложение: Program Beg60m; uses crt; const n=10; nr=13.00; type Mreal=array[1..n] of real; {массив результатов} Mstr=array[1..n] of string[20]; {массив фамилий} var a:Mreal; s:Mstr; k:integer; Procedure Vvod(var r:Mreal;var u:Mstr); var i:integer; begin for i:=1 to n do begin writeln('Uchastnik # ',i); write('Familia: ');readln(u[i]); write('Rezultat:' );readln(r[i]); end; end; Procedure GTO(r:Mreal;u:Mstr); var i,k:integer; begin writeln('Uchastniki, vypolnivshie normativ:'); writeln; k:=0; for i:=1 to n do if r[i]<=nr then begin k:=k+1; writeln(u[i]); end; writeln; writeln('Kolichestvo vypolnivshih normativ=',k); end; begin clrscr; Vvod(a,s); writeln; GTO(a,s); readln; end.

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

Вопрос № 131.270

Вводя по четыре оценки,полученные студентами в сессию,вывести на экран фамилии неуспевающих студентов(имеющих хотя бы одну оценку два).Решить задачу с помощью одномерных массивов и подпрограмм.

Отправлен: 09.04.2008, 06:43 Вопрос задала: Лиманская Юлия Вадимовна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимовна! Эта задача похожа на предыдущую, поэтому не комментирую. Поправьте текстовую часть, если моя не нравится и поставте константу n, какую вам надо, а то размерность иассива не указана. Я взял 5, чтобы быстрее тестировать. Код в приложении. Приложение: Program Ocenki; uses crt; const n=5; type Mbyte=array[1..n] of byte; Mstr=array[1..n] of string[20]; var a,b,c,d:Mbyte; s:Mstr; Procedure Vvod(var o,p,r,q:Mbyte;var u:Mstr); var i:integer; begin for i:=1 to n do begin writeln('Student # ',i); write('Familia: ');readln(u[i]); write('Ocenka1:' );readln(o[i]); write('Ocenka2:' );readln(p[i]); write('Ocenka3:' );readln(r[i]); write('Ocenka4:' );readln(q[i]); end; end; Procedure Hvost(o,p,r,q:Mbyte;u:Mstr); var i:integer; begin writeln('Studenty s hvostami:'); writeln; for i:=1 to n do if (o[i]=2)or(p[i]=2)or(r[i]=2)or(q[i]=2)then begin writeln(u[i]); end; end; begin clrscr; Vvod(a,b,c,d,s); writeln; Hvost(a,b,c,d,s); readln; end.

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

© 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