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

Выпуск № 447
от 23.09.2007, 09:35

Вопрос № 102.288

Здраствуйте товарищи эксперты!Помогите пожалуйста! Напишите мне 3 программы!Заранее огромное спасибо!!! 1) Для заданного с клавиатуры натурального числа к, вычислить S: S=(1/sin1)+(1/(sin1+sin2))+...+(1/(sin1+...+sink)) (Эту программу сделать с помощью двойного вложенного цикла) 2)Построить диагональную матрицу D(n+1)(n+1): |Ao 0 0 ... 0| |0 A1 0 ... 0| D=|0 0 A2 ... 0| |.....................| |0 0 0 ... An| 3)Разбить экран главной диагональю. Окрасить верхнюю и нижнюю части экрана красным и синим цветами. Изобразить желтую окружность диаметром D перемещающуюся по вертикали через центр экрана.

Отправлен: 17.09.2007, 09:46 Вопрос задал: Serg (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Delph Здравствуйте, Serg! В приложении решение Вашей первой задачи. Там реализовано 2 варианта: первый, как Вы и просили, в виде двух циклов (второй вложен в первый). Второй вариант оптимизирован по быстродействию, поскольку второй цикл исключён. Вы можете убедиться по выводу, что оба варианта дают одинаковые результаты. Приложение: Program Summa; Uses CRT; var i, j, k: Integer; S, s1: Double; Begin ClrScr; Write('int k = '); ReadLn(k); { Variant 1 } S := 0; for i := 1 to k do begin s1 := 0; for j := 1 to i do s1 := s1 + Sin(j); S := S + 1/s1; end; WriteLn('1) S = ', S:9:6); { Variant 2 } S := 0; s1 := 0; for i := 1 to k do begin s1 := s1 + Sin(i); S := S + 1/s1; end; WriteLn('2) S = ', S:9:6); Repeat Until KeyPressed; WriteLn End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: 9-ый класс) Ответ отправлен: 17.09.2007, 11:06 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, Serg! Смотрите приложение 2-я и 3-я задачи. Последовательность А - не задана, я считал все элементы равными 1. Удачи Вам! Приложение: program q102288bc; uses Graph,Crt; var grDriver,grMode,x,y,xMax,yMax,z:integer; kXY:real; d:packed array[0..20,0..20]of integer; begin {2-я задача:формиуем матрицу} for x:=0 to 20 do begin {чистим все элементы} for y:=0 to 20 do d[x,y]:=0; {задаем нужный элемент} d[x,x]:=1;{элемент последовательности А} end; {выводим по строчно} for x:=0 to 20 do begin for y:=0 to 20 do write(d[x,y]:2); writeln; end; readln; {3-я задача:ставим графический режим} grDriver:=0; InitGraph(grDriver,grMode,''); {чистим экран} ClearDevice; {получаем максимальные значения экрана} xMax:=GetMaxX; yMax:=GetMaxY; kXY:=xMax/yMax; {рисуем фон} for y:=0 to yMax do begin SetColor(1);{синим цетом} Line(0,y,round(kXY*y),y);{ниже диагонали} SetColor(12);{красным цветом} Line(round(kXY*y),y,xMax,y);{выше диагонали} end; {радиус} z:=20; for x:=z+1 to yMax-z-1 do begin {востанавливаем фон в районе окружности} for y:=x-z-1 to x+z+1 do begin SetColor(1); Line(0,y,round(kXY*y),y); SetColor(12); Line(round(kXY*y),y,xMax,y); end; {желтый цвет} SetColor(14); {рисуем окружность} Circle(xMax div 2,x,z); {задержка} Delay(1000); end; readln; CloseGraph; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Специалист) Ответ отправлен: 17.09.2007, 17:56 Оценка за ответ: 5

Отвечает: Tribak Здравствуйте, Serg! 1 задача: program www; uses crt; var r,s:real; i,j,n:integer; begin write('n='); readln(n); s:=0; for i:=1 to n do begin r:=0; for j:=1 to i do r:=r+sin(j); s:=s+1/r; end; writeln(s); readln; end. 2 задача: program www; uses crt; var i,j,n:integer; begin write('n='); readln(n); inc(n); for i:=1 to n do begin for j:=1 to n do if i=j then write('A', i-1,' ') else write('0 '); writeln; end; readln; end.

Ответ отправил: Tribak (статус: 3-ий класс) Ответ отправлен: 17.09.2007, 22:29 Оценка за ответ: 5

Отвечает: Артём1983 Здравствуйте, Serg! Я решил первые две задачи, в третьей сделано не всё.Смотрите приложение. Так же хочу предупредить что в третьем решении могут возникнуть проблемы с путями и драйвером. Приложение: {102228_1} uses crt; var i,k:integer; S:real; begin clrscr; S:=0; write('введите натуральное число k='); readln(k); for i:=0to k do begin S:=S+1/(sin(1*(pi/180))+sin(k*(pi/180))) end; write('сумма ряда S=',S:5:4); readln; end. {102228_2} uses crt; type matrix=array[1..10,1..10]of integer; var i,j:integer; A:matrix; begin clrscr; for i:=1to 10do begin for j:=1to 10do begin if i=j then A[i,j]:=1 else A[i,j]:=0; if j<>10 then write(A[i,j]:2) else begin write(A[i,j]:2); writeln; end; end; end; readln; end. {102228_3} uses graph; const Triangle1: array[1..3] of PointType = ((X: 0; Y: 0), (X: 639; Y: 199), (X: 639; Y: 0)); Triangle2: array[1..3] of PointType = ((X: 0; Y: 0), (X: 639; Y: 199), (X: 0; Y: 199)); var grDriver: Integer; grMode: Integer; ErrCode: Integer; begin grDriver :=EGA; grMode :=EGALo; InitGraph(grDriver, grMode,'C:/BP/BGI/'); ErrCode := GraphResult; if ErrCode = grOk then begin { Do graphics } SetFillStyle(1,4); FillPoly(SizeOf(Triangle1) div SizeOf(PointType), Triangle1); SetFillStyle(1,1); FillPoly(SizeOf(Triangle2) div SizeOf(PointType), Triangle2); Readln; CloseGraph; end else Writeln('Graphics error:', GraphErrorMsg(ErrCode)); end.

Ответ отправил: Артём1983 (статус: 2-ой класс) Ответ отправлен: 20.09.2007, 00:46

Вопрос № 102.340

Нужно решить следующую задачу, задача элементарная, но у меня какие то ошибки он пишет, поэтому прошу написать весь код. Если кому то не сложно: Подсчитать количество отрицательных, среди чисел a, b, c

Отправлен: 17.09.2007, 15:56 Вопрос задал: Вадюкин Николай (статус: Посетитель) Всего ответов: 6 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Andreev Oleg Здравствуйте, Вадюкин Николай! Программа действительно элементарная, проверенна, работает. Если что-то не понятно пишите на почтовый ящик, т.к.отслеживать вопрос бесплатно у меня недостаточный уровень.. program one; uses crt; var a,b,c:real; i:integer; begin writeln('Vvedite a'); readln(a); writeln('Vvedite b'); readln(b); writeln('Vvedite c'); readln(c); i:=0; if a<0 then i:=i+1; if b<0 then i:=i+1; if c<0 then i:=i+1; writeln('Otricatelnyh - ',i); readkey end.

Ответ отправил: Andreev Oleg (статус: 4-ый класс) Ответ отправлен: 17.09.2007, 16:06 Оценка за ответ: 5 Комментарий оценки: Спасибо, ошибку обнаружил

Отвечает: Багиев Александр Здравствуйте, Вадюкин Николай! Элементарно, вот пример из несколько строк: Приложение: otr:=0; if a<0 then inc(otr); if b<0 then inc(otr); if c<0 then inc(otr);

Ответ отправил: Багиев Александр (статус: 2-ой класс) Ответ отправлен: 17.09.2007, 21:16

Отвечает: Gh0stik Здравствуйте, Вадюкин Николай! Вот есть еще один способ и без применения дополнительных переменных, а используя стандартную функцию Ord(). Врезка из справки: Ord (функция) ▀▀▀▀▀▀▀▀▀▀▀▀▀▀ Возвращает порядковое значение выражения перечисляемого типа. Объявление: Function Ord(X) : Longint; Замечания: Параметр X - выражение перечисляемого типа. Результат имеет тип LongInt, a его значение - порядковый номер X в типе. Соответственно Ваше задача может быть записана как: var a,b,c:real; begin a:=-3; b:=-4; c:=5; {определение исходных данных, если необходимо можно организовать ввод с клавиатуры} writeln('Отрицательных чисел', ord(a<0)+ord(b<0)+ord(c<0)); {непосредственно вывод результата} end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 17.09.2007, 21:45

Отвечает: Tribak Здравствуйте, Вадюкин Николай! program www; var a,b,c:real; i:integer; begin write('a='); readln(a); write('b='); readln(b); write('c='); readln(c); i:=0; if a<0 then inc(i); if b<0 then inc(i); if c<0 then inc(i); writeln(i); readln; end.

Ответ отправил: Tribak (статус: 3-ий класс) Ответ отправлен: 17.09.2007, 22:16

Отвечает: Витек Здравствуйте, Вадюкин Николай! var a,b,c:real; n:integer; begin readln(a,b,c); n:=0; if a<0 then inc(n); if b<0 then inc(n); if c<0 then inc(n); write(n); end. --------- ohne fleis, keine preis

Ответ отправил: Витек (статус: 3-ий класс) Ответ отправлен: 18.09.2007, 10:25

Отвечает: Артём1983 Здравствуйте, Вадюкин Николай! Конечно Вы могли бы привести свой код посмотрелибы на Ваши ошибки. Подсказали что не так. Приложение: {102340} uses crt; var a,b,c,counter,i:integer; begin clrscr; counter:=0; for i:=1to 3do begin case i of 1:begin write('введите первое число а='); readln(a); if a<0 then counter:=counter+1; end; 2:begin write('введите второе число b='); readln(b); if b<0 then counter:=counter+1; end; 3:begin write('введите третье число c='); readln(c); if c<0 then counter:=counter+1; end; end; end; write('количество отрицптельных чисел =',counter); readln; end.

Ответ отправил: Артём1983 (статус: 2-ой класс) Ответ отправлен: 20.09.2007, 00:35

Вопрос № 102.427

Здравствуйте эксперты! У меня такой вопрос: в переменной типа Word(слово) как идут байты? То есть слева направо или справо налево(где старший и младший)? В приложении пример конструкции. Приложение: procedure ABC(oldCRC:Word); var abc_arr [0..1] of byte absolute oldCRC;

Отправлен: 18.09.2007, 09:27 Вопрос задал: Muratov Radik (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 7)

Отвечает: Yandrey Здравствуйте, Muratov Radik! Старший слева младший справа. 2F7A зесь 2F старший 7A младший.

Ответ отправил: Yandrey (статус: Студент) Ответ отправлен: 18.09.2007, 09:46 Оценка за ответ: 5 Комментарий оценки: спасибо

Отвечает: Delph Здравствуйте, Muratov Radik! В типе Word ("слово") первым идёт младший байт, а вторым - старший. Приведённая в приложении программа позволяет в этом убедиться. При использовании 32-битных целых "слова" подчиняются тому же правилу: сначала младшее, а уже потом старшее. В итоге самый младший байт оказывается по наименьшему адресу в памяти, а самый старший - по наибольшему. Пошло это с давних времён, когда процессоры были ещё восьмибитными, но подробно об этом рассказать не смогу - сам знаю не много. Приложение: Program Test; Uses CRT; var W: Word; b: Array[0..1] of Byte ABSOLUTE W; Begin ClrScr; W := 96 * 256 + 50; { умножение на 256 помещает число в старший байт } WriteLn('b[0] = ', b[0], ' b[1] = ', b[1]); Repeat Until KeyPressed; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: 9-ый класс) Ответ отправлен: 18.09.2007, 09:48 Оценка за ответ: 5 Комментарий оценки: СПасибо за развернутый ответ, но уточните пжлста где первый и где второй. СЛева напрво или справа на лево?

Отвечает: Багиев Александр Здравствуйте, Muratov Radik! В компьютере младший байт всегда находится в начале, а старший в конце. Это удобно для быстрого преобразования типов.

Ответ отправил: Багиев Александр (статус: 2-ой класс) Ответ отправлен: 18.09.2007, 19:46 Оценка за ответ: 4 Комментарий оценки: Не полный ответ. Непонятно где начало, а где конец?

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