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

Выпуск № 478
от 04.11.2007, 14:35

Вопрос № 106.762

1. Какие значения примут переменные с и d после выполнения следующего фрагмента программы: c:=1; d:=0; while d<50 do begin d:=d+sqr(c); c:=c+1; end; 2. Какое значение примет переменная А после выполнения следующего фрагмента программы: А:=1; b:=false; repeat А:=А+1; b:=b or (A>10) until b; 3. Какое значение примет переменная А после выполнения следующего фрагмента программы: A:=0; for i:=10 downto 7 do А:=A+i; 4. Практическое задание 1. Заданы три вещественных числа: 1) определить, что больше: сумма или произведение этих чисел, 2) вывести на экран отдельно целую и дробную часть суммы.(подобное было-"что больше: сумма или произведение", но здесь дополнительное задание) 5. Практическое задание 2. Напишите программу, рисующую разными цветами N линий (N вводится пользователем), причем расположение и длина линий выбирается случайным образом, и начало следующей линии должно совпадать с концом предыдущей. 6. Создать текстовый файл fonotek.txt, содержащий сведения о музыкальных альбомах различных групп (название группы, название альбома, год выпуска, стиль). Удалить из файла все альбомы в стиле pop и techno. Переписать в другой файл информацию об альбомах в порядке убывания года выпуска. Приложение: К четвертому заданию (спасибо Артёму и др. экспертам): Var a, b, c: real; begin writeln ('Введите три числа'); readln (a, b, c); if (a+b+c)>(a*b*c) then writeln ('Сумма больше') else if (a+b+c)<(a*b*c) then writeln ('Произведение больше') else writeln ('Они равны'); end.

Отправлен: 25.10.2007, 17:51 Вопрос задал: Сараев Лаврентий Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Сараев Лаврентий Александрович! И что же сложного Вы нашли в этих задачах? Любая из них решается за 5 минут максимум, если заглянуть хотя бы в справочник функций Паскаля. Вот Вам задачи 1-5 1. Цикл выполняется пока d не станет больше 50. Функция sqr (х) возводит х в квадрат. с = 1 d = 0 - 1 шаг c = 2 d = 1 - 2 шаг c = 3 d = 5 - 3 шаг c = 4 d = 14 - 4 шаг c = 5 d = 30 - 5 шаг c = 6 d = 55 > 50 - условие выхода из цикла выполнилось, это ответ 2. A = 11, поскольку цикл будет выполняться, пока b = false, а оно станет равно true только тогда, когда выполнится условие А > 10 (or (или) возвращает true, когда один из операндов становится равен true). 3. A = 4, поскольку цикл будет выполняться от 10 до 7 с шагом -1, количество повторений цикла равно 10-7+1=4. Задачи 4 и 5 смотрите в приложении. Приложение: 4. Var a, b, c: real; begin writeln ('Введите три числа'); readln (a, b, c); if (a+b+c)>(a*b*c) then writeln ('Сумма больше') else if (a+b+c)<(a*b*c) then writeln ('Произведение больше') else writeln ('Они равны'); writeln ('Целая часть: ', Int (a+b+c)); {функция Int возвращает целую часть} writeln ('Дробная часть: ', Frac (a+b+c)); {функция Frac возвращает дробную часть} end. 5. uses Graph; {подключение графического модуля} Var grDriver: integer; {драйвер} grMode: integer; {графический режим} ErrCode: integer; x, y, n, color: integer; begin readln (n); grDriver:= VGA; {режим VGA} grMode:= VGAHi; {разрешение 640х480} InitGraph (grDriver, grMode, 'c: p7egavga.bgi'); {тут указать реальный путь к файлу egavga.bgi} ErrCode:= GraphResult; {проверить код ошибки} if (ErrCode<>grOk) then begin writeln ('Ошибка инициализации графического режима'); halt (1); {выход из программы} end; color:= 0; randomize; x:= random (639); {произвольное х от 0 до 639 (макс. значение} y:= random (479); {произвольное у от 0 до 639 (макс. значение} MoveTo (x, y); {ставим курсор в эту точку} for i:=1 to n do begin SetColor (color); {установим цвет} if color<15 then inc (color) else color:= 0; {изменим цвет} x:= random (639); y:= random (479); LineTo (x, y); {чертим линию из текущей точки в указанную} MoveTo (x, y); {ставим курсор на конец линии} end; CloseGraph; {закрываем графический режим} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 25.10.2007, 21:58 Оценка за ответ: 5 Комментарий оценки: Спасибо. Но почему же никто не может решить шестое задание? (Создать текстовый файл fonotek.txt, содержащий сведения о музыкальных альбомах различных групп (название группы, название альбома, год выпуска, стиль). Удалить из файла все альбомы в стиле pop и techno. Переписать в другой файл информацию об альбомах в порядке убывания года выпуска.)?

Вопрос № 106.936

Уважаемые эксперты! У меня возник такой вопрос по поводу ускорения вывода изображения на экран в Паскале (Real mode) средствами модуля Graph BMP файла (640х480х16 цветов). Вот программа, которую я написал, но она работает очень медленно даже на Core2 Duo. Пожалуйста помогите Приложение: uses graph; var a,b,x,y:integer; c:byte; f:file of byte; begin initgraph (a,b, 'c:pgi'); assign(f,'zast.bmp'); reset(f); seek(f,118); x:=1;y:=1; while not eof(f) do begin read(f,c); a:=c and 15; b:=c and 240; b:=b shr 4; putpixel(x,y,b); putpixel(x+1,y,a); if x>=640 then begin x:=1; y:=y+1; end; x:=x+2; end; close(f); readln; closegraph; end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Каракулов Алексей Валентинович! Операции работы с файлами ( чтения / записи ) не самые быстрые, а Вам нужно повторит эту операцию 307200(640*480) раз считывая побайтно файл заставки. Ускорить этот процесс можно если читать по блокам в память и уже потом обрабатывать полученную информацию. Операции: a:=c and 15;{a:=c & 000011112} b:=c and 240;{b:=c & 11110002} b:=b shr 4;{b:=(сдвинуть вправо)000011112} полностью эквивалентны строкам: a:=c mod 16; b:=c div 16; на одну команду меньше, будет немного быстрее. На участках кретичным ко времени выполнения лутше переходить на встроенный ассемблер(это моё мнение). Удачи! --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Специалист) Ответ отправлен: 29.10.2007, 16:57 Оценка за ответ: 3 Комментарий оценки: Меня как раз интересовал вопрос, как же не использовать putpixel, икаким образом организовать поблочное чтение данных

Вопрос № 106.952

Здравствуйте, не могу решить одну задачу: Составьте программу нахождения произведения двух наибольших из пяти чисел введенных с клавиатуры Я пишу сначала код для нахождения самого большого числа (приложение) и компиляор мне пише: error in statement. В чем тут ошибка? Приложение: writeln ('введите 5 чисел'); readln (a,b,c,d,e); if a>b then max:=a else max:=b; if b>c then max:=b; else max:=c; if c>d then max:=c; else max:=d; if d>e then max:=d; else max:=e;

Отправлен: 27.10.2007, 07:03 Вопрос задал: Исаак Моисеевич (статус: 2-ой класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 25)

Отвечает: Djec Здравствуйте, Исаак Моисеевич! В Pascal точка с запятой ";" перед else не ставится. Вот в чем ваша ошибка. --------- Никогда не сдавайся, даже если боишься проиграть

Ответ отправил: Djec (статус: 3-ий класс) Ответ отправлен: 27.10.2007, 12:28 Оценка за ответ: 5

Отвечает: Pavl Здравствуйте, Исаак Моисеевич! Перед else нельзя ставить точку с запятой. Вот цитата из Фаронова: "Структура условного оператора имеет вид: if <условие> then <оператор1> else <оператор2>"

Ответ отправил: Pavl (статус: 1-ый класс) Ответ отправлен: 27.10.2007, 17:10 Оценка за ответ: 5

Отвечает: Артём1983 Здравствуйте, Исаак Моисеевич! Начну с Вашего кода. Вам следует убирать знак ";" перед else, если Вы используете именно эту кострукцию. writeln ('введите 5 чисел'); readln (a,b,c,d,e); if a>b then max:=a else max:=b; if b>c then max:=b else max:=c; if c>d then max:=c else max:=d; if d>e then max:=d else max:=e; Теперь я опишу своё решение. Задачу решал используя одномерный массив. В начале я записал в массив все числа введёные с клавиатуры. Потом я отсортировал его по убыванию. В конце я просто перемножил два первых элемента. Приложение: {106952} uses crt; var a:array[1..5]of integer; i,max,n,swap:integer; begin clrscr; writeln ('ўўҐ¤ЁвҐ 5 зЁбҐ«'); for i:=1to 5do begin write('ўўҐ¤ЁвҐ зЁб«® #',i,' = '); readln(a[i]); end; {============б®авЁа®ўЄ =============} while n<5do begin n:=0; for i:=1to 5do begin if i=5 then begin if a[i-1]<a[i] then begin swap:=a[i-1]; a[i-1]:=a[i]; a[i]:=swap; end else begin n:=n+1; end; end else begin if a[i]<a[i+1] then begin swap:=a[i]; a[i]:=a[i+1]; a[i+1]:=swap; end else begin n:=n+1; end; end; end; end; {===================================} {if a>b then max:=a else max:=b; if b>c then max:=b else max:=c; if c>d then max:=c else max:=d; if d>e then max:=d else max:=e; {===================================} for i:=1to 5do write(a[i]:3); writeln; write('б㬬  ¤ўге ¬ ЄбЁ¬ «м­ле зЁбҐ« =',a[1]*a[2]); readln end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 5-ый класс) Ответ отправлен: 27.10.2007, 21:37 Оценка за ответ: 5

Вопрос № 106.992

Здравствуйте уважаемые эксперты! Есть задачка: Введите три числа. Если они могут быть длинами сторон остро- угольного треугольника, выведите их в порядке убывания и вычислите площадь полученного треугольника. Вопрос: числа - динамические, каким образом можно проверить - является ли треугольник острым - при динамических значениях??

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

Отвечает: Решетник Д Здравствуйте, Игнатов Игнат Игнатович! посмотрите школьную программу по геометрии... были такие формулы s = sqrt(p(p-a)(p-b)(p-c)), где p = (a+b+c)/2 a,b,c - стороны также можно воспользоваться теоремами косинусов и синусов (наверное, все же первой) для поиска углов... если не получится, давайте будем разбирать через мини форум теоретическую часть. --------- Жизнь коротка, чтобы писать на ассемблере

Ответ отправил: Решетник Д (статус: Студент) Ответ отправлен: 27.10.2007, 16:44

Вопрос № 107.070

Здравствуйте прошу вас решить 1)Даны целые числа a1, ..., a10, целочисленная квадратная матрица порядка n. Заменить нулями в матрице те элементы с чётной суммой индексов, для которых имеются равные среди a1, ..., a10. 2)Цилиндр объема единица имеет высоту h. Определить радиус основания цилиндра для значений h, равных 0.5, 1, 1.5, ..., 5. Зарание блогодарен.

Отправлен: 28.10.2007, 08:26 Вопрос задал: Alex Bond (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Vassea Здравствуйте, Alex Bond! Программы в приложении Для первой программы: в массиве data --целые числа от а1 до а10 в массиве mat -- матрица размеры 100 на 100 => максимальное значение n=100 В программе сначала вводим эти матрицы и значение n После чего начинаем просматривать каждый элемент(1). если сумма координат не нечетное число, то сравниваем этот элемент с каждым из массива data В случае если найдется равный ему, то мы обнуляем этот элемент матрицы mat после произведенных операций мы выводим измененную матрицу Для второй программы Нам необходимы значения h от 0.5 до 5 или от 1/2 до 10/2 => берем цикл for i:=1 to 10 и значения h -- это половина i объем конуса 1/3 * pi * r^2 * h = 1 => r=sqrt(3/h/pi) подставляем эту формулу и выводим результаты. Приложение: Program Res; var data : array [1..10] of integer; Mat : array [1..100,1..100] of integer; n:integer; i,j,z:integer; begin writeln('ўў®¤ 1 10'); for i:=1 to 10 do begin writeln('a',i); readln(data[i]); end; write('n='); readln(n); writeln('ўў®¤ ¬ ваЁж '); for i:=1 to n do for j:=1 to n do begin write('M(',i,',',j,')='); readln(mat[i,j]); end; {1} for i:=1 to n do for j:=1 to n do if not odd(i+j) then for z:=1 to 10 do if mat[i,j]=data[z] then mat[i,j]:=0; for i:=1 to n do begin writeln; for j:=1 to n do begin write(mat[i,j],' '); end; end; readln; end. program res2; var h:real; i:integer; r:real; begin for i:=1 to 10 do begin h:=i/2; writeln('r=',sqrt(3/h/pi)); end; readln; end.

Ответ отправил: Vassea (статус: 7-ой класс) Ответ отправлен: 28.10.2007, 14:56

Отвечает: Артём1983 Здравствуйте, Alex Bond! Вашу первую задачу я решал используя динамический массив. Вначале я генерирую саму матрицу потом те десять чисел с которыми надо сравнивать. Ну а потом уже сравниваю. Вторая задача. Я использовал цикл repeat until. Код обеих программ смотрите в приложении. Приложение: {107070_1} {$R-} uses crt; const numb=10; type lin=array[1..1]of integer; arr=array[1..1]of lin; ArrPtr=^arr; LinPtr=^lin; var A:ArrPtr; L:LinPtr; i,j,k,n:integer; begin clrscr; randomize; write('введите размерность массива ='); readln(n); getmem(a,n*n*sizeof(integer)); getmem(l,n*sizeof(integer)); for i:=1to n do begin for j:=1to n do begin A^[i,j]:=-10+random(21); if j=n then begin write(A^[i,j]:3); writeln; end else begin write(A^[i,j]:3) end; end; end; writeln; for i:=1to numb do begin L^[i]:=1+random(10); write(L^[i]:3); end; writeln; writeln; for i:=1to n do begin for j:=1to n do begin {=============================================} if (i+j)mod 2=0 then begin for k:=1to numb do begin if a^[i,j]=l^[k] then begin a^[i,j]:=0; end; end; end; if j=n then begin write(A^[i,j]:3); writeln; end else begin write(A^[i,j]:3) end; {=============================================} end; end; freemem(a,n*n*sizeof(integer)); freemem(l,n*sizeof(integer)); readln; end. {107070_2} uses crt; const volume=1; var h,square:real; begin clrscr; h:=0.5; writeln('радиус':10,'высота':10); repeat writeln(sqrt(volume/(pi*h)):10:3,h:10:3); h:=h+0.5; until h>5; readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 5-ый класс) Ответ отправлен: 28.10.2007, 18:07

Вопрос № 107.075

Доброе утро! Можно ли решить задачу: Дана функция x=a*sin(k*t+2)*cos(k*t). Составить алгоритм для расчета этой функции, если а изменяется от 5 до 7 с шагом 0.12, t изменяется от 4.2 до 6.2 с шагом 0.17 а k=1,2,3,...,12. тремя способами: 1. используя только цикл while; 2. используя только цикл for; 3. используя только цикл repeat.

Отправлен: 28.10.2007, 09:49 Вопрос задал: Ezhik (статус: Практикант) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: lyalya Здравствуйте, Ezhik! Цикл while program wwhile; var a,t,k,y:real; begin a:=5; while a<7 do begin t:=4.2; while t<6.2 do begin k:=1; while k<=12 do begin y:=a*sin(k*t+2)*cos(k*t); writeln(a:1:4,' ',t:1:4,' ',k:1:2,' ',y:4:8); k:=k+1; end; t:=t+0.17; end; a:=a+0.12; end; readln; end. Цикл repeat program Project2; var a,t,k,y:real; begin a:=5; repeat t:=4.2; repeat k:=1; repeat y:=a*sin(k*t+2)*cos(k*t); writeln(a:1:4,' ',t:1:4,' ',k:1:2,' ',y:4:8); k:=k+1; until k>12; t:=t+0.17; until t>6.2; a:=a+0.12; until a>7; readln; end.

Ответ отправила: lyalya (статус: 1-ый класс) Ответ отправлен: 28.10.2007, 10:12 Оценка за ответ: 5

Вопрос № 107.198

Здравствуйте, уважаемые эксперты помогите решить задачу: В массиве целых чисел с количеством элемнтов n найти наиболее часто встречающееся число. Если таких чисел несколько, определить наименьшее из них

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

Отвечает: Gh0stik Здравствуйте, Андрей Логинов! Вот программа, которая выполняет указанные действия. const n=10; var a:array [1..n] of integer; i,j,mx,mk,k:integer; begin randomize; for i:=1 to n do begin a[i]:=random(n); write(a[i]:3); end; writeln; mx:=a[1]; mk:=1; k:=0; for i:=1 to n do {цикл в котором производим необходимые проверки для получения результата} begin for j:=1 to n do if a[i]=a[j] then inc(k); if ((mk = k) and (mx > a[i])) or (mk < k) {выбираем меньшее из "одинаковых"} then begin mx:=a[i];mk:=k; end; k:=0; end; writeln('mx=',mx,' count=',mk); {выводим число соответствующее условию, а также количество сколько раз это число встречается в массиве} readln; end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

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

Отвечает: Форсман Павел Вячеславович Здравствуйте, Андрей Логинов! Программа примет следующий вид: Program T107198; const nMax=10; {Максимальное количество элементов в массиве} type TVector=array [1..nMax] of integer; {Описание типа массива} var X:TVector; {Массив} i,n,F:byte; {Счетчик, реальное количество элементов, возврат частоты} V:integer; {Возврат значения минимума} Procedure FreqCount(var X:TVector;n:byte;var F:byte;var V:integer); {Обработка} var i,j,tf:byte; {Счетчики, временная переменная частоты} begin V:=X[1]; {Задание начальных условий} F:=1; for i:=1 to n-1 do {Начало перебора массива} begin tF:=1; for j:=i+1 to n do if X[j]=X[i] then inc(tF); {Подсчет числа элементов} if tF>F then {Сравнение с текущей частотой} begin V:=x[i]; F:=tF; end else if (tF=F) and (X[i]<V) then V:=X[i]; {Сравнение на минимум} end; end; begin write('N='); {Ввод элементов массива} readln(n); for i:=1 to n do begin write('X[',i,']='); readln(X[i]) end; FreqCount(X,n,F,V); {Вызов процедуры} writeln('Максимальная частота F=',F); {Вывод результата} writeln('Значение V=',V); readln; end. С уважением, Павел Форсман. --------- Научить нельзя, но можно попробовать научиться!!!

Ответ отправил: Форсман Павел Вячеславович (статус: 2-ой класс) Ответ отправлен: 29.10.2007, 15:07

Вопрос № 107.285

Скажите, пожалуйста, как начертить табличку?

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

Отвечает: Gh0stik Здравствуйте, Byzly! Для постороения "красивой" таблицы рекомендую Вам использовать псевдографику, коды этих символов лежат в диапазоне от 176 до 223. Вот программа которая строит шахматную доску: var i,j:integer; begin writeln('╔═══╤═══╤═══╤═══╤═══╤═══╤═══╤═══╗'); for i:=1 to 8 do begin write('║ '); for j:=1 to 8 do begin if odd(i+j) then write('*') else write(''); {вместо символа 0 рекомендую ставить пробел} if j<8 then write(' │ '); end; writeln(' ║'); if i<8 then writeln('╟───┼───┼───┼───┼───┼───┼──γ 2;┼───╢'); end; writeln('╚═══╧═══╧═══╧═══╧═══╧═══╧═══╧═══╝'); end. Результат выполнения программы: ╔═══╤═══╤═══╤═══╤═══╤═══╤═══╤═══╗ ║ 0 │ * │ 0 │ * │ 0 │ * │ 0 │ * ║ ╟───┼───┼───┼───┼───┼───┼───┼───╢ ║ * │ 0 │ * │ 0 │ * │ 0 │ * │ 0 ║ ╟───┼───┼───┼───┼───┼───┼───┼───╢ ║ 0 │ * │ 0 │ * │ 0 │ * │ 0 │ * ║ ╟───┼───┼───┼───┼───┼───┼───┼───╢ ║ * │ 0 │ * │ 0 │ * │ 0 │ * │ 0 ║ ╟───┼───┼───┼───┼───┼───┼───┼───╢ ║ 0 │ * │ 0 │ * │ 0 │ * 474; 0 │ * ║ ╟───┼───┼───┼───┼───┼───┼───┼───╢ ║ * │ 0 │ * │ 0 │ * │ 0 │ * │ 0 ║ ╟───┼───┼───┼───┼───┼───┼───┼───╢ ║ 0 │ * │ 0 │ * │ 0 │ * │ 0 │ * ║ ╟───┼───┼───┼───┼───┼───┼───┼───╢ ║ * │ 0 │ * │ 0 │ * │ 0 │ * │ 0 ║ ╚═══╧═══╧═══╧═══╧═══╧═══╧═══╧═══╝ Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

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

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