Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Micren Статус: Студент Рейтинг: 158 ∙ повысить рейтинг >>

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 80 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 79 ∙ повысить рейтинг >>

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

Выпуск № 796
от 30.01.2009, 19:05

Вопрос № 158644: Здрасвуйте, помогите решить : Подпрограммы. Составить программу на Паскале. Дан одномерный массив, выполнить следующие действия: - найти первый максимальный элемент массива и заменить его нулем. - заменить нулями те числа, величина котор...

Вопрос № 158.644

Здрасвуйте, помогите решить : Подпрограммы. Составить программу на Паскале. Дан одномерный массив, выполнить следующие действия: - найти первый максимальный элемент массива и заменить его нулем. - заменить нулями те числа, величина которых по модулю больше максимального числа; - найти max(a2, a4, …a2k)+min(a1, a3,…a2k-1); - найти среди элементов массива те, которые являются квадратами некоторого числа m;

Отправлен: 24.01.2009, 18:36 Вопрос задал: Давыдов Артём Аркадьевич (статус: 1-й класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 10)

Отвечает: Micren Здравствуйте, Давыдов Артём Аркадьевич! Вот программа с краткими комментариями. Приложение: program Pascal_158644; type intptr=^integer; var N,i,max,min,m,cnt:integer; arr,arrPtr:intptr; { Вывод массива } procedure PrintArray(msg:string); var arrPtr:intptr; begin WriteLn(msg); arrPtr:=arr; for i := 1 to N do begin Write(arrPtr^:4,' '); Inc(arrPtr); end; WriteLn; end; begin Randomize; { Ввод количества элементов в массиве } Write('The number of elements:'); ReadLn(N); if N<2 then WriteLn('Value should be at least 2') else begin { Выделение памяти под массив и заполнение его случайными значениями } GetMem(arr,N*sizeof(integer)); arrPtr:=arr; for i := 1 to N do begin arrPtr^:=Random(51)-25; Inc(arrPtr); end; PrintArray('Source Array:'); { Ищем максимальный элемент } arrPtr:=arr; max:=arrPtr^; for i := 1 to N do begin if max<arrPtr^ then max:=arrPtr^; Inc(arrPtr); end; WriteLn('Max=',max); { Меняем 1й максимальный на ноль } arrPtr:=arr; for i := 1 to N do begin if max=arrPtr^ then begin arrPtr^:=0; break; end; Inc(arrPtr); end; PrintArray('After changing the maximum zero:'); { Заменить нулями те числа, величина которых по модулю больше максимального числа } arrPtr:=arr; for i := 1 to N do begin if abs(max)<abs(arrPtr^) then arrPtr^:=0; Inc(arrPtr); end; PrintArray('After replacing large(abs) maximum:'); { найти max(a2, a4, …a2k)+min(a1, a3,…a2k-1) } arrPtr:=arr; min:=arrPtr^; Inc(arrPtr); max:=arrPtr^; Inc(arrPtr); for i := 3 to N do begin if Odd(i) and (min>arrPtr^) then min:=arrPtr^ else if not Odd(i) and (max<arrPtr^) then max:=arrPtr^; Inc(arrPtr); end; WriteLn('max(a2,a4,...,a2k)+min(a1,a3,...,a2k-1)=',min+max); { Ввод числа m } Write('Enter m='); ReadLn(m); { Найти среди элементов массива те, которые являются квадратами некоторого числа m } arrPtr:=arr; cnt:=0; for i := 1 to N do begin if m*m=arrPtr^ then begin WriteLn(m,'^2=Array[',i,']'); Inc(cnt); end; Inc(arrPtr); end; if cnt=0 then WriteLn('Not Found') else WriteLn('Found ',cnt,' items'); { Освобождаем память } FreeMem(arr,N*sizeof(integer)); end; ReadLn; end.

Ответ отправил: Micren (статус: Студент) Ответ отправлен: 24.01.2009, 19:41 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242039 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 2

Отвечает: Alex2008pro Здравствуйте, Давыдов Артём Аркадьевич! program pas; const Nmax=100; var a:array[1..Nmax]Of integer; i,l,n,max,max1,min1,j:integer; begin repeat writeln('введите кол-во элементов <= ',Nmax); readln(n); until (n>0)and(n<=Nmax); writeln('введи данные'); for i:=1 to n do readln(a[i]); min1:=a[1]; max1:=a[2]; for i:=1 to n do begin if i div 2=1 then if a[i]<min1 then min1:=a[i] else if a[i]>max1 then max1:=a[i]; end; writeln('kv'); for i:=1 to n do if Sqrt(a[i])=int(Sqrt(a[i])) then writeln(a[i]); max:=a[i]; l:=1; for i:=1 to n do if a[i]>max then begin max:=a[i]; l:=i; end; writeln('max = ',max,', номер = ',l); a[l]:=0; for i:=1 to n do if abs(a[i])>max then a[i]:=0; writeln('min=',min1); writeln('max=',max1); for i:=1 to n do writeln(a[i]); end.

Ответ отправил: Alex2008pro (статус: 1-й класс) Ответ отправлен: 24.01.2009, 19:59 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242040 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: Пупорев Юрий Борисович Здравствуйте, Давыдов Артём Аркадьевич! Решение Вашей задачи с использованием подпрограмм и привычных видимо Вам статистических массивов, короче по рабоче-крестьянски. Приложение: uses crt; const nmax=100; {максимальный размер массива} type Tmas=array[1..nmax] of integer; {тип массива для передачи параметра в подпрограммы и обратно} procedure Vvod(x:byte; var ms:Tmas);{процедура ввода исходного массива} var i:byte; begin writeln('Vvedite ',x,' elementov massiva:'); for i:=1 to x do read(ms[i]); {вводим через пробел элементы массива, целые числа, желательно ввести положительные и отрицательные, причем несколько отрицательных по модулю должны быть больше максимального положительного, а также нескольео чисел-квадратов некоего числа, расположенные в разных местах} readln; end; procedure Vyvod(x:byte;var ms:Tmas);{процедура вывода массива на экран после создания и преобразований} var i:byte; begin for i:=1 to x do write(ms[i],' '); writeln; end; procedure ZamMax(x:byte;var ms:Tmas;var max:integer);{процедура замены максимального} var i,imax:byte; begin max:=ms[1];imax:=0; for i:=1 to x do if ms[i]>max then begin max:=ms[i];{максимум} imax:=i; {его номер} end; ms[imax]:=0;{заменяем на ноль} writeln('Max=',max,' ego nomer=',imax); end; procedure ZamMod(x:byte;max:integer; var ms:Tmas);{замена отрицательных, больших по модулю максимального на ноль} var i:byte; begin for i:=1 to x do if abs(ms[i])>max then ms[i]:=0; end; function SumMaxMin(x:byte;ms:Tmas):integer;{функция расчета max+min} var i:byte; max,min:integer; begin max:=ms[2];min:=ms[1]; for i:=1 to x do begin if odd(i)and(ms[i]<min) then min:=ms[i];{если индекс нечетный(odd)} if not odd(i) and(ms[i]>max) then max:=ms[i];{если четный(not odd)} end; SumMaxMin:=max+min;{запоминаем результат} end; procedure Sqr(p:integer;x:byte;ms:Tmas);{процедура поиска квадрата заданного числа} var i,t:byte; begin t:=0; for i:=1 to x do if ms[i]=p*p then {если число равно квадрату} begin t:=1; {фиксируем этот факт} writeln('# ',i,'=',ms[i]);{выводим его номер и значение} end; if t=0 then writeln('Kvadrata chisla ',p,' net!');{если ни одного} end; var a:Tmas; {раздел переменных программы} n,k:byte; m,mx:integer; begin {начало программы} clrscr; write('Kolichestvo elementov n='); readln(n); Vvod(n,a); clrscr; writeln('Ishodnyj massiv A:'); Vyvod(n,a); ZamMax(n,a,mx); writeln('Massiv s zamenoj max. elementa:'); Vyvod(n,a); ZamMod(n,mx,a); writeln('Massiv s zamenoj modulej:'); Vyvod(n,a); writeln('Summa max+min=',SumMaxMin(n,a)); write('Vvedite chislo m='); readln(m); writeln('Kvadraty chisla ',m,':'); Sqr(m,n,a); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 24.01.2009, 21:09 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242046 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Отвечает: Motoden Здравствуйте, Давыдов Артём Аркадьевич! Не очень понятно что такое "первый максимальный элемент массива", но программа находящая максимальный элемент в массиве и выполняющая все пункты в вашем задании есть в приложении. Приложение: program massiv; const max_predel=100; var a:array[1..max_predel] of integer; max,n,i,m:integer; function rezultat:integer; var i:integer; begin writeln; writeln('Rezultat:'); for i:=1 to n do begin writeln('a[',i,']=',a[i]); end; end; function maximum_zamena:integer; var j,i:integer; begin max:=a[1]; j:=1; for i:=1 to n do begin if max<a[i] then begin max:=a[i]; j:=i; end; end; a[j]:=0; end; function zamena_modul:integer; var i:integer; begin for i:=1 to n do begin if abs(a[i])>max then a[i]:=0; end; end; function viborka:integer; var i,j,max,min:integer; begin min:=a[1]; max:=a[2]; for i:=1 to n do begin if (i mod 2)=0 then begin if max<a[i] then max:=a[i]; end else begin if min>a[i] then min:=a[i]; end; end; viborka:=max+min; end; function kvadrat_m:integer; var i:integer; c:boolean; begin c:=false; writeln('nomera elemontov kotorie ravni m^2:'); for i:=1 to n do if sqr(m)=a[i] then begin c:=true; writeln(i); end; if c=false then writeln('elementov ravnix m^2 NET!'); end; begin writeln('Vvedite razmernost massiva:'); write('n='); readln(n); for i:=1 to n do begin writeln('Vvedite elementi massiva:'); write('a[',i,']='); readln(a[i]); end; maximum_zamena; rezultat; readln; zamena_modul; rezultat; readln; writeln('max(2,4...) + min(1,3...) = ',viborka); readln; writeln('Vvedite chislo m:'); write('m='); readln(m); kvadrat_m; readln; end. --------- не забудьте поставить оценку!:)

Ответ отправил: Motoden (статус: 3-й класс) Ответ отправлен: 25.01.2009, 01:34 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242063 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 158.655

Метод монте карло.вычисление двухкратного интеграла

Отправлен: 24.01.2009, 21:38 Вопрос задал: Astroboy (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Boriss Здравствуйте, Astroboy! В приложении пример простейшей программы, решающей Вашу задачу Если что не понятно будет - спрашивайте Приложение: TYPE TFunc = function (u, v: Real): Integer; TLim = record minx, maxx, miny, maxy: Real; end; function MyFunc(x, y: Real): Integer; far; {far - обязательно} {Определяет внутри фигуры или нет} const R2 = 25; {квадрат радиуса} x_center = 10; y_center = 10; {Центр круг} begin {определим круг} if (x - x_center)*(x - x_center) + (y - y_center)*(y - y_center) < R2 then MyFunc := 1 else MyFunc := 0 end; function Integr(func: TFunc; x_min, x_max, y_min, y_max: Real; max_count: LongInt): Real; var x, y: Real; dx, dy: Double; {диапазон изменения x и y. Double - если будут заданы максимально допустимые для Real значения, то не уместятся} count, i: Longint; begin count := 0; dx:= (x_max - x_min); dy:= (y_max - y_min); for i:= 1 to max_count do begin x := x_min + dx*random; y := y_min + dy*random; Count := count + func(x, y) end; Integr := Count/max_count*dx*dy; end; BEGIN WriteLn(#13#10,pi*5*5:10:5); {Точное значение} WriteLn(Integr(MyFunc, 4.9, 15.1, 4.9, 15.1, 10000):10:5); END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 25.01.2009, 12:49 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242080 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: Micren Здравствуйте, Astroboy! Простая программа, которая вычисляет интеграл той кратности, которая Вам нужна. Код: program Pascal_158655; {$R+} { Предел } type TLim=record a,b:double; end; const MaxLim=65536 div sizeof(TLim)-1; type TLimArr=array[1..MaxLim]of TLim; Tx=array[1..MaxLim]of double; var iNum,i,j,pNum:LongInt; limarr:^TLimArr; x:^Tx; p,sum:double; { Функция f(x1,x2,...,xn), где x1-x[1],x2-x[2],...,xn-x[n], возвращает 1, если попали в область и 0 если не попали} function f(var x:Tx):double; begin { Шар единичного радиуса как пример } if x[1]*x[1]+x[2]*x[2]+x[3]*x[3]<=1 then f:=1 else f:=0; end; { Возвращает случайное число в интервале a..b } fu nction GetX(a,b:double):double; begin GetX:=a+(b-a)*Random; end; begin Randomize; { Ввод кратности интеграла } Write('Integral multiples:'); ReadLn(iNum); { Выделяем память } GetMem(limarr,sizeof(TLim)*iNum); GetMem(x,sizeof(double)*iNum); p:=1; for i := 1 to iNum do begin Write('A',i,'=');ReadLn(limarr^[i].a); Write('B',i,'=');ReadLn(limarr^[i].b); p:=p*(limarr^[i].b-limarr^[i].a); end; Write('Points:');ReadLn(pNum); p:=p/pNum; sum:=0; for i := 1 to pNum do begin for j := 1 to iNum do x^[j]:=GetX(limarr^[j].a,limarr^[j].b); sum:=sum+f(x^)*p; end; WriteLn('I=',sum:8:4); FreeMem(x,sizeof(double)*iNum); FreeMem(limarr,sizeof(TLim)*iNum); ReadLn; end. Пример вывода программы: Код: Integral multiples:3 A1=-1 B1=1 A2=-1 B2=1 A3=-1 B3=1 Points:1000000 I= 4.1908

Ответ отправил: Micren (статус: Студент) Ответ отправлен: 25.01.2009, 14:04 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242090 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 158.686

подскажите пожалуйста как решить эту задачу: Дано четное число N(>0) и символы С1 и С2. Вывести строку длины , которая состоит из N чередующихся символов С1 и С2, начиная с С1. И Через Модуль.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Otherside! Поскольку в задании упоминается строка, а работаем мы в Паскале, я сделал программу именно для строки, т.е. массива символов длиной не более 255 элементов. Хотя можно легко переделать эту программу на массив символов-array[1..n]of char, длиной значительно больше. Текст модуля и программы с пояснениями, в приложении. Приложение: Текст модуля. Unit Modul; interface function Stroka(x:byte;a,b:char):string;{в этом разделе помещаем заголовок функции} implementation function Stroka(x:byte;a,b:char):string;{в этом разделе ее описание} var i:byte; s:string; begin s:='';{сначала строка пустая} for i:=1 to x do begin if odd(i) then s[i]:=a{если номер нечетный} else s[i]:=b;{если четный} s:=s+s[i];{составляем строку} end; Stroka:=s;{запоминаем значение} end; end. Про структуру модуля, его сохранение и использование прочитайте в учебнике, лень переписывать. Текст программы. uses Crt,Modul;{подключаем модуль} var st:string; c1,c2:char; n,i:word; begin clrscr; repeat {в цикле вводим размер строки с проверкой правильности ввода} write('Vvedite chetnoe chislo n='); readln(n); until (n>0)and(n mod 2=0)and(n<255); Write('c1=');readln(c1);{вводим символы} write('c2=');readln(c2); write(Stroka(n,c1,c2));{вызываем функцию из нашего модулл} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 25.01.2009, 13:57 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242088 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Отвечает: Motoden Здравствуйте, Otherside! Ваша программа и модуль в приложении. Приложение: Собственно программа: program m; uses unit_m; var N:integer; C1,C2:char; begin N:=1; while (N mod 2)<>0 do begin writeln('Vvedite chetnoe chislo :'); write('N='); readln(N); if (N mod 2)<>0 then writeln('N - NEchetnoe') end; writeln('Vvedite simvoli:'); write('C1='); readln(C1); write('C2='); readln(C2); writeln('stroka:'); vivod(N,C1,C2); readln; end. --------------------------------------- Модуль к программе: unit unit_m; interface function vivod(A:integer;B,C:char):string; implementation function vivod(A:integer;B,C:char):string; var i:integer; d:string; begin d:=''; for i:=1 to A do begin d:=d+B+C; end; writeln(d); end; end. --------- не забудьте поставить оценку!:)

Ответ отправил: Motoden (статус: 3-й класс) Ответ отправлен: 25.01.2009, 17:18 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242101 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 158.687

народ!!! люди добрые!!! помогите!!! нужно решить 4 задачи я над ними уже 3 дня сижу... ничего не могу... а задачи такие: 1) дана матрица порядка n и число к. разделить элементы к-ой строки на диагональный элемент этой строки. 2) заполнить матрицу линейной последовательности от левого нижнего угла по диагонали : влево вверх.пример заполнения: 10 13 15 16 6 9 12 14 3 5 8 11 1 2 4 7 3) дан текст напечатать в алфавитном порядке все согласные буквы которые не входят ни в одно слово. 4) создать файл содержащий текст на английском языке и некоторые два слова. определить, сколько раз они встречаются в тексте и сколько из них непосредственно друг за другом

Отправлен: 25.01.2009, 11:56 Вопрос задал: Edise (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Edise! Задача №1 с небольшими пояснениями в приложении. Приложение: uses crt; const n=6; {размер матрицы} var a:array[1..n,1..n]of real;{тип матрицы} i,j,k:byte; begin clrscr; randomize; writeln('Ishodnaya matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=10*random; write(a[i,j]:5:1); end; writeln; end; repeat {вводим номер строки с проверкой интервала} write('k='); readln(k); until (k>0)and(k<=n); for j:=1 to n do a[k,j]:=a[k,j]/a[k,k];{делим элементы строки на элемент главной диагонали} writeln('Rezultat:'); for i:=1 to n do begin for j:=1 to n do write(a[i,j]:5:1); writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 25.01.2009, 15:28 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242094 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: спасибо огромное))) не ожидал что кто-нить поможет)

Отвечает: Шевченко Дмитрий Здравствуйте, Edise! Решение задач 1-3 в приложении. Приложение: program z158687; {$I-} const n = 7; type elem1 = Real;{тип элементов в массиве} elem2 = Word; tmas1 = array[1..n,1..n] of elem1;{массив дробных чисел (для задачи 1)} tmas2 = array[1..n,1..n] of elem2;{массив целых чисел (для задачи 2)} {Задача №1} procedure fill1(var mas:tmas1); var i,k:byte; begin Randomize; For i := 1 to n do For k := 1 to n do mas[i,k]:=Random(100)+1;{заполняем числами от 1 до 100} end; procedure z1(var mas:tmas1; k:byte); var i:byte; begin For i := 1 to n do mas[k,i] := mas[k,i]/mas[k,k];{Если надо поделить на элемент главной диагонали} { mas[k,i] := mas[k,i]/mas[k,n-k+1];{Если надо поделить на элемент побочной диагонали}} end; procedure vivod1(mas:tmas1); var i,k:byte; begin For i := 1 to n do begin For k := 1 to n do Write(mas[i,k]:6:2,' ');{выводим массив} WriteLn; end; end; {Задача №2} procedure fill2(var mas:tmas2); var i,k:byte; j:word; begin j:=1; {заполняем часть массива, находящуюся ниже главной диагонали (и главную диагональ)} For k := 1 to n do For i := 1 to k do begin mas[n-i+1,k-i+1]:=j; inc(j); end; {выше главной диагонали} For i := n-1 downto 1 do{перебираем строки от n-1 до первой} For k := n downto n-i+1 do{перебираем столбцы от последнего до n - №строки} begin mas[i-(n-k),k]:=j; inc(j); end; end; procedure vivod2(mas:tmas2); var i,k:byte; begin For i := 1 to n do begin For k := 1 to n do Write(mas[i,k]:3,' ');{выводим массив} WriteLn; end; end; {Задаяа №3} Function z3(var f:Text):String; const Sogl1:String = 'bcdfghjklmnprstvwxz';{список согласных букв в алфавитном порядке} Sogl2:String = 'BCDFGHJKLMNPRSTVWXZ'; var symb:char; begin While (not EOF(f))and(length(Sogl1)>0) do{перебираем файл} begin Read(f,symb); IF pos(symb,Sogl1)>0 then{если нашли строчную согласную - удаляем её из списка} begin delete(Sogl2,pos(symb,Sogl1),1); delete(Sogl1,pos(symb,Sogl1),1); end Else IF pos(symb,Sogl2)>0 then{если нашли заглавную согласную - удаляем её из списка} begin delete(Sogl1,pos(symb,Sogl2),1); delete(Sogl2,pos(symb,Sogl2),1); end; end; z3:=Sogl1; end; {основная часть} var mas1:tmas1;mas2:tmas2; k:byte; FileName:String; f:Text; begin {задача №1} WriteLn('task 1:'); fill1(mas1); vivod1(mas1); Write('Enter k from 1 to ',n,': '); ReadLn(k); z1(mas1,k);{заполняем массив как надо} vivod1(mas1);{выводим массив} {задача №2} WriteLn('task 2:'); fill2(mas2);{заполняем массив} vivod2(mas2);{выводим массив} {Задача №3} WriteLn('task 3:'); Write('Enter name of file: '); ReadLn(FileName); Assign(f,FileName); Reset(f); IF IOResult = 0 then begin WriteLn(z3(f)); Close(f); end Else WriteLn('File not found: ',FileName); ReadLn; end.

Ответ отправил: Шевченко Дмитрий (статус: 10-й класс) Ответ отправлен: 25.01.2009, 15:57 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242096 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: спасибо большое)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Edise! Четвертая задача в приложении. Строка результата выглядит так: 'One:' , indexOne, - счетчик певого слова; ' Two:' , indexTwo, - счетчик второго слова; ' One after Two:' , indexOneTwo, - счетчик количества комбинаций, когда первое слово следует за вторым; ' Two after One:' , indexTwoOne - счетчик количества комбинаций, когда второе слово следует за первым. Оператор case c of{проверяем разделители и регистр букв} '.',',',':','-','!','"','/','*','+','=','%':c:=' '; 'A'..'Z':c:=chr(ord(c)+32); end; выполняет две функции: - приводит все слова к одному регистру т.е. к примеру: The = the; - все знаки препинания преобразовывает в пробел - единственный стандартный разделитель для всех слов, в этой строке Вы можете добавить свои знаки или убрать лишние. Вопросы по программе задавайте в мини-форум. Удачи! Приложение: var c:char; one,two,last_word,next_word:string; indexOne,indexTwo,indexOneTwo,indexTwoOne:integer; isFile:text; begin {счутчики слов} indexOne:=0; indexTwo:=0; indexOneTwo:=0; indexTwoOne:=0; {вводим первое слово} repeat write('Enter first word:'); readln(one); until length(one)>0; {вводим второе слово} repeat write('Enter second word:'); readln(two); until length(two)>0; writeln(':',one,':',two,':'); {октрываем файл} assign(isFile,'help.txt'); reset(isFile); next_word:=''; while not eof(isFile)do begin {запоминаем предыдущее слово} last_word:=next_word; next_word:=''; {считываем слово} repeat{цикл считывания одного слова} repeat{цикл игнорирования разделителей стоящий перед словом} read(isFile,c); case c of{проверяем разделители и регистр букв} '.',',',':','-','!','"','/','*','+','=','%':c:=' '; 'A'..'Z':c:=chr(ord(c)+32); end; until (c<>' ')or(length(Next_word)>0)or(eof(isFile)); if c<>' 'then next_word:=next_word + c;{если не пробел, то добавляем символ в слово} until (c=' ')or(eof(isFile)); {контролируем нужные параметры} inc(indexOne,ord(one=next_word)); inc(indexTwo,ord(two=next_word)); inc(indexOneTwo,ord((one=last_word)and(two=next_word))); inc(indexTwoOne,ord((two=last_word)and(one=next_word))); end; {выводим результат работы} write('One:',indexOne,' Two:',indexTwo,' One after Two:',indexOneTwo,' Two after One:',indexTwoOne); close(isFile); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 26.01.2009, 17:06 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242213 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 158.704

Добрый день уважаемые эксперты! Подскажите пожлауйста: есть функция возведения основания в нужную степень, но когда передаю в качестве аргумента показателя степени например 3 - функция считает в квадрате, все тоже с другими значениями. Помогите пожалуйста, последнее время программирую на С++, в Паскале очень многое забыл function Extent(n : Extended; Index : Integer) : Extended; var Ext : Extended; begin while(I < Index) do begin Inc(I); Ext := (n * n); end; Extent := Ext; end;

Отправлен: 25.01.2009, 14:59 Вопрос задал: Николай // Programmator (статус: Студент) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Motoden Здравствуйте, Николай // Programmator ! Ошибка в алгоритме. Исправленная версия функции в приложении. Приложение: function Extent(n : Extended; Index : Integer) : Extended; var Ext : Extended; begin Ext:=n; while(I < Index) do begin Inc(I); Ext := (Ext * n); end; Extent := Ext; end; --------- не забудьте поставить оценку!:)

Ответ отправил: Motoden (статус: 3-й класс) Ответ отправлен: 25.01.2009, 17:58 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242110 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Спасибо Вам, вроде и опыт не плохой имею, но вчера до такой степени в Delphi напрограммировался, что глядя на код он мне кажется кучей безсмысленных символов :))

Вопрос № 158.726

Здравствуйте, уважаемые эксперты! Задание у меня состоит в следующем: - описать объект в рамках Pascal; - продемонстрировать работу с объектом, созданным динамически и уничтожить; - создать иерархию объектов, имеющую не менее 3ех уровней (постараться использовать виртуальные методы). У меня проблема в следующем: не могу придумать ни объект, ни иерархию. Подскажите, пожалуйста, какой объект можно описать (и какие у него описать методы), и если можно иерархию. Заранее спасибо!

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

Отвечает: Verena Здравствуйте, Draconit! Самый тривиальный пример: первичный объект - список (элемент, ссылки на следующий/предыдущий, создание, удаление), на основе этого объекта, например, объект-стек (реализуем методы добавления и удаления из начала списка), на основе объекта-стека реализуем объект-D-очередь (если не ошибаюсь, так называется список, где добавление и удаление возможно из конца и начала) (добавляем к имеющемуся ещё методы добавления и удаления из конца). Пример понятный и полезный, потому как можно его использовать потом. Удачи! --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Специалист) Ответ отправлен: 25.01.2009, 19:06 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242112 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 4

Отвечает: Зенченко Константин Николаевич Здравствуйте, Draconit! В приложении программа, которая создает иерархию из трёх объектов: oPoint, oLine и oFigure. Можете использовать её как пример. Удачи! Приложение: uses Graph,Crt; type { объект точка } oPoint=object xA,yA,pColor:integer;{наследуется всеми объектами} constructor Init; procedure Show;virtual;{для точки свой метод показатать} procedure Hide;virtual;{для точки свой метод спрятать} procedure Move(a,b:integer);{переместить} procedure Color(a:integer);{изменить цвет} end; { объект линия } oLine=object(oPoint) xB,yB,lAngle,Lsize:integer;{наследуется всеми объектами} constructor Init; procedure Show;virtual;{для линии свой метод показать} procedure Hide;virtual;{для линии свой метод спрятать} procedure Change;virtual;{для линии свой метод считать координаты} (* наследуется procedure Move(x,y:integer);{от объекта точка} procedure Color(a:integer);{от объекта точка} *) procedure Rotate(a:integer);{метод повернуть линию} procedure Size(a:integer);{метод изменить размер} end; { } oFigure=object(oLine) xC,yC:integer; constructor Init; procedure Show;virtual; procedure Hide;virtual; procedure Change;virtual; procedure Draw; (* наследуется procedure Move(x,y:integer);{от объекта точка} procedure Color(a:integer);{от объекта точка} procedure Rotate(a:integer);{от объекта линия} procedure Size(a:integer);{от объекта линия} *) end; { ОБЪЕКТ ТОЧКА } constructor oPoint.Init;{описываем точку, начальные значение} begin xA:=GetMaxX div 2; yA:=GetMaxY div 2; pColor:=15; oPoint.Show; end; procedure oPoint.Color;{меняем цвет точки} begin oPoint.Hide; pColor:=(16+pColor+a) mod 16; oPoint.Show; end; procedure oPoint.Move;{меняем положение точки} begin oPoint.Hide; xA:=xA+a; yA:=yA+b; oPoint.Show; end; procedure oPoint.Show;{показываем точку} begin PutPixel(xA,yA,pColor); end; procedure oPoint.Hide;{прячем точку} begin PutPixel(xA,yA,GetBkColor); end; { ОБХЕКТ ЛИНИЯ } constructor oLine.Init;{описываем линию:начальные значения} begin xA:=GetMaxX div 2; yA:=GetMaxY div 2; lAngle:=0; lSize:=50; pColor:=15; oLine.Show; end; procedure oLine.Rotate;{поворачиваем линию} begin oLine.Hide; lAngle:=(360+lAngle+a)mod 360; oLine.Show; end; procedure oline.Change;{пересчитываем координаты} begin xB:=xA+round(lSize*cos(2*pi*lAngle/360)); yB:=yA+round(lSize*sin(2*pi*lAngle/360)); end; procedure oLine.Show;{показываем линию} begin oLine.Change; SetColor(pColor); Line(xA,yA,xB,yB); end; procedure oLine.Hide;{прячем линию} begin SetColor(GetBkColor); Line(xA,yA,xB,yB); end; procedure oLine.Size;{меняем размер линии} begin oLine.Hide; lSize:=lSize+a; oLine.Show; end; { ОБЪЕКТ ТРЕУГОЛЬНИК } constructor oFigure.Init;{описываем труугольник: начальные значения} begin xA:=GetMaxX div 2; yA:=GetMaxY div 2; lSize:=100; lAngle:=10; pColor:=14; oFigure.Show; end; procedure oFigure.Show;{показываем фигуру} begin oFigure.Change; SetColor(pColor); oFigure.Draw; end; procedure oFigure.Draw;{рисуем фигуру} begin MoveTo(xA,yA); LineTo(xB,yB); LineTo(xC,yC); LineTo(xA,yA); end; procedure oFigure.Hide;{прячем фигуру} begin SetColor(GetBkColor); oFigure.Draw; end; procedure oFigure.Change;{пересчитываем координаты} begin xB:=xA+round(lSize*cos(2*pi*lAngle/360)); yB:=yA+round(lSize*sin(2*pi*lAngle/360)); xC:=xA+round(lSize*cos(2*pi*(lAngle-60)/360)); yC:=yA+round(lSize*sin(2*pi*(lAngle-60)/360)); end; var myTr:^oFigure; y:integer; d:char; begin y:=detect; InitGraph(y,y,''); if GraphResult<>grOk then halt(1); OutTextXY(0,0,'+,-size all; 2,4,6,8-location; 1,3-rotate; 7,9-color; 5-exit.'); d:=' '; New(myTr,Init); repeat myTr^.Hide; case d of '+','-':{меняем размер} myTr^.Size(ord(d='+')-ord(d='-')); '7','9':{меняем цвет} myTr^.Color(ord(d='9')-ord(d='7')); '4','6','8','2':{перемещаем фигуру} myTr^.Move(ord(d='6')-ord(d='4'), ord(d='2')-ord(d='8')); '3','1':{поворачиваем фигуру} myTr^.Rotate(ord(d='3')-ord(d='1')); end; myTr^.Show; d:=ReadKey; until d='5'; Dispose(myTr); end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 26.01.2009, 11:03 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 242159 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

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