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

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

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

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

Шичко Игорь Статус: Практикант Рейтинг: 148 ∙ повысить рейтинг >>

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

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

Выпуск № 760
от 20.12.2008, 07:05

Вопрос № 154269: Пусть a_i = (i-1)/(i+1) + sin (i - 3)³/(i+1) i = 1, 2, ... Дано натуральное n. Среди a₁, ... , a_n найти все положительные числа, среди положительных a₁, ... , a_n выбрать наименьше...

Вопрос № 154.269< /b>

Пусть ai = (i-1)/(i+1) + sin (i - 3)3/(i+1) i = 1, 2, ... Дано натуральное n. Среди a1, ... , an найти все положительные числа, среди положительных a1, ... , an выбрать наименьшее число.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Спросил, потому что в этом ряду всего одно отрицательное число. Решение в приложении. Приложение: uses crt; const n=10; var a:array[1..n] of real; min,max:real; i:integer; begin clrscr; writeln('Massiv:'); for i:=1 to n do begin a[i]:=(i-1)/(i+1)+(sin((i-3)*(i-3)*(i-3)))/(i+1); write(a[i]:6:2); end; writeln; writeln('Polozitelnye chisla:'); min:=100; for i:=1 to n do begin if a[i]>0 then write(a[i]:6:2);{если>0, выводим } if (a[i]<min)and(a[i]>0) then min:=a[i];{минимальный из них} end; writeln; writeln('Min=',min:0:2); readln end.

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

Вопрос № 154.270

Даны натуральное число n, действительные числа x1, ... , x3n. Последовательность чисел x1, ... , x3n определяет на плоскости n квадратов со сторонами, параллельными координатным осям: так, x1, x2 - координаты центра первого квадрата, x3 - длина его стороны; аналогично, числа x4, x5, x6 определяют второй квадрат, x7, x8, x9 - третий и т. д. Имеются ли точки, принадлежащие всем квадратам? Если да, то указать координаты одной из них.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Иванов Виктор Олегович! В приложении программа переделанная под графический режим. И соответственно изменены вводимые параметры. Вводится левый верхний угол квадрата (а не центр) и длина стороны, целый тип данных. Чиловая последовательность упорядочена с помощью определяемого пользователем типа. В самой программе Вам будет интересен только цикл проверки заданной области. Удачи! Приложение: uses graph,crt; const MaxS =4; type TSqr=record x,y,z:integer; end; var a:array[1..MaxS]of TSqr; xMin,xMax,yMin,yMax,i:integer; noSqr:boolean; function Check(b,c,d:integer):boolean; begin Check:=(b<=d)and(d<c);{} end; begin {вводим все координаты} for i:=1 to MaxS do begin repeat{координата Х} write('Enter X',i,':='); readln(a[i].x); until a[i].x>0; repeat{координата У} write('Enter Y',i,':='); readln(a[i].y); until a[i].y>0; repeat{сторона квадрата} write('Enter A',i,':='); readln(a[i].z); until a[i].z>0; end; i:=detect; InitGraph(i,xmax,''); {назначаем общей - область точек первого квадрата} xMin:=a[1].x; xMax:=a[1].x+a[1].z; yMin:=a[1].y; yMax:=a[1].y+a[1].z; noSqr:=true; {в цикле проверяем каждый квадрат} for i:=2 to maxS do begin {это условие проверяет выход запределы общей области} if (xMax<a[i].x)or (xMin>(a[i].x+a[i].z))or (yMax<a[i].y)or (yMin>(a[i].x+a[i].z))then noSqr:=false; {проверяем каждую сторону общей области точек} if Check(xMin,xMax,a[i].x)then xMin:=a[i].x; if Check(xMin,xMax,a[i].x+a[i].z)then xMax:=a[i].x+a[i].z; if Check(yMin,yMax,a[i].y)then yMin:=a[i].y; if Check(yMin,yMax,a[i].y+a[i].z)then yMax:=a[i].y+a[i].z; end; {в цикле рисуем все точки} for i:=1 to maxS do begin SetFillStyle(1,i);{меняем для каждого квадрата цвет отрисовки} Bar(a[i].x,{левый верхний угол квадрата} a[i].y, a[i].x+a[i].z,{правый нижний угол квадрата} a[i].y+a[i].z); readKey; end; {меняем стиль и цвет для вывода результата} SetFillStyle(3,maxS+1); if NoSqr then Bar(xMin,yMin,xMax,yMax){выводим область пересечения} else Bar(GetMaxX-100,GetMaxY-100,GetMaxX,GetMaxY);{рисуем квадрат в в правом нижнем углу} readKey; CloseGraph; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 154.271

Даны действительные числа a, b (a<b), натуральное число n, функция y = f(x), определенная на отрезке [a, b]. Для значений аргумента xi = a + ih (i = 0, 1, ... , n), h = (b - a)/n вычислить значения функции yi = f(xi) (i = 0, 1, ... , n). Вывести xi и yi (i = 0, 1, ... , n) в виде таблицы из двух колонок. В i-ю строку таблицу заносятся соответствующие значения xi и yi Рассмотреть следующую функцию: y = x|x+1|, a = -1, b = 2, n = 30

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение с пояснениями в приложении. Приложение: uses crt; const n=30; var a,b,x,y,h:real; i,k:integer; begin clrscr; a:=-1; b:=2; h:=(b-a)/n; x:=a;k:=0; for i:=0 to n do begin y:=x*abs(x+1);{считаем первое значение} writeln('x=',x:4:1,' y=',y:5:2);{выводим на экран в две колонки} k:=k+1; if k mod 16=0 then readln;{поскольку вся таблица на экран не входит, через 16 значений делаем задержку} x:=x+h;{переходим к следующему значению} end; readln end.

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

Вопрос № 154.272

Даны натуральное число n, действительные числа y1, ... , yn. найти: min(|z1|, ... , |zn|), где zi = yi при |yi| > 1, 2 в противном случае.

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

Отвечает: Кулик Александр Сергеевич Здравствуйте, Иванов Виктор! Решение вашей зыдачи в приложении. Приложение: var y,z:array[1..100] of real; n,i:integer; min:real; begin writeln('vvedite n'); readln(n); for i:=1 to n do y[i]:=random(9)-5.0; for i:=1 to n do write(y[i]:4:1); writeln; for i:= 1 to n do if abs(y[i])>1 then z[i]:=y[i] else z[i]:=2; for i:=1 to n do write(z[i]:4:1); writeln; min:=abs(z[1]); for i:= 1 to n do if abs(z[i])<min then min:=abs(z[i]); writeln('min=',min:3:1); end. --------- нет ничего невозможного!

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

Вопрос № 154.274

Даны натуральное число n, действительные числа a1, ... , an. Найти длину наименьшего отрезка числовой оси, содержащего числа a1, ... , an.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение в приложении. Приложение: uses crt; const n=20; var a:array[1..n] of real; min,max:real; i:integer; begin clrscr; randomize; writeln('Massiv chisel:'); min:=1000; max:=-1000;{берем за макс и мин числа, явно превышающие пределы нашего диапазона} for i:=1 to n do begin a[i]:=20*random-9; {случайные числа из инт -9;10} if a[i]<min then min:=a[i];{находим макс и мин} if a[i]>max then max:=a[i]; write(a[i]:6:2); end; writeln; writeln; write('Min=',min:0:2,' Max=',max:0:2,' Dlina otrezka=',abs(min-max):0:2); {длина отрезка=разности крайних точек по модулю} readln end.

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

Вопрос № 154.275

Даны натуральное число n, символы S1,...,Sn. Известно, что среди данных символов есть хотя бы один, отличный от пробела. Требуется преобразовать последовательность S1,...Sn следующим образом: удалить группы пробелов, которыми начинается и которыми заканчивается последовательность, а также заменить каждую внутреннюю группу пробелов одним пробелом. Если указанных групп нет в данной последовательности, то оставить последовательность без изменений.

Отправлен: 14.12.2008, 09:04 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор! Решение в приложении. Приложение: uses crt; const n=30; var s:string[n]; i,k:integer; begin clrscr; k:=0; repeat {вводим строку и проверяем правильность ввода} writeln('Vvedite posledovatelnost iz 30 simvolov, vkluchaushyu probely:'); readln(s); for i:=1 to length(s) do if s[i]=' ' then k:=k+1; if k=0 then writeln('Probelov net!. Povtorite vvod.'){если нет пробелов} else if k=length(s){если все пробелы} then writeln('Posledovatelnost soderzit tolko Ppobely!. Povtorite vvod.'); until (k>0)and(k<length(s)); i:=1; while s[i]<>' ' do {пока в начале строки пробелы, удаляем их} begin delete(s,1,1); inc(i); end; i:=length(s); while s[i]<>' ' do {то же с конца} begin delete(s,1,1); dec(i); end; while pos('--',s)>0 do {пока в оставшейсе строке есть два пробела сподряд(-- пробелы)} delete(s,pos('--',s),1);{обязательно в кавычках по два пробела} write(s); readln end.

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

Вопрос № 154.292

Даны действительные числа s,t. Получить g(1.2,s)+g(t,s)-g(2*s-1,s*t), a^2 + b^2 где g(a,b)= ----------------------- a^2 +2*a*b+3*b^2 +4 Приложение: выполнить с помощю -Процедуры и функции

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Микола! Решение с пояснениями в приложении. Приложение: uses crt; procedure G(a,b:real; var y:real);{процедура считает по формуле, выдает результат в программу} begin y:=(a*a+b*b)/(a*a+2*a*b+3*b*b+4); end; function Summ(a,b,c:real):real;{функция принимает результаты из процедуры и выдает конечный результат} begin Summ:=a+b-c; end; var s,t,g1,g2,g3,sm:real; begin clrscr; write('s=');readln(s); {исходные данные} write('t=');readln(t); G(1.2,s,g1); {три раза вызываем процедуру} G(t,s,g2); G(2*s-1,t,g3); write('Summa=',Summ(g1,g2,g3):0:5);{выводим результат} readln end.

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

Вопрос № 154.294

Здравствуйте, уважаемые эксперты. Нужно решить задачу с использованием процедур и функций: Создать два одномерных массива А и В различной длины. Рассортировать оба по возрастанию чисел. Затем записать числа обоих массивов в массив С тоже по возрастанию, при этом не используя алгоритма сортировки. Результаты выводить в отдельных окнах и различным цветом. Заранее спасибо. Буду ждать ваших ответов. С уважением, Георгий. P. S. Пожалуйста, в коде программы оставьте свои комментарии с пояснением.

Отправлен: 14.12.2008, 12:33 Вопрос задал: Николаев Георгий Александрович (статус: 3-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Denisss Здравствуйте, Николаев Георгий Александрович! В приложении находится пример решения поставленной задачи. Для сортировки массивов А и В использован алгоритм сортировки методом прочесывания. Исходный код взят из книги Дж. Бакнелла "Фундаментальные алгоритмы и структуры данных в Delphi" (URL >>). Успехов! Приложение: program Q154249; type PInt = ^Integer; { Functions & Procedures } { Случайное заполнение массива } procedure randFill(anArr: PInt; const arrSize: Byte); { Параметры: anArr - указатель на массив arrSize - длина массива } var i: Byte; begin for i:= 1 to arrSize do begin anArr^ := Random(1001) - 500; Inc(anArr); end; end; { Печать содержимого массива } procedure printArr(anArr: PInt; const arrSize: Byte); { Параметры аналогичны процедуре randFill() } var i: Byte; begin for i:= 1 to Pred(arrSize) do begin write(anArr^:4, ', '); Inc(anArr); end; writeln(anArr^:4); end; { Сортировка массива } procedure sort(anArr: PInt; const arrSize: Byte); { Параметры аналогичны двум предыдущим процедурам } var piI, piJ: PInt; i, j: Integer; Temp: Integer; Gap: Byte; Done: Boolean; begin { Начинаем с расстояния, равного количеству элементов массива } Gap:= arrSize; repeat { Предполагаем, что сортировка будет выполнена на этом проходе } Done:= True; { Вычисляем новый gap } { Gap:= Trunc(Gap/1.3); } Gap:= (Integer(Gap)*10) div 13; if (Gap < 1) then Gap:= 1 else if ((Gap = 9) or (Gap = 10)) then Gap:= 11; { Упорядочить два элемента, отстоящих друг от друга на Gap элементов } piI:= anArr; piJ:= piI; Inc(piJ, Gap); for i:= 1 to (arrSize - Gap) do begin if (piJ^ < piI^) then begin { Меняем местами элементы } Temp:= piJ^; piJ^:= piI^; piI^:= Temp; { Была выполнена перестановка, следовательно сортировка не завершена } Done:= False; end; Inc(piI); Inc(piJ); end; until (Done and (Gap = 1)); end; { Слияние сортированных массивов } function sortMerge(arrA: PInt; const sizeA: Byte; arrB: Pint; const sizeB: Byte; arrC: Pint): Byte; var InxA, InxB: Byte; begin { Инициализируем счетчики } InxA:= 0; InxB:= 0; { Выполняем цикл до исчерпания одного из массивов } while ((inxA < sizeA) and (InxB < sizeB)) do begin { Определяем наименьшее значение из двух массивов и копируем его в результирующий список } if (arrA^ <= arrB^) then begin arrC^:= arrA^; { Переходим к следующему элементу массива А } Inc(arrA); Inc(InxA); end else begin arrC^:= arrB^; { Следующий элемент массива В } Inc(arrB); Inc(InxB); end; { Следующий элемент результирующего массива C } Inc(arrC); end; { Если в массиве А остались элементы, копируем их в массив С } if (inxA < sizeA) then Move(arrA^, arrC^, (sizeA - InxA)*sizeof(Integer)) else { Копируем оставшиеся в массиве В элементы в массив С } Move(arrB^, arrC^, (sizeB - inxB)*sizeof(Integer)); { Результат выполнения функции = размер массива С } sortMerge:= sizeA + sizeB; end; { Variables & Constaints } var A, B: array[1..50] of Integer; C: array[1..100] of Integer; na, nb, nc: Byte; begin { Вводим размеры массивов А и В } repeat write('Na = '); Readln(na); until ((na > 0) and (na < 51)); repeat write('Nb = '); Readln(nb); until ((nb > 0) and (nb < 51)); { Инициализируем генератор случайных чисел } Randomize; { Заполняем массивы А и В } { при желании можно сделать ручное заполнение } randFill(@A, na); randFill(@B, nb); { Выводим содержимое массивов } { Если реализуете ручное заполнение массивов, то лучше не выполнять данного шага } write('A = '); printArr(@A, na); write('B = '); printArr(@B, nb); writeln('Sorted:'); { Сортировка массивов } sort(@A, na); sort(@B, nb); { Вывод отсортированных массивов } write('A = '); printArr(@A, na); write('B = '); printArr(@B, nb); { Слияние двух отсортированных массивов в один отсортированный массив С } nc:= sortMerge(@A, na, @B, nb, @C); { Вывод массива С } write('C = '); printArr(@C, nc); { Ожидаем от пользователя дальнейших действий } writeln; writeln('Press ''Enter'' to continue...'); Readln; end. --------- Все должно быть сделано настолько просто, насколько это возможно. Но не проще. (с) А.Эйнштейн

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

Вопрос № 154.295

Обозначим f(i) = 1/ (i^2+1) + 1/ ( i^2+2) +1/(i^2+i+1) , i=0,1,... Написать программу вычисления произведения f(0) * f(1) *...* f(n) . n - дано. с помощю операторов FOR , REPEAT и WHILE.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Микола! Решение в приложении. Комментапии не писал, все очень просто. Будут вопросы, пишите в мини-форум. Приложение: uses crt; const n=10; var i:integer; f,t:real; begin clrscr; f:=0; for i:=0 to n do begin t:=1/(i*i+i+1); f:=f+t; end; writeln('FOR f=',f:0:5); f:=0;i:=0; repeat t:=1/(i*i+i+1); f:=f+t; i:=i+1; until i>n; writeln('REPEAT f=',f:0:5); f:=0;i:=0; while i<=n do begin t:=1/(i*i+i+1); f:=f+t; i:=i+1; end; writeln('WHILE f=',f:0:5); readln end.

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

Вопрос № 154.297

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

Отправлен: 14.12.2008, 12:37 Вопрос задал: Ефимкин Евгений Владимирович Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шичко Игорь Здравствуйте, Ефимкин Евгений Владимирович! Предлагаю вариант решения с использованием функции. Код в приложении. Приложение: programm pr_chisla; function Prost(num: integer):boolean; {функция возвращает True, если число простое} var temp: boolean; i: integer; begin temp:= True; for i:= 2 to num-1 do begin if num mod i = 0 then temp:= False; end; Prost:= temp; end; var k, i, kol: integer; begin writeln('Vvedite k > 1'); readln(k); kol:=0; i:=1; while kol <> k do begin inc(i); if Prost(i) then kol:=kol+1; end; writeln('Prostoe chislo #', k:3, ' = ', i); readln; end.

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

Вопрос № 154.312

Пожалуйста , помогите с решением данной задачи: Составить программу, которая переносит в конец непустого списка L его первый элемент.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Аркадий Петрович! Программа с комментариями в приложении. Удачи! Приложение: const n=10; type TList=^RList; RList=record x:integer; y:TList; end; var a,b:Tlist; i:integer; begin {создаем список} a:=nil; for i:=1 to n do begin new(b); b^.x:=random(20); b^.y:=a; a:=b; end; {выводим его} while b<>nil do begin write(b^.x:4); b:=b^.y; end; {ищем последний элемент списка} writeln; b:=a; while b^.y<> nil do b:=b^.y; {замыкаем кольцо} b^.y:=a; b:=a; {переходим на второй элемент} a:=a^.y; {ставим маркер конца списка} b^.y:=nil; {выводим список} b:=a; while b<>nil do begin write(b^.x:4); b:=b^.y; end; {освобождаем память} repeat b:=a; a:=a^.y; dispose(b); until a=nil; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 154.322

Есть задание такого типа: "Дан массив вещественных чисел, содержащий 25 элементов, записать в этот же массив сначала все положительные, затем все отрицательные числа и нули, сохраняя порядок их следования." Никак не могу с ним разобраться, поможете?

Отправлен: 14.12.2008, 16:14 Вопрос задал: Сергей Жастифаев (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Сергей Жастифаев! Программа в приложении. Количество переменных минимально(один массив и один индекс этого массива). Вопросы задавайте в мини-форуме. Удачи! Приложение: const N=25; var a:array[1..N]of real; i:integer; begin {создаем массив} for i:=1 to N do begin a[i]:=50*random-25; write(a[i]:8:3); end; {начинаем сортировку} i:=0; writeln; repeat {ищем первый полжительный элемент} repeat inc(i); until(i>=N)or(a[i]>0); {начинаем обен пока не встретим положительный элемент} while (i>1)and(a[i-1]<=0)and(i<N)do begin a[i]:=a[i]+a[i-1]; a[i-1]:=a[i]-a[i-1]; a[i]:=a[i]-a[i-1]; dec(i); end; until i>=N; writeln; {выводим результат} for i:=1 to N do write(a[i]:8:3); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 154.336

Здравствуйте уважаемые эксперты вот задачки : 1.Дано предложение (введенное с клавиатуры). Найти в каком из слов больше четырех символов и буква А встречается реже. 2.Произвести с помощью подпрограммы сортировку по возрастанию всех столбцов матрицы А(7,7).

Отправлен: 14.12.2008, 18:08 Вопрос задала: Анна Александоровна Нежнова (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Анна Александоровна Нежнова! Решение второй задачи в приложении. Приложение: uses crt; const n=7; type Tmatr= array[1..n,1..n] of integer; procedure SortStb(y:integer; var m:Tmatr);{процедура сортировки одного столбца (y)} var x,k,t:integer; begin for x:=1 to n-1 do for k:=x+1 to n do if m[x,y]>m[k,y] then {сортировка обменом по возрастанию} begin t:=m[x,y]; m[x,y]:=m[k,y]; m[k,y]:=t; end; end; var a:Tmatr; i,j:integer; begin clrscr; randomize; writeln('Ishodnaja matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; writeln; writeln('Rezultat:'); for j:=1 to n do SortStb(j,a); {сортировка всех столбцов} for i:=1 to n do begin for j:=1 to n do write(a[i,j]:4); writeln; end; readln end.

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

Вопрос № 154.344

Здраствуйте, помогите пожалуйста составить программу которая проверяет есть ли в списке L хотя бы 2 одинаковых элемента.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Sever151! Программа в приложении. Удачи! Приложение: type Tlist=^Rlist; Rlist=record x:integer; y:Tlist; end; var a,b:Tlist; z:integer; begin {создаем список} a:=nil; for z:=1 to 20 do begin new(b); b^.x:=random(20); b^.y:=a; a:=b; end; {выводим его} while b<>nil do begin write(b^.x:3); b:=b^.y; end; writeln; b:=a; z:=0; {начинаем поиск одинаковых элементов} repeat {поиск одинаковых элементов} while b^.y<>nil do begin {переходим на следующий элемент} b:=b^.y; {проверяем условие} if a^.x = b^.x then begin {выводим результат работы} inc(z); writeln(a^.x:3,'=':2,b^.x:3); end; end; {освобождаем память} b:=a^.y; dispose(a); a:=b; until a=nil; write(z>0); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Вопрос № 154.375

Сложите список группы с № спортсменов.Для каждего спортсмена укажите фамилию,имя,школу,класс,результаты во следующих видах: вольные упражнения,прыжки,прыжки через коня.Информацию про каждего спортсмена оформить в виде записи.все записи объеденить у файл.Сложите програму ,которая обеспечивает введение полученой информации ,распечатку ее в виде таблици, а также распечатку данных спортсменов,которые не одержали победы. Пожалуйста,помогите!Очень надо!СПС!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Vadimka1991! Привожу вариант решения так, как я его понял из условия, если что не так, пишите в мини-форум, поправим. Решение в приложении. Попробую прикрепить сам файл. Приложение: uses crt; const n=5;{количество спортсменов, это для тестирования, надо взять больше} type Tsport=record {тип запись с полями по условию} fam:string[15]; {фамилия} shk:word; {школа} kls:string[3]; {класс} rez:record {результаты} vol:real; {вольные упражнения} prz:real;{прыжки} kon:real;{конь} end; end; var sp:array[1..n] of Tsport;{массив записей} f:file of Tsport; {типизированный файл для хранения записей} i:integer; maxv,maxp,maxk:real;{максимальные результаты} begin clrscr; assign(f,'sport.dat'); {связываем переменную с файлом на диске} rewrite(f); {открываем его для записи} writeln('Vvedite dannye o ',n,' sportsmenah:');{заполняем список данными} for i:=1 to n do begin writeln('Sportsmen ',i); write('Familia: ');readln(sp[i].fam);{фамилия- строка до 15 символов} write('Shkola: ');readln(sp[i].shk);{школа- натуральное число} write('Klass: ');readln(sp[i].kls); {класс типа 11а} writeln('Rezultaty:'); write(' Volnye: ');readln(sp[i].rez.vol);{результаты типа 10,25, 9,32} write(' Pryzki: ');readln(sp[i].rez.prz); write(' Kon: ');readln(sp[i].rez.kon); write(f,sp[i]); {заносим запись в файл] end; reset(f); {открываем файл для чтения} clrscr; {очищаем экран} writeln(' Spisok sportsmenov:'); {выводим весь список} writeln('----------------------------------------------------------'); writeln('| Familia | Shkola | Klass | Rezultaty |'); writeln('| | | |-------------------------'); writeln('| | | | Volnye | Pryzki | Kon |'); writeln('----------------------------------------------------------'); for i:=1 to n do begin read(f,sp[i]); writeln(sp[i].fam:11,sp[i].shk:9,sp[i].kls:9,sp[i].rez.vol:11:2, sp[i].rez.prz:8:2,sp[i].rez.kon:8:2); end; readln; {читаем} close(f); {закрываем файл} reset(f); {снова открываем для чтения, поскольку он уже один раз прочитан} maxv:=0;maxp:=0;maxk:=0; for i:=1 to n do {ищем максимальные результаты по видам, т.е. результаты победителей} begin if sp[i].rez.vol>maxv then maxv:=sp[i].rez.vol; if sp[i].rez.prz>maxp then maxp:=sp[i].rez.prz; if sp[i].rez.kon>maxk then maxk:=sp[i].rez.kon; end; clrscr; writeln(' Sportsmeny, ne oderzavshie pobed:'); writeln('----------------------------------------------------------'); writeln('| Familia | Shkola | Klass | Rezultaty |'); writeln('| | | |-------------------------'); writeln('| | | | Volnye | Pryzki | Kon |'); writeln('----------------------------------------------------------'); for i:=1 to n do begin read(f,sp[i]); {читаем файл} if {если у спортсмена нет ни одного максимального результата, выводим его на экран} sp[i].rez.vol<>maxv)and(sp[i].rez.prz<>maxp)and(sp[i].rez.kon<>maxk)then writeln(sp[i].fam:11,sp[i].shk:9,sp[i].kls:9,sp[i].rez.vol:11:2, sp[i].rez.prz:8:2,sp[i].rez.kon:8:2); end; readln end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

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

Вопрос № 154.388

Здравствуйте господа эксперты! Помогите решить 4 задачи. Массивы одномерные,и операторы простые)) 1)Отсортировать по алфавиту массив символов 2)Определить,есть ли в данном массиве два соседних положительных элемента.Найти номер первой(последней)пары. 3)Определить,есть ли в данном массиве положительные элементы,кратные числу К. 4)Удалить из Массива все повторяющиеся элементы,оставив их первые вхождения,т.е в массиве должны остаться только различные элементы. Зарание спасибо)

Отправлен: 15.12.2008, 00:23 Вопрос задал: Knellen (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Knellen! Решение задач с пояснениями в приложении. Приложение: №1. uses crt; const n=30; {размер массива} var s:array[1..n] of char; {массив символов} i,j:integer; c:char; {символьная переменная, буфер при сортировке} begin clrscr; randomize; writeln('Massiv simvolov:'); for i:=1 to n do begin s[i]:=chr(ord(random(26)+65));{заполним массив случайным образом прописными английскими буквамим, их коды от 65 до 90 } write(s[i]); end; writeln; for i:=1 to n-1 do {отсортируем их лбменным методом по возрастанию, это тоже, счто и по алфавиту} for j:=i+1 to n do if s[i]>s[j] then begin c:=s[i]; s[i]:=s[j]; s[j]:=c; end; writeln('Massiv po alfavitu:'); for i:=1 to n do write(s[i]); readln end. №2. uses crt; const n=20; var a:array[1..n] of integer; i,j,k:integer; begin clrscr; randomize; writeln('Massiv :'); for i:=1 to n do begin a[i]:=random(10)-3; {заполняем массив числами из инт. -3, 6} write(a[i],' '); end; writeln; k:=0; for i:=2 to n do {смотрим сначала} if (a[i]>0) and(a[i-1]>0)then {находим пару} begin writeln('Pervaja para polozitelnyh elementov ',i-1,'-',i); k:=k+1; {фиксируем находку} break; {прекращаем поиск} end; for i:=n downto 2 do {смотрим с конца} if (a[i]>0) and(a[i-1]>0)then {то же самое} begin writeln('Poslednja para polozitelnyh elementov ',i-1,'-',i); k:=k+1; break; end; if k=0 then writeln('Par polozitelnyh elementov net!');{если не встретили пар} readln; end. №3. uses crt; const n=20; var a:array[1..n] of integer; i,j,k:integer; begin clrscr; randomize; writeln('Massiv :'); for i:=1 to n do begin a[i]:=random(20)-5; {заполняем массив числами из инт. -5, 14} write(a[i],' '); end; writeln; write('Vvedite chislo K='); {задумываем число} readln(k); j:=0; for i:=1 to n do if (a[i]>0)and(a[i] mod k=0) then {ищем положительное и кратное ему} begin writeln('Polozitelnye elementy, kratnye K est!'); j:=1; {нашли, фиксируем} break;{прекращаем поиск} end; if j=0 then writeln('Polozitelnyh elementov, kratnye K net!');{если не нашли} readln end. №4. uses crt; const n=20; var a:array[1..n] of integer; i,j,k,q,t:integer; begin clrscr; randomize; writeln('Massiv :'); for i:=1 to n do begin a[i]:=random(20)-5; {аналогично создаем массив из случайных чисел} write(a[i],' '); end; writeln; i:=1;q:=n; {запомним размер массива, так как при удалении лишних элементов он будет уменьшаться} while i<=n do {смотрим массив сначала до конца} begin j:=i+1; {начинаем со следующего за i смотреть} while j<=q do {до изменяющегося конца} begin if a[j]=a[i] then {если нашли совпадение} begin for t:=j to q-1 do {сдвигаем массив доэтого элемента на 1 влево и он исчезает} a[t]:=a[t+1]; q:=q-1;[уменьшаем длину массива на 1} end else j:=j+1; {если не совпадение, переходим дальше} end; i:=i+1; {ищем повторы следующего числа} end; writeln('Vse po odnomu:'); for i:=1 to q do write(a[i],' '); readln end.

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

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