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

Выпуск № 612
от 24.03.2008, 22:35

Вопрос № 128.050

Здравствуйте=) Помогите пож. с задачками=)) 1) Создать программу, обрабатывающую шесть чисел с ис- пользованием всех арифметических операций с помо- щью процедур и функций. 2) Напечатайте непустой текст, удалив из него все буквы "b" , непосредственно перед которыми находится буква "c". 3) Разработайте программу расчета функции y = 4ax2 + 3,7b +c, где с =2,7 a принадлежит [1;2], шаг ha = 0,5; b принадлежит [1;2], шаг hb = 0,5; х принадлежит [0;1], шаг hх = 0,2. Используйте одновременно все три цикла for, repeat и while. ЗАРАНЕЕ ОГРОМНОЕ СПАСИБО=)))

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

Отвечает: Delph Здравствуйте, Осипова Анна Олеговна! В приложении решение третьей из Ваших задач. Поскольку у меня вывод данных не уместился на экране, я продублировал его в файл Result.txt. При желании Вы можете убрать из программы все операции с файловой переменной f, в том числе и её определение. Я пометил комментарием те строки, которые можно удалить, если Вы хотите избавиться от файлового вывода. Только удаляйте либо все эти строки, либо ни одной! Приложение: Program Pr128050; Uses CRT; Function y(a, b, c, x: Real): Real; begin y := 4*a*x*x + 3.7*b + c; end; Var a, b, c, x: Real; i: Integer; f: Text; { эту строку можно удалить } Begin ClrScr; c := 2.7; { строку ниже можно удалить } Assign(f, 'Result.txt'); ReWrite(f); WriteLn(' a b c x y(a,b,c,x)'); WriteLn(f, ' a b c x y(a,b,c,x)'); for i := 2 to 4 do begin a := i / 2; b := 1; while b <= 2 do begin x := 0; Repeat WriteLn(a:7:3, b:7:3, c:7:3, x:7:3, y(a,b,c,x):9:4); { строку ниже можно удалить } WriteLn(f, a:7:3, b:7:3, c:7:3, x:7:3, y(a,b,c,x):9:4); x := x + 0.2; Until x > 1; b := b + 0.5; end; end; Close(f); { эту строку можно удалить } ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 19.03.2008, 08:38

Отвечает: Пупорев Юрий Борисович Здравствуйте, Осипова Анна Олеговна! Мой вариант решения задачи полностью соответствует заданию, предусмотрена прокрутка данных, с тем, чтобы можно было их просмотреть без использования файла. Исрользуются последовательно все три цикла. Код в приложении. Приложение: uses crt; var a,b,ha,hb,y:real; i,p:integer; begin clrscr; ha:=0.5;hb:=0.5;p:=0; a:=1; while a<=2 do begin b:=1; repeat for i:=1 to 6 do begin y:=4*a*sqr(0.2*(i-1))+3.7*b+2.7; p:=p+1; writeln('a=',a:3:1,' b=',b:3:1,' x=',0.2*(i-1):3:1,' y=',y:3:1); if p mod 12=0 then readln; end; b:=b+hb; until b>2; a:=a+ha; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 8-ой класс) Ответ отправлен: 19.03.2008, 08:45

Вопрос № 128.053

Пусть даны координаты трех точек на плоскости.Если они могут быть вершинами равнобедренного остроугольного треугольника,вычислить его площадь.Выведите длины сторон и площадь в порядке возрастания значений.

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

Отвечает: Костя Симанович Здравствуйте, Лиманская Юлия Вадимовна! Расстояние между двумя точками с заданными координатами А(х1, у1), В(х2, у2) находим по формуле D = sqrt(sqr(x2-x1)+sqr(y2-y1)), (где sqrt(x) корень квадратный из х, sqr(x) х в квадрате, не знаю как формулу писать). В решении сперва ищем длинны сторон по введённым координатам, а далее я использовал решение эксперта Пупорева Юрия Борисовича из вопроса №127866 с небольшой доработкой, и проверяем, чтобы был равнобедренный. Удачи! uses crt; var a:array[1..3]of real; i,j:integer; x,cs,sn,s:real; x1, y1, x2, y2, x3, y3 : real; // координаты вершин треугольника begin clrscr; writeln('x1 = '); readln(x1); writeln('y1 = '); readln(y1); writeln('x2 = '); readln(x2); writeln('y2 = '); readln(y2); writeln('x3 = '); readln(x3); writeln('y3 = '); readln(y3); {--------------вычисляем стороны треугольника------------------} a[1] := sqrt(sqr(x2-x1)+sqr(y2-y1)); a[2] := sqrt(sqr(x3-x2)+sqr(y3-y2)); a[3] := sqrt(sqr(x3-x1)+sqr(y3-y1)); for i:=1 to 2 do for j:=1 to 2 do if a[j]>a[j+1] then begin x:=a[j];a[j]:=a[j+1];a[j+1]:=x; end; cs:=(sqr(a[2])+sqr(a[3])-sqr(a[1]))/(2*a[2]*a[3]); sn:=sqrt(1-sqr(cs)); if (a[1]<(a[2]+a[3]))and(cs>0) then begin writeln; writeln('Treugolnik ostrougolny'); if (a[1] = a[2]) or (a[2] = a[3]) or (a[3] = a[1]) then begin writeln('Treugolnik rawnobedrennii'); s:=0.5*a[2]*a[3]*sn; writeln('Ploshad= ',s:5:2); write(a[1]:5:2,' ',a[2]:5:2,' ',a[3]:5:2); end else writeln(' Treugolnik ne rawnobedrennii'); end else writeln('Treugolnik ne ostrougolny ili ne sushestvuet'); readln; end. в приложении продублирован ответ на вопрос № 127866 Приложение: Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимовна! Мне кажется мое решение неплохое. Лего решен вопрос с расположением по убыванию(сортировка в массиве), нет многочисленных сравнений и переборов, а также формулы Герона, одна элементарная планиметрия. Суть решения задачи сводится к нескольким постулатам планиметрии. 1.Треугольник существует, если большая сторона меньше суммы двух других. 2.Наибольший угол лежит против большей стороны (c). 3.Сos этого угла равен (a^2+b^2-c^2)/(2ab). 3.Если синус большего угла >0, треугольник остроугольный. 4.Площадь треугольника равна 1/2ab*sinC sinC=sqrt(1-cos^2). Код в приложении. uses crt; var a:array[1..3]of real; i,j:integer; x,cs,sn,s:real; begin clrscr; for i:=1 to 3 do begin write('a[',i,']='); readln(a[i]); end; for i:=1 to 2 do for j:=1 to 2 do if a[j]<a[j+1] then begin x:=a[j];a[j]:=a[j+1];a[j+1]:=x; end; cs:=(sqr(a[2])+sqr(a[3])-sqr(a[1]))/(2*a[2]*a[3]); sn:=sqrt(1-sqr(cs)); if (a[1]<(a[2]+a[3]))and(cs>0) then begin write(a[1]:5:2,' ',a[2]:5:2,' ',a[3]:5:2); writeln; writeln('Treugolnik ostrougolny'); end else writeln('Treugolnik ne ostrougolny ili ne sushestvuet'); s:=0.5*a[2]*a[3]*sn; writeln('Ploshad= ',s:5:2); readln; end. Отвечает: Костя Симанович Здравствуйте, Лиманская Юлия Вадимовна! Насколько я помню из геометрии остроугольный треугольник это треугольник углы которого меньше 90 градусов. Поэтому предлагаю использовать для решения задачи теорему косинусов. cos(90) = 0 , cos(0) = 1, значит если угол острый то косинус угла будет в диапазоне от 0 до 1, но крайние случаи не рассматриваем (для упрощения задачи, но если хотите можно ввести в задачу эту проверку), а угол 90 градусов это прямоугольный треугольник и под Ваше условие не попадает. поэтому в задаче проверяется, что бы косинус угла был больше 0, но не больше 1. так же я не стал проверять в задаче ввод отрицательных чисел. (хотя если такое возможно, то чтобы не усложнять решение можно воспользоваться функцией ABS ). Вариант решения в приложении. В предыдущем ответе Delph проверяется условие (Каждая из сторон должна быть меньше суммы двух других) помоему не достаточна для определения остроугольного треугольника. т. к. если взять классический прямоугольный треугольник со сторонами 3, 4, 5 то сумма двух сторон будет всегда больше третьей стороны. program treug; var ab, bc, cd : real; a, b , c : real; // cos углов s : real; // площадь p : real; // полупериметр begin writeln('ab = '); readln(ab); writeln('bc = '); readln(bc); writeln('cd = '); readln(cd); if (ab = 0) or (bc = 0) or (cd = 0) then writeln('Стороны не могут иметь 0 длину') else begin a := (ab*ab + cd*cd - bc*bc)/(2*ab*cd); b := (ab*ab + bc*bc - cd*cd)/(2*ab*bc); c := (bc*bc + cd*cd - ab*ab)/(2*bc*cd); if a > 0 then if b > 0 then if c > 0 then begin writeln('Треугольник остроугольный'); writeln('Вычисляем площадь.'); p := (ab + bc + cd)/2; s := sqrt(p*(p - ab)*(p - bc)*(p-cd)); {сортируем стороны} if ab < bc then begin a := ab; ab := bc; bc := a; end; if ab < cd then begin a := ab; ab := cd; cd := a; end; if bc < cd then begin a := bc; bc := cd; cd := a; end; writeln(ab); writeln(bc); writeln(cd); writeln; writeln('Площадь треугольника = ', s:2:2); end else writeln('треугольник не остроугольный') else writeln('треугольник не остроугольный') else writeln('треугольник не остроугольный'); end; readln; end. Отвечает: Delph Здравствуйте, Лиманская Юлия Вадимовна! Решение Вашей задачки в приложении. Program Pr127867; Uses CRT; Var a, b, c, p, S: Real; Begin ClrScr; WriteLn('Введите стороны треугольника:'); Write('a = '); ReadLn(a); Write('b = '); ReadLn(b); if b < a then begin p := a; a := b; b := p; end; Write('c = '); ReadLn(c); if c < a then begin p := a; a := c; c := p; end; if c < b then begin p := b; b := c; c := p; end; if ((a <= 0.0) or (b <= 0.0) or (c <= 0.0)) then begin WriteLn('Все стороны треугольника должны быть положительны!'); end else if ((a >= b + c) or (b >= a + c) or (c >= a + b)) then begin WriteLn('Каждая из сторон должна быть меньше суммы двух других!'); end else begin WriteLn; WriteLn('c = ', c); WriteLn('b = ', b); WriteLn('a = ', a); p := (a + b + c) / 2; { Полупериметр } S := sqrt(p * (p - a) * (p - b) * (p - c)); { формула Герона } WriteLn('Площадь треугольника = ', S); end; ReadLn; End.

Ответ отправил: Костя Симанович (статус: 2-ой класс) Ответ отправлен: 19.03.2008, 22:39

Вопрос № 128.131

Вот есть задачка: в лотереи разыгрывается 10000 билетов с номерами 0, 1, ...., 9999. Билет с номером n считается выигрышным, если в результате преобразований получается четыре: Введите номер билета: 72 Это выигрышный билет т. е. 7*2=14, 1*4=4. Т. е. мы перемножаем цифры этого числа, пока не получим 4. если 4 не равно, то билет не выигрышный. Что-то тольком задача не получается. Как её сделать?

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

Отвечает: Delph Здравствуйте, Хощенко Артём Владимирович! Всё оказалось очень даже просто... Посмотрите организацию циклов внутри функции Lottery_Ticket. Даже рекурсия не понадобилась :) Программа в приложении Приложение: Program Pr128131; Uses CRT; Function Lottery_Ticket(k: Integer): Boolean; var r, g: Integer; begin r := k; While r >= 10 do begin g := 1; while r > 0 do begin g := g * (r mod 10); r := r div 10; end; r := g; end; Lottery_Ticket := (r = 4); end; Var k: Integer; Begin ClrScr; Write('Введите номер билета: '); ReadLn(k); if Lottery_Ticket(k) then WriteLn('У Вас выигрышный билет!!!') else WriteLn('Самый заурядный билет. Вы зря потратили деньги...'); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 19.03.2008, 15:41 Оценка за ответ: 5 Комментарий оценки: Прикольно, спасибо!

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хощенко Артём Владимирович! И другой вариант циклов. Удачи! Приложение: var a,b:integer; begin repeat write('Enter N:'); readln(a); until (a>=0)and(a<10000); repeat b:=1; repeat b:=b*(a mod 10); a:=a div 10; until (a mod 10)=0; a:=b; until(a div 10)=0; writeln(a=4); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 19.03.2008, 16:32 Оценка за ответ: 5 Комментарий оценки: Спасибо! Сам бы не догадался.

Вопрос № 128.153

Уважаемые эксперты! Помогите пожалуйста решить задачу в PASCAL. Дана матрица Y размером (3*5) переставить в матрице столбцы 2 и 4. Напечатать преобразованную матрицу. Создать одномерный массив XP элементами которого являются значения сумм элементов каждого столбца преобразованной матрицы. Вывести массив XP. Заранее БОЛЬШОЕ СПАСИБО!!!! п.с. матрица в приложении. Приложение: Матрица по строкам (1.6 -3.8 1.6 0.1 7.4) (5.1 5.1 0.2 -0.1 1.9) (-1.7 -2.0 2.9 6.7 9.6)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Vl@di! Все сделал, как просили. Оставил ручной ввод элементов матрицы, хотя здесь вполне можно сделать рандомный ввод, намного быстрее, или приведенные вами цифры чем-то дороги вам? Код в приложеннии. Приложение: uses crt; var Y:array[1..3,1..5]of real; XP:array[1..5]of real; i,j,k:integer; x,sum:real; begin clrscr; writeln('Vvedite elementy matricy:'); for i:=1 to 3 do for j:=1 to 5 do begin write('Y[',i,',',j,']='); readln(Y[i,j]); end; clrscr; writeln('Ishodnaia matrica:'); for i:=1 to 3 do begin for j:=1 to 5 do begin write(Y[i,j]:5:1); end; writeln; end; for i:=1 to 3 do begin x:=Y[i,2];Y[i,2]:=Y[i,4];Y[i,4]:=x; end; writeln('Preobrazovannaia matrica:'); for i:=1 to 3 do begin for j:=1 to 5 do begin write(Y[i,j]:5:1); end; writeln; end; for j:=1 to 5 do begin sum:=0; for i:=1 to 3 do begin sum:=sum+Y[i,j]; end; XP[j]:=sum; end; writeln('Massiv summ XP:'); for i:=1 to 5 do write(XP[i]:6:1); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 8-ой класс) Ответ отправлен: 19.03.2008, 18:17 Оценка за ответ: 5 Комментарий оценки: БОЛЬШОЕ ВАМ СПАСИБО!!!!

Отвечает: Tribak Здравствуйте, Vl@di! Код в приложении Программа перенесена в приложение. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 20.03.2008, 16:59 Приложение: program www; uses crt; var Y:array[1..3,1..5] of real; XP,b,c:array [1..5] of real; i,j:integer; begin clrscr; i:=1; j:=1; Y[i,j]:=1.6 ; inc(j); Y[i,j]:=-3.8 ; inc(j); Y[i,j]:=1.6 ; inc(j); Y[i,j]:=0.1 ; inc(j); Y[i,j]:=7.4 ; inc(i); j:=1; Y[i,j]:=5.1 ; inc(j); Y[i,j]:=5.1 ; inc(j); Y[i,j]:=0.2 ; inc(j); Y[i,j]:=-0.1 ; inc(j); Y[i,j]:=1.9 ; inc(i); j:=1; Y[i,j]:=-1.7 ; inc(j); Y[i,j]:=-2.0 ; inc(j); Y[i,j]:=2.9 ; inc(j); Y[i,j]:=6.7 ; inc(j); Y[i,j]:=9.6 ; for i:=1 to 3 do begin b[i]:=Y[i,2]; c[i]:=Y[i,4]; end; for i:=1 to 3 do begin Y[i,4]:=b[i]; Y[i,2]:=c[i]; end; for i:=1 to 5 do XP[i]:=Y[1,i]+Y[2,i]+Y[3,i]; for i:=1 to 3 do begin for j:=1 to 5 do write(Y[i,j]:2:1,' '); writeln; end; writeln; for i:=1 to 5 do write(XP[i]:2:1,' '); readln; end.

Ответ отправил: Tribak (статус: 8-ой класс) Ответ отправлен: 19.03.2008, 18:28 Оценка за ответ: 3 Комментарий оценки: Спасиба!!!!!!!

Вопрос № 128.171

Уважаемые эксперты!помогите решить задачи: 1.Организовать тектовый файл состоящий из N строк.Вывести на экран строки, размер которых больше среднего размера строки в файле. 2.Определить и вывести на экран множество символов входящих только в имя, фамилию или отчество введенных с клавиатуры. 3.Организовать файл, содержащий информацию о книгах.Сведения о каждой из книг - это фамилия автора, название книги, количество страниц и год издания.Найти название книг данного автора, изданных не позднее определенного года.Фамилия автора и год вводятся с клавиатуры

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Азиатова,Регина,Ружановна! Привожу решение первых двух задач, на третью духу не хватило. Если никто не пришлет, завтра как-нибудь передам. В первой задаче все как в условии, создаем файл, заполняем его строками разной длины в количестве N штук. Затем открываем файл для чтения и считываем строки в массив. В массиве суммируем длины строк, считаем округленное среднее и все, что длиннее выводим на экран. Во второй задаче не очень четко понял условие. Поэтому решил ввести разную инфрор мацию о человеке, а символы вывести только те, которые встречаются в имени, фамилии и отчестве. Код двух задач в приложении. Приложение: Задача № 1. uses crt; var f:text; s,s1:array[1..100]of string; n,i,sum,sr:integer; begin clrscr; assign(f,'stroki.txt'); rewrite(f); write('n=');readln(n); for i:=1 to n do begin writeln('Vvedite stroku ',i,':'); readln(s[i]); writeln(f,s[i]); end; close(f); clrscr; assign(f,'stroki.txt'); reset(f); n:=1; while not eof(f) do begin readln(f,s1[n]); n:=n+1; end; close(f); sum:=0; for i:=1 to n do begin sum:=sum+length(s1[i]); end; sr:=round(sum/n); writeln('Sredn dlina stroki=',sr); writeln; writeln('Stroki dlinnee srednei:'); for i:=1 to n do if length(s1[i])>sr then begin writeln(s1[i]); end; readln end. Задача №2. uses crt; const ch=['А'..'п','р'..'ё']; var fam,nam,otc,god,adr:string; i:integer; begin clrscr; writeln('vvedite familiu:');readln(fam); writeln('vvedite imia:');readln(nam); writeln('vvedite otchestvo:');readln(otc); writeln('vvedite god rojdeniia:');readln(god); writeln('vvedite adres:');readln(adr); for i:=1 to length(fam) do if fam[i] in ch then begin write(fam[i],' '); end; writeln; for i:=1 to length(nam) do if nam[i] in ch then begin write(nam[i],' '); end; writeln; for i:=1 to length(otc) do if otc[i] in ch then begin write(otc[i],' '); end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 8-ой класс) Ответ отправлен: 19.03.2008, 22:35

Отвечает: Verena Здравствуйте, Азиатова,Регина,Ружановна! Добавлю третью задачу. Она приятна тем, что можно использовать типизированный файл - запись и извлечение данных сложного типа (в данном случае - запись) в/из него очень просты и не нужно преобразовывать информацию из текстового формата, как пришлось бы делать с текстовым файлом. Решение в приложении, думаю, всё будет ясно из комментариев. Удачи! Приложение: uses crt; Type Book = record {Запись, описывающая книгу} title: string[20]; {Заголовок} auname: string[20]; {Автор} pages: word; {Количество страниц} year: word; {Год} end; cat = file of book; {Тип - каталог книг} Var f: cat; a: book; fnm, aut: string; y: word; Begin writeln ('Vvedite imia faila: '); readln (fnm); {Получаем имя файла для создания} assign (f, fnm); {Ассоциируем файл с именем на носителе} rewrite (f); {Создаём файл (открываем для перезаписи)} writeln ('Najmite ''esc'' dlia vihoda'); repeat {Ввод данных} writeln ('Avtor:'); readln (a.auname); writeln ('Zagolovok:'); readln (a.title); writeln ('Kol-vo stranitz:'); readln (a.pages); writeln ('God:'); readln (a.year); write (f, a); {Пишем структуру в файл} until readkey=#27; {Пока не нажата клавиша esc (её код равен 27)} close (f); {Закрываем файл, чтобы сохранить изменения} reset (f); {Открываем файл для чтения} writeln ('Vvedite avtora i god: '); readln (aut, y); while not eof (f) do {Пока не конец файла} begin read (f, a); {Считываем очередную запись} if (a.auname=aut) and (a.year>=y) then {Если она удовлетворяет нашему условию} writeln (a.title); {Выводим название книги} end; close (f); {Закрываем файл} readkey; end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 20.03.2008, 01:47

© 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