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

Выпуск № 529
от 27.12.2007, 21:35

Вопрос № 115.313

Задан массив с размерностью N=10 найти сумму первых пяти положительных членов. Заранее спасибо!!

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

Отвечает: SHERRY Здравствуйте, Голиков Алексей Николаевич! Код программы в приложении. Приложение: const N=10; var m: array [a..N] of integer; i,count,sum: integer; begin sum := 0; count := 0; randomize; for i:=1 to n do begin m[i]:=random(20) - 10; if m[i] > 0 and count <= 5 then begin inc(count); sum := sum + m[i]; end; end; if count = 5 then writeln(sum); readln; end. --------- Наши программисты самые программистые программисты!..

Ответ отправил: SHERRY (статус: 5-ый класс) Ответ отправлен: 21.12.2007, 23:56 Оценка за ответ: 5 Комментарий оценки: Спасибо,как раз то, что и нужно было!!!

Отвечает: sergesus Здравствуйте, Голиков Алексей Николаевич! const n=10; var A: array [1..n] of double; {Наш массив } S: double; {Куда записывается сумма} j,i,k: integer; begin repeat begin S:=0; {начальное значение суммы (S- сумма елементов >0)} k:=0; {k-счедчик элесентов} for i := 1 to n do if A[i]>0 then begin S:=S+A[i]; k:=k+1 end; end; until k=5; end. Приложение: const n=10; var A: array [1..n] of double; {Наш массив } S: double; {Куда записывается сумма} j,i,k: integer; begin repeat begin S:=0; {начальное значение суммы (S- сумма елементов >0)} k:=0; {k-счедчик элесентов} for i := 1 to n do if A[i]>0 then begin S:=S+A[i]; k:=k+1 end; end; until k=5; end.

Ответ отправил: sergesus (статус: 2-ой класс) Ответ отправлен: 22.12.2007, 00:38 Оценка за ответ: 5 Комментарий оценки: Спасибо, я воспользуюсь!!!

Отвечает: Alexey Ku Здравствуйте, Голиков Алексей Николаевич! Насколько я понял Ваш вопрос: var i, { цикловая переменная } n, { счетчик положительных } Sum: integer; { сумма } { массив M будем считать заданным } ... Sum:=0; n:=0; for i:=1 to 10 do begin if M[i]>0 then begin Inc(Sum, M[i]); Inc(n); if n=5 then Break; { если пять чисел найдены - выходим из цикла } end; { if } end; { for }

Ответ отправил: Alexey Ku (статус: 1-ый класс) Ответ отправлен: 22.12.2007, 02:39 Оценка за ответ: 5 Комментарий оценки: Спасибо, можно воспользоваться!

Вопрос № 115.370

Уважаемые эксперты помогите пожалуйста сделать 3 задания.Если же у Вас совсем нет свободного времени то хотя бы подскажите как их сделать .А то что-то ничего не получается.В особенности первая. Вот задания: 1. Задав конкретную функцию F(x), построить на символьном экране дисплея ее график и графически найти все возможные решения, не применяя никаких численных методов. F(x) = x + cos (2+х в степени 0,52). На интервале [0.5,1] ответ: x=0.9892. 2. Задав с клавиатуры последовательность символов, реализовать обработку ее, как указано в варианте. Исходные данные задать самостоятельно, учитывая специфику конкретного варианта. Дана последовательность, содержащая от 2 до 50 слов, в каждом из которых от 1 до 8 строчных латинских букв; между соседними словами - не менее одного пробела, за последним словом - точка. Напечатать те слова последовательности, которые отличны от последнего слова и удовлетворяют следующему свойству: вторая буква слова входит в него еще раз. 3. Взяв за основу задание 2, реализовать ввод из текстового файла и обработку символьных последовательностей, состоящих из любых символов. В программе должны быть предусмотрены соответствующие процедуры и функции, корректно обрабатывающие входные данные, согласно заданию 2. Результат должен запоминаться тоже в текстовом файле и в понятном для интерпретации виде.

Отправлен: 22.12.2007, 13:44 Вопрос задала: Балицкая А.П. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Alexey Ku Здравствуйте, Балицкая А.П.! Для 1-й пользуйте Crt unit и функции GotoXY(X, Y), ClrScr, Write. Ваш инткрвал адресации при режиме дисплея 80x25 - 80x24 либо используйте вместо CRT блок в приложении, я его Вам дарю. :-) Чертите текстом оси посередине и стройте график относительно центральных координат (40, 12). Для функции нужно расчитать коэффициент масштабирования координат. PS: Очень похоже на олимпиадные задания для 10-го класса, где Вы их взяли? Приложение: { Необходимые процедуры для работы с текстовым экраном } { ------------------------------------------------------ } { * HomeSoft * Unit HsCommon V0.01 (C) Copyright '92 } { ------------------------------------------------------ } { Written by Alexei Kurbatow. t.Vologda } Unit HsCommon; Interface Type VideoBufferType = array[0..$7FF7] of word; VideoBufferPtrType = ^VideoBufferType; Const CheckSnow : boolean = false; { -- for cursor size -- } BlockCursor = $000C; HiddenCursor = $2000; NormalCursor = $0607; SaveCursor : word = 0; { Сохраненный старый размер курсора } RussianLo : string = 'абвгдежзийклмнопрстуфхцчшщъыьэюя'; RussianHi : string = 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭБЯ'; Var ActiveVideoPage : byte absolute $40:$62; VideoSegment : VideoBufferPtrType; TextAttr : byte; procedure InitCommon; { Инициализация блока Common } procedure FastWrite(S:string; Row,Col,Attr:byte); { Высвечивает строку S на терминале в позиции Row,Col и аттрибутом Attr } function VideoOffset(Row, Col:byte):word; { вычисляет сдвиг (в словах) } procedure WaitForRetrace; { ожидает обновления экрана } procedure GetVideoSegment(P : VideoBufferPtrType); { получение адреса текущего реген буфера } function GetCursorSize : word; { Получение размера курсора } procedure SetCursorSize(Size : word); { Установка размера курсора } function WhereY : byte; { Выдает текущую Y-координату курсора } function WhereX : byte; { Выдает текущую X-координату курсора } function WhereXY : word; { Выдает текущую позицию курсора } procedure GotoXY(X, Y : word); { Установить курсор на позицию X, Y } function UpCase(Ch : Char) : char; { Преобразование из строчной в прописную } Procedure ClrScr; { Очистка экрана } function NumToStr(N : longint; Count: integer) : string; { Преобразование числа в строку } implementation function VideoOffset(Row, Col:byte):word; assembler; { вычисляет сдвиг (в словах) } asm dec Row dec Col mov AL, 80 mul Row xor DX, DX mov DL, Col add AX, DX end; procedure WaitForRetrace; assembler; { ожидает обновления экрана } asm push DX push AX mov DX, 3DAh ; Видео порт cli WaitNoH: in AL, DX { Взять 6845 статус } test AL,8 { Check for vertical retrace } jnz @Go { In progress? go } shr AL,1 { Wait for end of horizontal } jc @WaitNoH { retrace } WaitH: in AL, DX { Get 6845 status again } shr AL, 1 { Wait for horizontal } jnc @WaitH { retrace } Go: sti pop AX pop DX end; procedure FastWrite(S:string; Row,Col,Attr:byte); assembler; { Высвечивает строку S на терминале в позиции Row,Col и аттрибутом Attr } asm ; подсчитаем сдвиг xor AX, AX mov AL, Row push AX mov AL, Col push AX Call VideoOffset mov DI, AX add DI, WORD PTR DS:[VideoSegment+0] ; сложим с началом буфера shl DI, 1 mov ES, WORD PTR DS:[VideoSegment+2] mov AH, Attr mov BL, DS:CheckSnow cld push DS lds SI, S lodsb xor CX, CX mov CL, AL ; длина строки jcxz @Exit cmp BL, 0 jne @CheckLoop NoCheckLoop : lodsb stosw loop @NoCheckLoop jmp @Exit CheckLoop : lodsb call WaitForRetrace stosw loop @CheckLoop Exit : pop DS end; { FastWrite } procedure SetCursorSize(Size : word); assembler; { Установка размера курсора } asm mov AH, 01 mov CX, SS:Size int 10h end; { Hidden Cursor } function GetCursorSize : word; assembler; { Получение размера курсора } asm mov AX, 40h mov ES, AX mov AH, 03 mov BH, ES:ActiveVideoPage int 10h mov AX, CX end; { GetCursorSize } function WhereX : byte; assembler; { Выдает текущую X-координату курсора } asm mov AX, 40h mov ES, AX xor BX, BX mov BL, ES:ActiveVideoPage shl BX, 1 xor AX, AX mov AL, BYTE PTR ES:[BX+50h] inc AL end; { WhereX } function WhereY : byte; assembler; { Выдает текущую Y-координату курсора } asm mov AX, 40h mov ES, AX xor BX, BX mov BL, ES:ActiveVideoPage shl BX, 1 xor AX, AX mov AL, BYTE PTR ES:[BX+51h] inc AL end; { WhereY } function WhereXY : word; assembler; { Выдает текущую позицию курсора } asm mov AX, 40h mov ES, AX xor BX, BX mov BL, ES:ActiveVideoPage shl BX, 1 mov AX, WORD PTR ES:[BX+50h] inc AL inc AH end; { WhereXY } procedure GotoXY(X, Y : word); assembler; { Установить курсор на позицию X, Y } asm mov AX, 40h mov ES, AX xor BX, BX mov BL, ES:ActiveVideoPage shl BX, 1 mov CX, X mov AL, CL mov CX, Y mov AH, CL dec AH dec AL mov WORD PTR ES:[BX+50h], AX {--} mov DX, AX mov AL, DH mul BYTE PTR ES:[4Ah] xor DH, DH add AX, DX mov CX, AX mov DX, ES:[63h] mov AL, 0Eh out DX, AL jmp @1 1 : mov AL, CH inc DX out DX, AL jmp @2 2 : dec DX mov AL, 0Fh out DX, AL jmp @3 3 : mov AL, CL inc DX out DX, AL (* standart mov AX, 40h mov ES, AX xor BX, BX mov BL, ES:ActiveVideoPage mov DH, BYTE PTR SS:[Y] mov DL, BYTE PTR SS:[X] mov AH, 02h int 10h *) end; { GotoXY } procedure GetVideoSegment(P : VideoBufferPtrType); assembler; { получение адреса текущего реген буфера } asm mov AX, 40h mov ES, AX mov DI, 4Eh mov AX, WORD PTR ES:[DI] mov CL, 4 shr AX, CL add AX, 0B800h lea DI, VideoSegment mov WORD PTR DS:[VideoSegment+0], 0 mov WORD PTR DS:[VideoSegment+2], AX end; procedure InitCommon; { Инициализация блока Common } begin GetVideoSegment(VideoSegment); SaveCursor:=GetCursorSize; asm mov AX, 40h mov ES, AX mov BH, ES:ActiveVideoPage mov AH, 08h push BP int 10h mov DS:TextAttr, AH pop BP end; end; function UpCase(Ch : Char) : char; { Преобразование из строчной в прописную } begin if Pos(Ch, RussianLo)>0 then UpCase:=RussianHi[Pos(Ch, RussianLo)] else UpCase:=System.UpCase(Ch); end; { UpCase } Procedure ClrScr; assembler; { Очистка экрана } asm mov DI, WORD PTR DS:[VideoSegment+0] ; сложим с началом буфера shl DI, 1 mov ES, WORD PTR DS:[VideoSegment+2] mov AX, 20h { ' ' } cld mov CX, 2000 { размер экрана для 80x25) } loop: stosb inc DI loop @loop end; { ClrScr } function NumToStr(N : longint; Count: integer) : string; { Преобразование числа в строку } var S: string; begin Str(N: Count, S); NumToStr:=S; end; { NumToStr } begin InitCommon; end.

Ответ отправил: Alexey Ku (статус: 1-ый класс) Ответ отправлен: 22.12.2007, 16:44

Вопрос № 115.430

Уважаемые эксперты, уверен вы легко сможете помочь в написании следующей програмы: Необходимо написать программу сложения и умножения двух комплексных чисел. Заранее благодарен.

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

Отвечает: Артём1983 Здравствуйте, Silencio! Сложение двух комплексных чисел: (a+bi)+(c+di)=(a+c)+(b+d)i Умножение двух комплексных чисел: (a+bi)(c+di)=(ac-bd)+(ac+bc)i Код программы смотрите в приложении. Приложение: {115430} uses crt; var a,b,c,d:real; ch:char; begin clrscr; writeln('-введите первое комплексное число-'); write('a = '); readln(a); write('b = '); readln(b); writeln('-введите второе комплексное число-'); write('c = '); readln(c); write('d = '); readln(d); write('введите "+" для сложения двух чисел и "*" для умножения двух чисел = '); readln(ch); case ch of '+': begin write('(',a:0:2,' + ',b:0:2,'i',')+(',c:0:2,' + ',d:0:2,'i',')= ',a+c:0:2,' + ',b+d:0:2,'i'); end; '*': begin write('(',a:0:2,' + ',b:0:2,'i',')*(',c:0:2,' + ',d:0:2,'i',')= ',(a*c-b*d):0:2,' + ',(a*d+b*c):0:2,'i'); end; end; readln; end. --------- Программирование - дело Путное!

Ответ отправил: Артём1983 (статус: 7-ой класс) Ответ отправлен: 22.12.2007, 22:06 Оценка за ответ: 5

Вопрос № 115.435

Здравствуйте, уважаемые эксперты! Вновь обращаюсь к Вам! Помогите, пожалуйста, разобраться с задачами в PASCALе.. Наверно Вам они покажутся легкими, а у меня их ну никак не получается(((( Задача 1 Составить программу преобразования натуральных чисел, записаннных в римской нумерации, в десятичную систему счисления. Задача 2 Дана строка. Преобразовать ее, удалив каждый символ * и повторив каждый символ, отличный от *. Заранее спасибо...

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

Отвечает: Gh0stik Здравствуйте, ksana09! Вот программа, которая переводит число из римской системы в десятичную. function RomanToArabic(s: string): integer; var i, p: integer; begin   result:=0;   i:=13;  p:=1;   while p <= Length(S) do     begin       while copy(s, p, length(R[i])) <> R[i] do       begin         dec(i);         if i=0 then exit;       end;       result := result + A[i];       p := p + length(R[i]);   end; end; var rm:string; begin   write('Roman=');readln(rm);   write('Arabic=',RomanToArabic(rm));   readln; end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 22.12.2007, 22:21 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо за ответ!!!

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