Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

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

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

_Ayl_ Статус: Студент Рейтинг: 1387 ∙ повысить рейтинг »

Boriss Статус: Академик Рейтинг: 1127 ∙ повысить рейтинг »

Micren Статус: Бакалавр Рейтинг: 963 ∙ повысить рейтинг »

Вопрос № 173518: УВАЖАЕМЫЕ ЭКСПЕРТЫ ПОМОГИТЕ Коэффициент К2 принимать в зависимости от числа 2 работающих рем¬ней: К2=0,95при2 = 2...3; К7=0,9при2 = 4 ... 6; К2= 0,85 при 2 свыше 6. В зависимости от задач проектирования предполагается выбор числа одно¬...

УВАЖАЕМЫЕ ЭКСПЕРТЫ ПОМОГИТЕ
Коэффициент К2 принимать в зависимости от числа 2 работающих рем¬ней:
К2=0,95при2 = 2...3;
К7=0,9при2 = 4 ... 6;
К2= 0,85 при 2 свыше 6.
В зависимости от задач проектирования предполагается выбор числа одно¬временно работающих ремней, что должно быть учтено в программе.
Разработать программу для расчета необходимого (потребного) числа ремней 2 ременной передачи, если угол обхвата а принимает значения от 70° до 150° с шагом 20°.
Расчет 2 выполнять по формуле

Z=(W*Kg)/(W0*K)

где W - общая передаваемая передачей мощность, кВт; Кg - коэффициент динамичности (принять Кg = 1,1); К - корректирующий коэффициент:

K=Ka*Kl*Kz (a-альфа)

Ка - коэффициент угла обхвата:

а 70 90 110 130 150
Ka 0.56 0.68 0.78 0.88 0.92

Кl - коэффициент, учитывающий влияние длины ремня на его радиус (принять Ка = 0,99); Кz - коэффициент, учитывающий неравномерное распределение нагрузки между одновременно работающими ремнями (см. задание 22){находиться в начале вопроса}.
В зависимости от задач проектирования предполагается выбор того или другого угла обхвата из приведенной выше таблицы, что должно быть учтено в программе.

{нашел еще формулу W из задания 21 только незнаю нужнали она здесь}

{W=W0*Kz/Kg где W0 - мощность, передаваемая одним ремнем, кВт}

Отправлен: 21.10.2009, 19:21
Вопрос задал: Вадим555, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
program p173518; { Разработать программу для расчета необходимого (потребного) числа ремней Z ременной передачи, если угол обхвата <а> принимает значения от 70° до 150° с шагом 20°. Расчет Z выполнять по формуле Z=(W*Kg)/(W0*K) где W - общая передаваемая передачей мощность, кВт; Кg - коэффициент динамичности (принять Кg = 1,1); К - корректирующий коэффициент: K=Ka*Kl*Kz (a-альфа) Ка - коэффициент угла обхвата: а---- 70----- 90 -----110---- 130----- 150 Ka --0.56-- 0.68 ---0.78---- 0.88---- 0.92 КL - коэффициент, учитывающий влияние длины ремня на его радиус (принять КL = 0,99); Кz - коэффициент, учитывающий неравномерное распределение нагрузки между одновременно работающими ремнями Кz=0,95 при Z = 2...3; Кz=0,9 при Z = 4 ... 6; Кz= 0,85 при Z свыше 6. В зависимости от задач проектирования предполагается выбор того или другого угла обхвата из приведенной выше таблицы, что должно быть учтено в программе. } var z : integer; z0: integer; w : real; w0: real; alpha: real; function kalpha(alpha: real): real; { включая интерполяцию } const razmer = 5; eps = 0.001; type TPair = record a: real; ka: real; end; const tbl: array[1..razmer] of TPair = ( (a: 70.0; ka:0.56), (a: 90.0; ka:0.68), (a:110.0; ka:0.78), (a:130.0; ka:0.88), (a:150.0; ka:0.92)); var i: integer; amin, amax: real; begin if alpha<tbl[1].a then kalpha := 0.0 else if alpha>tbl[5].a then kalpha := 1.0 else begin i:= 1; while (alpha>tbl[i].a) and (i<=razmer) do i:= i+1; if abs(alpha-tbl[i].a)<eps then kalpha := tbl[i].ka else kalpha := tbl[i-1].ka + (alpha-tbl[i-1].a) / (tbl[i].a-tbl[i-1].a) * (tbl[i].ka-tbl[i-1].ka); end; end; {kalpha} function kg: real; begin kg := 1.1; end; { kg } function kl: real; begin kl := 0.99; end; { kl } function kz(z: integer): real; begin if z=1 then kz := 1 { при одном ремне нет неравномерного распределения } else if z in [2..3] then kz := 0.95 else if z in [4..6] then kz := 0.9 else if z > 6 then kz := 0.85 else kz:= MaxInt; end; { kz } procedure calc_z(w0, w, alpha: real; z0: integer; var z: integer); { рекурсия, пока в соседних вызовах число ремней будет отличаться не более, чем на 1 } var k: real; begin k:= kalpha(alpha)*kl*kz(z0); z := round( (w*kg)/(w0*k) ); { writeln(\'z=\',z,\' z0=\',z0); } if abs(z-z0)>=2 then calc_z(w0, w, alpha, round((z+z0)/2),z); end; { calc_z } begin writeln(\'произвольный пример\'); calc_z(0.5, 2.0, 90.0, 4, z); writeln(\'z=\',z); write(\'w=\'); readln(w); write(\'w0=\'); readln(w0); write(\'alpha=\'); readln(alpha); write(\'начальное приближение z0=\'); readln(z0); calc_z(w0, w, alpha, z0, z); writeln(\'z=\',z); end.

Ответ отправил: leonid59, Студент
Ответ отправлен: 26.10.2009, 21:31

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255883 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Дана цепочка символов, состоящая из скобок вида (',')','[',']'. Определить правильная ли она (правильная: [(())], неправильная: ((])),(())],...). Ответ распечатать словами "да", "нет".

Отправлен: 21.10.2009, 23:45
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{ Дана цепочка символов, состоящая из скобок вида (\',\')\',\'[\',\']\'. Определить правильная ли она (правильная: [(())], неправильная: ((])),(())],...). Ответ распечатать словами "да", "нет". } Program Brackets; Type PStack = ^TStack; TStack = Record next : PStack; ch : Char; end; Var st : PStack; Function isEmpty : Boolean; begin isEmpty := st = nil; end; Procedure Push (ch : Char); var p : PStack; begin New (p); p^.next := st; p^.ch := ch; st := p; end; Function Pop : Char; var p : PStack; begin if isEmpty then Pop := #0 else begin Pop := st^.ch; p := st; st := st^.next; Dispose (p); end; end; Function isTwink (openCh : Char; closeCh : Char) : Boolean; begin case openCh of \'(\' : isTwink := closeCh = \')\'; \'[\' : isTwink := closeCh = \']\' else isTwink := false; end; end; Var s : string; { Цепочка символов } ch : Char; { Текущий символ строки } openBracket : Char; { Открывающаяся скобка } i : Byte; { Переменная цикла } correctFlag : Boolean; { Результат проверки } Begin write (\'Введите строку символов, состоящую из скобок: \'); readln (s); correctFlag := true; for i := 1 to length (s) do begin ch := s [i]; case ch of \' \' : ; \'(\', \'[\' : Push (ch); \')\', \']\' : if not isTwink (Pop, ch) then begin correctFlag := false; break; end; else begin writeln (\'Строка содержит посторонний символ: "\', ch, \'"! Обработка прекращена\'); correctFlag := false; break; end; end; end; correctFlag := correctFlag and isEmpty; if correctFlag then writeln (\'да\') else writeln (\'нет\'); End.

Ответ отправил: _Ayl_, Студент
Ответ отправлен: 22.10.2009, 10:50

Оценка ответа: 5
Комментарий к оценке:
Спасибо!!!

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255706 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Дана последовательность символов . Определить сколько среди них различных.

Отправлен: 21.10.2009, 23:48
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
program q_173526; uses CRT; {Подключаем библиотеку CRT для ClrScr(очистка экрана), ReadKey(задержка экрана)} var s : String; {\'s\'-переменная, где будет храниться наш текст} i, n, p: Integer; {\'i\'-счетчик, \'n\' и \'p\' им будет присвоен соответственно результат выполнения функций \'длина строки\' и \'поиск в строке\'} begin ClrScr; WriteLn(\'Vvedite posledovatel\'\'nost\'\' simvolov: \'); ReadLn(s); n:=length(s); {длина строки} i:=1; {счетчик начинается с 1} While i<=n do begin WriteLn(s); {Смотрим как выглядит строка на данный момент итерции} p:=pos(s[i],s); {ищем позицию i символа в нашей строке} if (p<i) then {Если такой символ уже встечался, то удаляем его} begin delete(s,i,1); n:=n-1; end else i:=i+1; end; WriteLn(\'Razlichnyh simvolov: \',length(s)); WriteLn(\'Vvedite ljubuju klavishu dlja vyhoda...\'); ReadKey; end.

Ответ отправил: LfiN, 8-й класс
Ответ отправлен: 22.10.2009, 01:42

Оценка ответа: 5
Комментарий к оценке:
Спасибо!!!

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255695 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает leonid59, Студент :
Здравствуйте, смирнов артем владимирович.
Ответ в приложении. Программа обрабатывает строку за один проход.
Turbo Pascal 7

Приложение:
program p173526; { Дана последовательность символов . Определить сколько среди них различных. } var s : string; { строка символов } i : integer; { номер символа в строке } n : integer; { количество различных символов } chars: array[char] of integer; { массив количества вхождений символов } ch : char; { счетчик элементов массива } begin for ch:= chr(0) to chr(255) do chars[ch]:= 0; write(\'s= \'); readLn(s); { заполнение массива числа вхождений нулями} for ch:= chr(0) to chr(255) do chars[ch]:= 0; { обрабатываем строку за один проход } for i:= 1 to length(s) do inc(chars[s[i]]); n:= 0; for ch:= chr(0) to chr(255) do { если символ встретился в строке, значение соответствующего элемента больше нуля } if chars[ch]>0 then inc(n); writeln(\'n=\', n); end.

Ответ отправил: leonid59, Студент
Ответ отправлен: 23.10.2009, 14:05

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255755 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Дан массив из пяти строк. В строке "наименование завода_количество выпускаемой продукции". Вычислить общее количество выпускаемой продукции, распечатать наименование завода, выпустившего максимальное количество продукции.

Отправлен: 21.10.2009, 23:49
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; var plants:array[1..5] of string; max, sum, n_max, n, e:integer; p, i:byte; begin clrscr; max:=1; readln(plants[1]); p:=pos(\'_\',plants[1]); val(copy(plants[1],p+1,length(plants[1])-p),n,e); n_max:=n; Sum:=n; for i:=2 to 5 do begin readln(plants[i]); p:=pos(\'_\',plants[i]); val(copy(plants[i],p+1,length(plants[i])-p),n,e); sum:=sum+n; if n>n_max then begin max:=i; n_max:=n end; end; writeln(copy(plants[max],1,pos(\'_\',plants[max])-1), \' sum=\',sum); readkey end.

Ответ отправил: Максим Юрьевич, 6-й класс
Ответ отправлен: 22.10.2009, 00:26

Оценка ответа: 5
Комментарий к оценке:
Спасибо!!!

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255691 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Даны действительные числа a,b,c,d. Вычислить и напечатать с использованием функции max(a+b,b*c)-(d-a,b/c) / min(a,b*d)

Отправлен: 21.10.2009, 23:52
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
program p173528; { Даны действительные числа a,b,c,d. Вычислить и напечатать с использованием функции max(a+b,b*c)-min(d-a,b/c)/min(a,b*d) } var a,b,c,d: real; function max(x1,x2: real): real; begin if x1>x2 then max := x1 else max := x2; end; { max } function min(x1,x2: real): real; begin if x1<x2 then min := x1 else min := x2; end; { min } begin { main } { Ввод данных } write(\'a=\'); readln(a); write(\'b=\'); readln(b); write(\'c=\'); readln(c); write(\'d=\'); readln(d); { Печать результатов } if (a=0) or (b=0) or (c=0) or (d=0) then writeln(\'zero division\') else writeln(\'max(a+b,b*c)-min(d-a,b/c)/min(a,b*d)=\', max(a+b,b*c)-min(d-a,b/c)/min(a,b*d):7:4); end.

Ответ отправил: leonid59, Студент
Ответ отправлен: 24.10.2009, 10:10

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255780 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Даны целочисленные матрицы А(3,4), В(3,4). Есть ли среди них числа являющиеся полными квадратами, простыми числами. Выделить те и другие с использованием процедуры, распечатать.

Отправлен: 21.10.2009, 23:53
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
program p173529; const Rows = 3; { строк } Cols = 4; { столбцов } type TMatrix = array[1..Rows, 1..Cols] of integer; var a, b: TMatrix; { данные матрицы } procedure Init2d(var m: TMatrix; name: string); { ввод с клавиатуры } var r, c: integer; begin writeln; writeln(\'Ввод матрицы \', name); for r:= 1 to Rows do for c:= 1 to Cols do begin write(name, \'[\',r,\',\',c,\']=\'); readln(m[r,c]); end; end; { Init2d } procedure CheckIfPrime(num: Integer; var IsPrime: boolean); { является ли число простым } var i: integer; begin IsPrime := true; i:=2; while i*i<=num do begin if (num mod i = 0) then begin IsPrime := false; exit; end; inc(i); end; end; { CheckIfPrime } procedure CheckIfSquare(num: integer; var IsSquare: boolean); { является ли число полным квадратом } var i: integer; sq: integer; begin i:=2; sq := i*i; while sq<num do begin inc(i); sq := i*i; end; IsSquare := sq = num; end; {CheckIfSquare } procedure PrintIfSquares(var m: TMatrix; name: string); var IsSquare: boolean; { является полным квадратом } Squares: integer; { полных квадратов } r, c: integer; begin Squares := 0; IsSquare := false; r := 1; for r:= 1 to Rows do for c:= 1 to Cols do begin CheckIfSquare(m[r,c], IsSquare); if IsSquare then begin inc( Squares ); if squares=1 then begin writeln; write(\'Полные квадраты \'); end; write(name,\'[\',r,\',\',c,\']=\',m[r,c], \';\'); end end; if Squares = 0 then writeln(\'Нет полных квадратов\') else begin writeln; writeln(\'Всего \',Squares, \' полных квадратов\'); end; end; { PrintIfSquares } procedure PrintIfPrimes(var m: TMatrix; name: string); var IsPrime: boolean; { является простым числом } primes: integer; { простых чисел } r, c: integer; begin primes := 0; IsPrime := false; r := 1; for r:= 1 to Rows do for c:= 1 to Cols do begin CheckIfPrime(m[r,c], IsPrime); if IsPrime then begin inc(primes); if primes=1 then begin writeln; write(\'Простые числа \'); end; write(name,\'[\',r,\',\',c,\']=\',m[r,c], \';\'); end end; if Primes = 0 then writeln(\'Нет простых чисел\') else begin writeln; writeln(\'Всего \',Primes, \' простых чисел\'); end; end; { PrintIfPrimes } procedure Print2d(var m: TMatrix; name: string); { печать матрицы } var r: integer; c: integer; begin writeln; writeln(\'Матрица \', name); write(\' \':4); for c:= 1 to Cols do write(c:4); writeln; writeln(\'====================\'); for r:= 1 to rows do begin write(c:4); for c:= 1 to Cols do write(m[r,c]:4); writeln; end; end; { Print2d } begin { main } init2d(a, \'a\'); Print2d(a, \'a\'); PrintIfSquares(a, \'a\'); PrintIfPrimes(a, \'a\'); init2d(b, \'b\'); Print2d(b, \'b\'); PrintIfSquares(b, \'b\'); PrintIfPrimes(b, \'b\'); readln; end.

Ответ отправил: leonid59, Студент
Ответ отправлен: 23.10.2009, 16:15

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255757 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Дан вещественный массив х(5). Вычислить сумму ряда Si для каждого хi с точностью , используя функцию и распечатать в виде таблицы xi,Si

S= -x^2 / 2*2i + x^4 / 4*4i - x^6 / 6*6i +...+(-1)* x^2n / 2n *2ni

^-степень

Отправлен: 21.10.2009, 23:56
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{ Вопрос № 173530 Дан вещественный массив х(5). Вычислить сумму ряда Si для каждого хi с точностью , используя функцию и распечатать в виде таблицы xi,Si S= -x^2 /(2*2*i) + x^4 /(4*4*i) - x^6 /(6*6*i)+...+(-1)* x^2n/(2*n *2*n*i) a[1] = -(x/2)^2/i; a[n+1] =-(x*k/(k+1))^2*a[n]; Ряд расходится при |x|>1, иначе ряд сходится, причем, абсолютно. } program p173530; uses crt; const size = 5; var i: integer; e: real; x: array[1..size] of real; function s(x,e: real; i: integer): real; var k: integer; { номер члена ряда } a: real; { k-й член ряда } sum: real; { частичная сумма ряда } begin k:= 1; a:= -sqr(x/2)/i; { первый член ряда } sum := 0; while abs(a)>=e do begin sum := sum+a; a := -a*sqr(x*k/(k+1)); { последующий член ряда } k:= k+1; end; s:= sum; end; { s } begin { ввод } clrscr; for i:= 1 to size do begin write(\'x[\',i,\']=\'); readln(x[i]); end; repeat write(\'epsilon=\'); readln(e); until e>0; { расчет и печать } writeln; writeln(\' x s\'); for i:= 1 to size do if (abs(x[i])>1) then writeln(x[i]: 8:6, \' \', \'Ряд расходится\') else writeln(x[i]: 8:6, \' \', s(x[i], e, i):8:6); readln; end.

Ответ отправил: leonid59, Студент
Ответ отправлен: 25.10.2009, 16:09

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255828 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Задан диапазонный тип М: type M=2..25;. Переменной Х присвоить множество всех целых чисел из 2..25. Переменной У - множество всех простых чисел из этого диапазона,Z-множество составных чисел.Распечатать Х,У,Z с использованием процедуры.

Отправлен: 21.10.2009, 23:58
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
const n1=2; n2=25; type M=n1..n2; tM=set of M; var X,Y,Z:tM; i:M; {функция контроля простых чисел} function pr(a:M):boolean; var b:boolean; c:M; begin b:=true; for c:=n1 to a-1 do if c>1 then b:= b and ((a mod c)>0); pr:=b; end; {функция контроля составных чисел} function so(a:M):boolean; var b:boolean; c,d:M; begin b:=false; for c:=n1 to a-1 do for d:=n1 to a-1 do b:=b or ((c*d)=a); so:=b; end; {процедура вывода} procedure view(a:tM;b:string); var c:M; begin writeln(b,\' numbers:\'); for c:=n1 to n2 do if c in a then write(c:3);{если число есть в множестве выводим} writeln; end; begin {сбрасываем множества} X:=[]; Y:=[]; Z:=[]; {перебираем диапозон} for i:=n1 to n2 do begin if pr(i)then Y:=Y+[i] else if so(i)then Z:=Z+[i]; X:=X+[i]; end; {выводим результаты} view(X,\'integer\'); view(Y+Z,\'integer2\'); view(Y,\'prime\'); view(Z,\'composite\'); readln; end.
-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич, Модератор
Ответ отправлен: 22.10.2009, 15:28
Украина, Киев
Тел.: +38-097-953-66-19
Адрес: Украина, Киев

Оценка ответа: 5
Комментарий к оценке:
Спасибо!!!

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255713 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Даны целые числа a1,...,an.Является ли последовательность a1,...,an перестановкой чисел 1,...,n ?

Отправлен: 21.10.2009, 23:58
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
program p173533; { Даны целые числа a1,...,an.Является ли последовательность a1,...,an перестановкой чисел 1,...,n ? } var a: integer; { вводимое число } i: integer; { номер вводимого числа } n: integer; { верхняя граница интервала } s: array[1..MaxInt] of 0..1; { создаем заведомо большой массив для хранения признаков того, встретилось ли число из интервала 1..n в последовательности вводимых чисел } perest: boolean; begin write(\'n=\'); readln(n); for i:= 1 to n do s[i] := 0; { пока не ввели ни одного числа, признак 0 } { не инициализируем элементы массива с номером свыше n, так как они нам не интересны } i:= 1; perest := true; { предположим, что последовательность является перестановкой } while (i<=n) and perest do begin write(\'a[\',i,\']=\'); readln(a); if (a in [1..n]) and (s[a]=0) then begin s[a]:=1; i:= i+1; end else { вводимое число либо не в интервале, либо уже встречалось } perest := false; end; if perest then writeln(\'Является\') else writeln(\'Не является\'); end.

Ответ отправил: leonid59, Студент
Ответ отправлен: 24.10.2009, 10:53

Оценка ответа: 5
Комментарий к оценке:
Спасибо

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255782 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Точка на плоскости задана в виде массива записей с полями: поле1- координата по оси Х поле2- координата по оси У


Упорядочить точки в массиве в соответствии с правилом (x,y),(u,v) если либо x<u, либо x=u< но y,v.

Отправлен: 22.10.2009, 15:39
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; type point=record x,y:integer; end; const nmax=20; var a:array[1..nmax] of point; n,i,j:byte; b:point; begin clrscr; randomize; repeat write(\'Количество точек, не более 19 n=\'); readln(n); until n in [1..19]; {просто подогнал количество под ширину окна} writeln(\'Исходный массив:\'); write(\'X\'); for i:=1 to n do begin a[i].x:=random(10)-4; write(a[i].x:4); end; writeln; write(\'Y\'); for i:=1 to n do begin a[i].y:=random(10)-4; write(a[i].y:4); end; writeln; for i:=1 to n-1 do {сортируем пузырьком по условию} for j:=i+1 to n do if(a[i].x>a[j].x)or((a[i].x=a[j].x)and(a[i].y>a[j].y)) then begin b:=a[i]; a[i]:=a[j]; a[j]:=b; end; writeln; writeln(\'Отсортированный массив:\'); write(\'X\'); for i:=1 to n do write(a[i].x:4); writeln; write(\'Y\'); for i:=1 to n do write(a[i].y:4); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 23.10.2009, 21:14

Оценка ответа: 5
Комментарий к оценке:
Спасибо

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255763 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Изобразить на экране прямоугольник, вращающийся вокруг одной из своих вершин.

Отправлен: 22.10.2009, 15:44
Вопрос задал: смирнов артем владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt,graph; {Поворот точки вокруг цнтра х0,у0 на а градусов} procedure Vrash(a:real;var x,y:integer;const x0,y0:integer); var px:integer; begin x:=x-x0; y:=y-y0; a:=a*pi/180; px:=x; x:=round(x*cos(a)-y*sin(a))+x0; y:=round(y*cos(a)+px*sin(a))+y0; end; const Width=150; {размеры прямоугольника} Haight=120; var gd,gm:integer;{параметры входа в граф. режим} ch:char; {символ для выхода из программы} ax,ay,bx,by,cx,cy,dx,dy:integer;{заданные координаты 4х точек} tbx,tby,tcx,tcy,tdx,tdy:integer;{текущие координаты 3х вращающихся точек} a:real; {угол поворота} begin initgraph(gd,gm,\'\'); {начальное положение прямоугольника} ax:=GetmaxX div 2;ay:=GetmaxY div 2; bx:=ax+Width;by:=ay; cx:=ax+Width; cy:=ay+Haight; dx:=ax; dy:=ay+Haight; a:=0; outtextxy(300,20,\'Vyhod Esc...\'); repeat delay(10);{задержка, можно менять} setfillstyle(solidfill,0); Bar(0,40,640,480);{очищаем область анимации} tbx:=bx;tby:=by;Vrash(a,tbx,tby,ax,ay);{определяем текущие координаты} tcx:=cx;tcy:=cy;Vrash(a,tcx,tcy,ax,ay); tdx:=dx;tdy:=dy;Vrash(a,tdx,tdy,ax,ay); setcolor(4);{цвет линий} moveto(ax,ay);{рисуем 4 линии} lineto(tbx,tby); lineto(tcx,tcy); lineto(tdx,tdy); lineto(ax,ay); a:=a+1;{увеличиваем угол} if keypressed then ch:=readkey; until ch=#27; {выход по нажатию Esc} end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 23.10.2009, 07:49

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255743 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »