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

Выпуск № 614
от 26.03.2008, 23:35

Вопрос № 128.374

Дана последовательность действительных чисел A1,A2 ... An.Указать те ее элементы, которые принадлежат отрезку [c,d]. Все переменные (А1, А2,...Аn,c,d) вводить вручную в самой программе. Решить с помощью одномерного массива

Отправлен: 21.03.2008, 07:43 Вопрос задал: Cobain (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Cobain! Задача простая, думаю в комментариях не нуждается. Код в приложении. Приложение: uses crt; const n=10; var a:array[1..n]of real; c,d:real; i:integer; begin clrscr; write('c=');readln(c); write('d>c =');readln(d); for i:=1 to n do begin write('a[',i,']='); readln(a[i]); end; clrscr; Writeln('Ishodny massiv:'); for i:=1 to n do write(a[i]:6:2); readln; writeln; writeln('Interval [',c:5:2,';',d:6:2,']: '); for i:=1 to n do if(a[i]>=c)and(a[i]<=d) then begin write(a[i]:6:2); end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 10-ый класс) Ответ отправлен: 21.03.2008, 08:11 Оценка за ответ: 4

Отвечает: Жиляев Здравствуйте, Cobain! Набросал программку для 25 чисел. Если нужно больше измените значение константы n или добавьте текст readLn(n); перед или после ввода чисел диапазона Приложение: Program Pr1; uses crt; n=25; var a:array[1..n] of real; i:byte; c,d:real; BEGIN clrscr; readLn(c,d); {Ввод чисел диапазона} for i:=1 to n do read(a[i]); {Считывание элемента} for i:=1 to n do begin if (a[i]>c) and (a[i]<d) then begin write(a[i]:8:2); {Вывод на экран} end; readLn;{Ожидает нажатия Enter, для просмотра пезультата} END.

Ответ отправил: Жиляев (статус: 1-ый класс) Ответ отправлен: 21.03.2008, 13:48 Оценка за ответ: 4

Вопрос № 128.382

Здравствуйте, могли бы вы мне помочь и решить такие задания. Задание 1. Вычислить выражение: y = d1 (a, b, a + c) * d2 (a+3, 4b+1, ac) + d3 (a/2, c, 3b), где функция d1 (x, y, z) – определяет наименьшее среди x, y и z, d2 (x, y, z) – вычисляет модуль произведения x, y и z, d3 (x, y, z) – вычисляет разность модулей x, y и z. Задание 2. Создайте функцию, вычисляющую сумму целых поло- жительных чисел среди шести действительных. По- стройте блок-схему процедуры. Обоснуйте выбор меха- низма передачи параметров. Задание 3. Создать программу, обрабатывающую шесть чисел с ис- пользованием всех арифметических операций с помо- щью процедур и функций. Заранее большое спасибо...

Отправлен: 21.03.2008, 09:28 Вопрос задала: Milya.90 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Milya.90! По первой задаче не совсем понятно условие "вычисляет разность модулей x, y и z. ". Как вычисляет, в каком порядке. Написал код как понял, если что переделать одна минута. Условие второй и особенно третьей что-то до мкня не дошло. Код первой задачи в приложении. Приложение: uses crt; var a,b,c:real; function d1(x,y,z:real):real; begin if (x<=y)and(x<=z) then d1:=x else if (y<=x)and(y<=z) then d1:=y else if (z<=x)and(z<=y) then d1:=z; end; function d2(x,y,z:real):real; begin d2:=abs(x*y*x); end; function d3(x,y,z:real):real; begin d3:=abs(x)-abs(y)-abs(z); end; begin clrscr; Write('a=');readln(a); Write('b=');readln(b); Write('c=');readln(c); Writeln; Writeln('d1=',d1(a,b,(a+c)):5:2); Writeln('d2=',d2((a+3),(4*b+1),(a*c)):5:2); Writeln('d3=',d3(a/2,c,3*b):5:2); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 10-ый класс) Ответ отправлен: 21.03.2008, 11:55 Оценка за ответ: 4 Комментарий оценки: Большое спасибо за помощь... я вам очень благодарна

Вопрос № 128.399

Уважаемые Эксперты. Помогите пожалуйста в написании программ : 1)Вычислить выражение: y = v1 (a, b, c) + v2 (a+3, 4b+1, ac) + v3 (a/2, c, 3b), где функция v1 (x, y, z) – вычисляет выражение 7x+y*z, v2 (x, y, z) – вычисляет сумму x, y и z, функция v3 (x,y,z) – разность x, y и z. 2) Создать функцию, обеспечивающую ввод с клавиатуры целого положительного трехзначного числа. Вводимый символ должен появиться на экране, если он – цифра. 3) Создать программу, выполняющих четыре арифметические операции над тремя целыми положительными трех- значными числами с помощью процедур и функций.

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

Отвечает: Delph Здравствуйте, Федосов Александр Иванович! Предлагаю Вашему вниманию решение второй из Ваших задач (см. приложение). Чтение символа с клавиатуры обеспечивает стандартная функция ReadKey. Ord() в данном случае позволяет узнать код символа, хотя в общем случае её применение значительно шире. Логика настолько проста, что разберётесь, думаю, быстро. Приложение: Program Pr128399; Uses CRT; Function ReadNum: Integer; var r: Integer; c: Char; begin r := 0; Repeat c := ReadKey; if c in ['0'..'9'] then begin r := r * 10 + Ord(c) - Ord('0'); if r > 0 then Write(c); end; Until r > 100; end; Var Num: Integer; Begin ClrScr; Write('Введите число: '); Num := ReadNum; WriteLn; WriteLn('Вы ввели: ', Num); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 21.03.2008, 12:51 Оценка за ответ: 4 Комментарий оценки: Решение мне понравилось, но мне показалось, что его можно облегчить, используя банальную защиту от дурака: while (Num<100) or (Num>=1000) do ...

Отвечает: Пупорев Юрий Борисович Здравствуйте, Федосов Александр Иванович! Решение первой задачи в приложении. Приложение: uses crt; var a,b,c:real; function v1(x,y,z:real):real; begin v1:=7*x+y*z; end; function v2(x,y,z:real):real; begin v2:=x+y+x; end; function v3(x,y,z:real):real; begin v3:=x-y-z; end; begin clrscr; Write('a=');readln(a); Write('b=');readln(b); Write('c=');readln(c); Writeln; Writeln('v1=',v1(a,b,c):5:2); Writeln('v2=',v2((a+3),(4*b+1),(a*c)):5:2); Writeln('v3=',v3(a/2,c,3*b):5:2); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 10-ый класс) Ответ отправлен: 21.03.2008, 14:41 Оценка за ответ: 5 Комментарий оценки: Отличное решение. Спасибо Вам огромное !

Отвечает: Marked One Здравствуйте, Федосов Александр Иванович! Ответы на вопрос 1 и 2 в приложении. Все проверено Удачи!!! Приложение: {№1} program q128399; Function v1(const x, y, z: real):real; begin result:=7*x+y*z; end; Function v2(const x, y, z: real):real; begin result:=x+y+z; end; Function v3(const x, y, z: real):real; begin result:=x-y-z; end; var a, b, c, y:real; begin Write('a='); readLn(a); Write('b='); readln(b); Write('c='); ReadLn(c); y:=v1(a, b, c)+v2(a+3, 4*b+1, a*c)+v3(a/2, c, 3*b); Write('v1(a, b, c) + v2(a+3, 4b+1, ac) + v3(a/2, c, 3b) = ', y:0:3); ReadLn(a); end. {№3} program q128399; Function plus(const x, y, z:integer):integer; begin result:=x+y+z; end; Function min(const x, y, z: integer):integer; begin result:=x-y-z; end; Function umnojenie(const x, y, z:integer):integer; begin result:=x*y*z; end; Function delenie(const x, y, z: integer):real; begin result:=x/y/z; end; var a, b, c:integer; begin Write('a='); ReadLn(a); Write('b='); ReadLn(b); Write('c='); ReadLn(c); Write('x+y+z=',plus(a, b, c), ' a-b-c=', min(a, b, c), ' a*b*c=', umnojenie(a, b, c), ' a/b/c=', delenie(a, b, c):0:2); ReadLn(a); end.

Ответ отправил: Marked One (статус: 9-ый класс) Ответ отправлен: 21.03.2008, 14:50 Оценка за ответ: 5 Комментарий оценки: Все отлично. Спасибо за Ваш труд.

Вопрос № 128.418

Дана целочисленная матрица, среди строк этой матрицы, которые содержат только нечетные элементы, найти строку с максимальной суммой модулей элементов. Нужно решить эту задачу с помощью двумерных массивов.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Cobain! Код с комментариями в приложении. Приложение: uses crt; const n=4; m=3; var a:array[1..n,1..m]of integer; b:array[1..n]of integer; i,j,k,sum,max,imax:integer; begin clrscr; for i:=1 to n do for j:=1 to m do begin write('a[',i,',',j,']='); readln(a[i,j]); end; clrscr; writeln('Ishodnaia matrica:'); for i:=1 to n do begin for j:=1 to m do begin write(a[i,j]:3); end; writeln; end; readln; for i:=1 to n do begin k:=0;sum:=0; for j:=1 to m do if a[i,j] mod 2<>0 then begin k:=k+1; sum:=sum+abs(a[i,j]);{считаем сумму модулей нечетных} end; if k=m then b[i]:=sum;{если все нечетные, вводим в массив} end; max:=b[1]; imax:=1; for i:=1 to n do if b[i]>max then begin max:=b[i]; {в массиве ищем максимальную сумму и номер строки} imax:=i; end; Writeln('max summa=',max,' v stroke ',imax); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 10-ый класс) Ответ отправлен: 21.03.2008, 16:50 Оценка за ответ: 4

Вопрос № 128.428

Здравствуйте, уважаемые эксперты! Сегодня вот такая задача: найдите k-ю цифру в последовательности 123456789101112131415..., в которую записали подряд все натуральные числа. Я составил пока программу для одно- и двузначных чисел, вот только где-то у меня ошибка. А ещё мне кажется, что можно обойтись и без массивов. Подскажите мне пожалуйста. Программа в приложении. Заранее благодарю. Приложение: Var x: Array[0..9] Of Integer; y: Array[10..99] Of Integer; z: Array[100..999] Of Integer; k, i, p1, p2, ans: Integer; Begin ans := 1; p1 := 0; p2 := 0; For i := 1 To 9 Do Begin x[i-1] := i; End; For i := 10 To 99 Do Begin y[i-1] := i; End; For i := 100 To 999 Do Begin z[i-1] := i; End; Write('k = '); ReadLn(k); If ((k >= 1) And (k <= 9)) Then Begin ans := k; End; If ((k >= 10) And (k <= 99)) Then Begin For i := 10 To 99 Do Begin If (i = (k-9) Div 2) Then Begin If (Not(Odd(k-9))) Then Begin ans := y[i] Mod 10; End Else Begin ans := y[i] Div 10; End; End; End; End; WriteLn(ans); ReadLn; End.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Хощенко Артём Владимирович! Эта задача решается без массивов и вообще без какого-либо сохранения в памяти, т.к. ряд уже упорядочен. Нужно только сначала добавить количество цифр начиная с 10 по 1, с 100 по 2 и т.д. После того как достигли, или перешагнули нужную цифру, возвращаемся назад, превращая цифры в числа и в нужном числе находим нужную цифру. Код в приложении. Приложение: program q8428; uses crt; var i,j,k,n,o:integer; a,t:longint; begin clrscr; write('Введите k=');readln(k); t:=0;i:=0; repeat t:=t+1; j:=t; while j>0 do{считаем количество цифр и добавляем к общему количеству} begin j:=j div 10; i:=i+1; end; until i>=k; while i>=k do{возвращаемся по цифрам последнего числа до нужной} begin o:=t mod 10; t:=t div 10; i:=i-1; end; writeln('k-я цифра :',o); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 10-ый класс) Ответ отправлен: 21.03.2008, 15:17 Оценка за ответ: 5

Вопрос № 128.435

Здавствуйте эксперты! Помогите очень с 2-мя задачками, что-то я немного не понял как их делать: (Задача №1): Ввести строку символов. Найти символ, который чаще всего встречается в строке. (Задача №2): Написать процедуру, которая выводит таблицу значений функции y=(x+5)-10. Исходные данные (начальные и конечное значение X, шаг приращения X) вводятся в основной программе и передаются в процедуру. Помогите пожалуйста, очень надо.

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

Отвечает: Delph Здравствуйте, Pusja Kosin Barkovich! Ваша первая задача довольно похожа на ту, что предложена в вопросе 128309, хотя там задача представлена посложнее (из-за этого и была оформлена процедура). Ту программу с небольшими упрощениями предлагаю Вашему вниманию. Приложение: Program Pr128435; Uses CRT; Type TCharsCount = Record ch: Char; Cnt: Byte; End; { Разбор строки } Procedure WordScan(str: String); var CharsCount : Array[0..255] of TCharsCount; i, j : Integer; tmp : TCharsCount; begin { Обнуление счётчиков и заполнение символов массива } for i := 0 to 255 do begin CharsCount[i].ch := Chr(i); CharsCount[i].Cnt := 0; end; { Подсчитываем частоту символов } for i := 1 to Length(str) do inc(CharsCount[ord(str[i])].Cnt); { Сортируем массив по убыванию частоты символов } for i := 0 to 254 do for j := i + 1 to 255 do if CharsCount[i].Cnt < CharsCount[j].Cnt then begin tmp := CharsCount[i]; CharsCount[i] := CharsCount[j]; CharsCount[j] := tmp; end; WriteLn; Write('Самый частый символ в строке: ', '"', CharsCount[0].ch, '", '); WriteLn('встречается ', CharsCount[0].Cnt, ' раз(а)'); end; Var Str: String; Begin ClrScr; WriteLn('Введите строку: '); ReadLn(str); WordScan(Str); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 21.03.2008, 16:15 Оценка за ответ: 4

Отвечает: Пупорев Юрий Борисович Здравствуйте, Pusja Kosin Barkovich! Решения обоих задач в приложении. К первой задаче привел комментарии, вторая понятна и так. Приложение: Задача 1. uses crt; var s:string; b:array[1..255]of integer;{массив кодов символов} i,j,k,max,imax:integer; begin clrscr; write('s: ');readln(s); for i:=1 to 255 do begin k:=0; for j:=1 to length(s) do if chr(i)=s[j] then {если символ есть в строке, считаем} begin k:=k+1; end; b[i]:=k; {массив встречаемости символов} end; max:=b[1];imax:=1; for i:=1 to 255 do if b[i]> max then begin max:=b[i]; {количество совпадений} imax:=i; {номер кода самого частого символа} end; writeln('Simvol ',chr(imax),' vstrechaetsa ',max,' raz'); readln end. Задача 2. Program ZAD2; uses crt; var y,x,x0,xn,hx:integer; i:integer; begin clrscr; x:=0; xn:=10; hx:=1; while (x<=10) do begin y:=(x+5)-10; writeln ('x=',x,' y=',y); x:=x+hx; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 10-ый класс) Ответ отправлен: 21.03.2008, 17:59 Оценка за ответ: 5

Вопрос № 128.463

Дан список фамилий и номеров телефонов абонентов. Составить отдельный список номеров телефонов. Данные абонентов ввести в файл АБОНЕНТ.ТХТ. Результат работы программы записать в файл REZULT.TXT. т.е. список номеров должен быть в файле REZULT.TXT помогите пожалуйста! :)

Отправлен: 21.03.2008, 18:59 Вопрос задал: SaHek (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, SaHek! Решение задачи в прложении. Комментарии небольшие , по-моему там все просто. Приложение: uses crt; const n=3; type spisok=record {тип запись с полями по условию} fam:string[20]; nom:string[20]; end; var s:array[1..n]of spisok;{массив записей} i:integer; f,g:text; {файловые переменные} begin clrscr; for i:=1 to n do begin {составлянм список и заносим его в массив} write('familia:');readln(s[i].fam); write('telefon:');readln(s[i].nom); end; assign(f,'abonent.txt'); assign(g,'rezult.txt'); rewrite(f); rewrite(g); for i:=1 to n do writeln(f,s[i].fam);{записываем в файл фамилии} for i:=1 to n do writeln(g,s[i].nom); {записываем в другой файл номера телефонов} close(f); close(g); end.

Ответ отправил: Пупорев Юрий Борисович (статус: 10-ый класс) Ответ отправлен: 21.03.2008, 19:21 Оценка за ответ: 5

Отвечает: Шемет Станислав Васильевич Здравствуйте, SaHek! Программа в приложении. Удачи !!! Приложение: const n=100; Type TAbonent=Record LastName:string; Number:string[50];(*Максимальная длина номера абонента 50 символов*) end; Var Abonent:array[1..n] of Tabonent; F1,F2:text; i:integer; Procedure Info; Begin For i:=1 to n do Begin Writeln; Writeln('Всего абонентов: ',n); Writeln('Текущий абонент: ',i); Write('Фамилия абонента: '); Readln(Abonent[i].Lastname); Write('Номер телефона абонента: '); Readln(Abonent[i].Number); end; end; Begin Assign(f1,'Abonent.txt'); Assign(f2,'Result.txt'); Rewrite(f1); Rewrite(f2); Writeln('Заполните информацию о абонентах'); Info; (*Запись информации в файлы*) For i:=1 to n do Begin Writeln(f1,Abonent[i].LastName);(*Запись фамилии абонента в файл Abonent.txt*) Writeln(f1,Abonent[i].Number);(*Запись номера телефона абонента в файл Abonent.txt*) Writeln(f2,Abonent[i].number);(*Запись номера телефона абонента в файл Result.txt*) end; Close(f1); Close(f2); Writeln('Программа завершила свою роботу '); Writeln('Нажмите Enter...'); Readln; end. --------- Любовь это прекрасно!!!

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

Вопрос № 128.486

Помогите пожайлуста !! Тугри туртбурчакнинг бирор учи атрофида айлантирувчи дастур тузинг. Дастур иши "С" клавиши ёрдамида тухтасин. Наверно так переводится Вкрутить четырёхуголник ABCD вокруг себя из любой точки А или В и т д.И остановился он нажав клавиш"с". ------------------------------------------------------ Перевод: Написать программу вращения прямоугольника вокруг одного из своих углов. Программа работает пока не нажата клавиша "С". Оформлен перевод. ----- ∙ Отредактировал: sir henry (Академик) ∙ Дата редактирования: 22.03.2008, 07:21

Отправлен: 21.03.2008, 21:41 Вопрос задала: Nargis Haydarova (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Louken Здравствуйте, Nargis Haydarova! Текст программы с комментариями в приложении: Приложение: program z; uses Graph, Crt; {Поворот точки (pointX, pointY) вокруг центра (centerX, centerY)} procedure RotatePoint(Angle: real; var pointX, pointY: integer; const centerX, centerY: integer); var SinVal, CosVal: real; pX: integer; begin pointX:=pointX-centerX; pointY:=pointY-centerY; Angle:=Angle*Pi/180; SinVal:=Sin(Angle); CosVal:=Cos(Angle); pX:=pointX; pointX:=Round(pointX * CosVal - pointY * SinVal)+centerX; pointY:=Round(pointY * CosVal + pX * SinVal)+centerY; end; const RectWidth = 150; {Ширина прямоугольника} RectHeight = 120; {Ширина прямоугольника} var grDriver,grMode : integer; ch: char; {символ нажатой клавиши} Ax,Ay, Bx,By, Cx,Cy, Dx,Dy: integer; {реальные координаты прямоугольника, неповернутые} tBx,tBy, tCx,tCy, tDx,tDy: integer; {временные координаты прямоугольника, повернутые} Angle: real; {угол поворота, можно использовать и очень маленькие углы поворота} begin {инициализируем графический режим} grDriver:=VGA; grMode:=VGAHi; {путь к папке BGI с драйвером поставьте свой} InitGraph(grDriver,grMode,'D:progTP7BGI'); Delay(20000); {задержка в начале программы} {Задаем координаты прямоугольника} Ax:=320; Ay:=240; Bx:=Ax+RectWidth; By:=Ay; Cx:=Ax+RectWidth; Cy:=Ay+RectHeight; Dx:=Ax; Dy:=Ay+RectHeight; Angle:=0; Repeat Delay(100); {очищаем экран} SetFillStyle(SolidFill, 0); Bar(0, 0, 640, 480); {Вращаем точки B, C, D вокруг точки A} tBx:=Bx; tBy:=By; RotatePoint(Angle, tBx, tBy, Ax, Ay); tCx:=Cx; tCy:=Cy; RotatePoint(Angle, tCx, tCy, Ax, Ay); tDx:=Dx; tDy:=Dy; RotatePoint(Angle, tDx, tDy, Ax, Ay); {Рисуем прямоугольник} SetColor(15); MoveTo(Ax, Ay); LineTo(tBx, tBy); LineTo(tCx, tCy); LineTo(tDx, tDy); LineTo(Ax, Ay); Angle:=Angle+1; if KeyPressed then ch:=UpCase(ReadKey); Until ch='C'; {Выходим из графического режима} CloseGraph; end.

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 22.03.2008, 09:37 Оценка за ответ: 5 Комментарий оценки: Катта рахмат! Это значит спосибо большое(но не абра-кадабра).Всё отлично получилось.!!!

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