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

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

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

_Ayl_ Статус: 8-й класс Рейтинг: 601 ∙ повысить рейтинг >>

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

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

Нам очень важно Ваше мнение об этом выпуске рассылки. Вы можете оценить этот выпуск по пятибалльной шкале, пройдя по ссылке:
оценить выпуск >>

Вопрос № 169992: Составить программу вычисления суммы членов бесконечного числового ряда с погрешностью . Определить количество членов ряда, сравнить полученное значени...

Составить программу вычисления суммы членов бесконечного числового ряда с погрешностью . Определить количество членов ряда, сравнить полученное значение суммы со значением функции y=arctg(x), lxl<1

Отправлен: 29.06.2009, 10:34
Вопрос задал: qwer1235, Посетитель
Всего ответов: 2
Страница вопроса >>

Приложение:
program p169992; { arctg(x) } var a: real; { n-й член ряда } e: real; { ошибка } n: integer; { число итераций } s: real; { сумма ряда } x: real; { аргумент } begin write(\'x=\'); readln(x); write( \'oshibka e=\'); readln( e ); s := 0; n := 0; a := x; {0й член} while abs(a)>e do begin s := s+a; n := n+1; a := -a*x*x* (2n-1)/(2*n+1); end; writeln(\'summa ryada =\',s: 6: 5); writeln(\'oshibka =\',e: 6: 5); writeln(\'chislo chlenov =\', n); writeln(\'ArcTan(\',x:6:5,\') =\', ArcTan( x ):6:5); writeln(\'rashogdenie =\', abs(ArcTan(x)-s):6:5); readln; end.

Ответ отправил: leonid59, 4-й класс
Ответ отправлен: 29.06.2009, 13:06

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

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

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

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

Приложение:
{ Составить программу вычисления суммы членов бесконечного числового ряда с погрешностью 10^(-4). Определить количество членов ряда, сравнить полученное значение суммы со значением функции y = arctg(x), |x| < 1 Заданный ряд: S = SUMM /n=0..+%/ ((-1)^n*(x^(2n+1))/(2n+1)) % - бесконечность } Program InfSeries; (* Uses Crt; *) { Остаток знакопеременного ряда определяется как абсолютное значение первого отброшенного члена: S = Sn + Rn: |Rn| <= |a(n+1)| Требуется, чтобы остаток был меньше погрешности: |Rn| <= E Заменяя |Rn| на заведомо не меньшее значение, получаем: |Rn| <= |a(n+1)| <= E - условие прекращения итераций Для заданной последовательности определим переход к следующему элементу: a(n) = a(n-1) * k(n) <=> k(n) = a(n)/a(n-1) k(n) = (((-1)^n*(x^(2n+1))/(2n+1)) / (((-1^(n-1)*(x^(2n-1)))/(2n-1))/(2n-1)) = -1 * x^2 * (2n-1)/(2n+1) = -x^2 * (2n-1)/(2n+1) } Const E = 1E-4; Function GetSum (x : Double; E : Double; var n : Word; var r : Double) : Double; var x2 : Double; { значение x^2 (постоянное значение внутри цикла) } a : Double; { текущий элемент последовательности } s : Double; { сумма ряда } begin s := 0; a := x; n := 0; x2 := sqr (x); Repeat s := s + a; Inc (n); a := -a * x2 * (2n-1) / (2*n+1); Until abs (a) <= E; r := a; GetSum := s; end; Procedure ClrScr; assembler; asm mov ax, 3 int 10h end; Var x : Double; s : Double; r : Double; n : Word; f : Double; ch : Char; Begin Repeat Repeat ClrScr; write (\'Введите значение аргумента (|x| < 1): \'); readln (x); Until abs (x) < 1; s := GetSum (x, E, n, r); writeln; writeln (\'Сумма ряда: \', s:10:8); writeln (\'Количество членов ряда: \', n); writeln (\'Разность ряда не более \', r:10:8, \' по модулю\'); writeln; f := arctan (x); writeln (\'Значение функции: \', f:10:8); writeln (\'Погрешность: \', abs (f - s):10:8); writeln; writeln; write (\'Еще один аргумент [Y/N]? \'); readln (ch); Until ch in [\'N\', \'n\', \'Н\', \'н\']; End.

Ответ отправил: _Ayl_, 8-й класс
Ответ отправлен: 29.06.2009, 14:03

Оценка ответа: 5

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

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

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

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

Здравствуйте помогите пожалуйста переделать программу на процедуру:

Отправлен: 29.06.2009, 02:28
Вопрос задал: Иванов Виктор Олегович, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
program p01; const rows = 3; cols = 5; type TMatrix = array[0..rows-1, 0..cols-1] of char; var s: string; mat: TMatrix; r: integer; procedure input2d( var mat: TMatrix ); var r,c: integer; begin for r:= 0 to rows-1 do begin for c:= 0 to cols-1 do read(mat[r,c]); readln; end; end; {input2d} procedure print2d( var mat: TMatrix ); var r,c: integer; begin for r:= 0 to rows-1 do begin for c:= 0 to cols-1 do write(mat[r,c]); writeln; end; end; {print2d} procedure bubble( var s: array of char; len: integer); { сортируем вектор символов, не строку } var i, j: integer; tmp: char; begin for i:= 0 to len-2 do for j:= len-1 downto i+1 do if s[j-1]>s[j] then begin tmp := s[j]; s[j] := s[j-1]; s[j-1] := tmp; end; end; { bubble} begin {main} input2d( mat ); writeln(\'do sortirovki\'); print2d( mat ); for r:= 0 to rows-1 do bubble( mat[r], cols ); writeln; writeln(\'posle sortirovki\'); print2d( mat ); readln; end.

Ответ отправил: leonid59, 4-й класс
Ответ отправлен: 28.06.2009, 23:16

Оценка ответа: 5
Комментарий к оценке:
Огромное спасибо! Благодарю Вас!

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

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

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

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

Здравствуйте помогите пожалуйста переделать программу на процедуру:

Отправлен: 29.06.2009, 02:32
Вопрос задал: Иванов Виктор Олегович, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
program p169981; { печатает суммы строк, содержащих отрицательные элементы } const rows = 2; cols = 3; type TMatrix = array[0..rows-1, 0..cols-1] of integer; var s: string; mat: TMatrix; r: integer; function HasNegative( vec: array of integer; elems: integer): boolean; forward; procedure input2d( var mat: TMatrix ); forward; procedure print2d( var mat: TMatrix ); forward; function RowSum( vec: array of integer; elems: integer): integer; forward; function HasNegative( vec: array of integer; elems: integer): boolean; { есть ли в массиве отрицательный элемент } var i: integer; neg: boolean; begin neg := false; i:= 0; while (i<elems) and (vec[i]>=0) do inc(i); HasNegative := i<elems; end; { HasNegative } procedure input2d( var mat: TMatrix ); { ввод матрицы } var r,c: integer; begin for r:= 0 to rows-1 do begin for c:= 0 to cols-1 do begin write(\'mat[\',r,\',\',c,\']=\'); readln(mat[r,c]); end; end; end; {input2d} procedure print2d( var mat: TMatrix ); { печать матрицы } var r,c: integer; begin writeln; writeln(\'matriza\'); for r:= 0 to rows-1 do begin for c:= 0 to cols-1 do write(mat[r,c]:4); writeln; end; end; {print2d} function RowSum( vec: array of integer; elems: integer): integer; { Сумма элементов в строке матрицы } var i: integer; sum: integer; begin sum:= 0; for i:= 0 to elems-1 do sum := sum + vec[i]; RowSum := sum; end; { RowSum } begin { main } input2d( mat ); print2d( mat ); writeln; for r:= 0 to rows-1 do if HasNegative( mat[r], cols ) then writeln( \'stroka \', r, \' summa = \', RowSum( mat[r], cols ) ); readln; end.

Ответ отправил: leonid59, 4-й класс
Ответ отправлен: 29.06.2009, 13:51

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

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

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

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

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

Здравствуйте, у меня пара вопросов, немогу решить. помогите пожалуйста

1) подчитать кол-во вводимого слова в тексте(текст находится в файле).

2) задача, дана шахматная доска. на ней некоторое кол-во черных и белых фигур. надо подсчитать скок возможно ходов у черных и у белых на данный момент. при этом расположение фигур должно не нарушать правилам
проблема в этом цикле
while (figures.cur <> nil) do begin
if (desk[figures.cur^.i, figures.cur^.j] = 'k') then inc(bk);
if (desk[figures.cur^.i, figures.cur^.j] = 'K') then inc(wk);
{ po analogii punkt 3 -- kol-vo ostalnyh figur }
end;
if (bk <> 1) or (wk <> 1) then begin
writeln('must be 1 white king and 1 black king');
halt;
end;
тут проверка на то чтоб королей было по одному.
и в этой же задаче надо написать функцию, которая проверяла бы чтоб при ходе данной фигуры не было поставленно шага королю, если п ри этом ходе король открывается, то ход не засчитывается. программа в прилождении

Отправлен: 29.06.2009, 01:49
Вопрос задал: Grishkin, Посетитель
Всего ответов: 2
Страница вопроса >>

Приложение:
program p169988; {Подсчитать количество вхождений слова в тексте(текст находится в файле).} var count : integer; {число вхождений} fH : text; fName : string[15]; len : integer; {длина слова} MyWord : string; {слово} p : integer; {текушая позиция найденного слова в строке, 0, если не найдено} s : string; {очередная строка файла} begin write( \'imya faila \' ); readln( fName ); assign( fH, fName ); reset( fH ); write( \'slovo \'); readln( MyWord ); len := length( MyWord ); count:= 0; while not eof( fH ) do begin readln(fH, s ); { если слово в строке найдено, начиная с позиции p, вырежем то, что слева от pos + само слово и продолжим поиск} p := pos( MyWord, s ); while p <> 0 do begin inc( count ); delete( s, 1, p+len-1); p := pos( MyWord, s ); end; end; close( fH ); writeln( \'Chislo vhogdenii slova "\', MyWord, \'" v fail "\', fName, \'"=\', count ); readln; end.

Ответ отправил: leonid59, 4-й класс
Ответ отправлен: 29.06.2009, 08:40

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

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

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

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

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

Приложение:
uses Crt; type tList=^tData;{данные об одной фигуре} tData=record Figure:char;{название} Color:char;{цвет} DirectFree:byte;{направление движения} Range:byte;{максимальное растояние хода} Step:byte;{} NoAttack:boolean;{флаг угрозы шаха для короля} NoProtect:boolean;{флаг запрета атаки королем} NumberStep:byte;{количество возможных ходов одной фигуры} end; tFigure=record{структура для чтения данных с файла} Figure,Color,x,y:Char;{название,Цвет,координаты} end; tDesk=array[1..8,1..8]of tList;{} var desk:tDesk; procedure NextStepDirection(f:char;z:integer;var x,y:integer); {процедура расчета направления движения f-название фигуры z-номер направления x-направление по Х y-направление по У} begin if f=\'H\' then{только для коня} begin x:=1+(z mod 2);{координата по Х} y:=3-x;{координата по У} z:=z div 2; x:=(1-2*(z mod 2))*x;{знак по Х} z:=z div 2; y:=(1-2*(z mod 2))*y;{знак по У} end else begin if z>3 then inc(z);{исключаем нулевое направление} x:=(z mod 3)-1;{напрваление по X} y:=(z div 3)-1;{направление по Y} end; end; function loadDesk(var a:tDesk):boolean; {процедура загрузки данных a-массив 8x8} var b:tFigure;{переменная для чтения из файла} c:tList;{динамическая структура} f:file of tFigure;{указатель на файл} x,y:integer;{} NoError:boolean; begin for x:=1 to 8 do for y:=1 to 8 do begin new(c); a[x,y]:=c; c^.Figure:=\' \';{название фигуры} c^.NumberStep:=0;{количество шагов} c^.Step:=0;{} c^.NoAttack:=true;{флаги угрозы королю} c^.NoProtect:=true;{флаг защиты фигуры} end; assign(f,\'chess.txt\');{открываем для чтения} reset(f); NoError:=true; while not eof(f) do{пока не кончится файл} begin read(f,b);{читаем один блок} b.Figure:=upCase(b.Figure);{приводим к одному регистру} b.Color:=upCase(b.color);{} if not((b.x in [\'1\'..\'8\'])and(b.y in [\'1\'..\'8\'])and{проверяем диапозон чисел} (b.Figure in [\'K\',\'Q\',\'H\',\'R\',\'B\',\'P\'])and(b.color in [\'W\',\'B\'])){проверяем допустимость букв} then NoError:=true;{выводим сообщение об ошибке} x:=ord(b.x)-ord(\'0\');{переводим символы в число} y:=ord(b.y)-ord(\'0\'); if a[x,y]^.Figure=\' \' then a[x,y]^.Figure:=b.Figure{записываем название фигуры} else NoError:=false; a[x,y]^.Color:=b.Color;{записываем цвет} case a[x,y]^.Figure of{определяем возможные направления} \'K\',\'H\',\'Q\':a[x,y]^.DirectFree:=255;{все направления} \'R\':a[x,y]^.DirectFree:=90;{вертикаль и горизонталь} \'B\':a[x,y]^.DirectFree:=165;{диагональ} \'P\':a[x,y]^.DirectFree:=16;{пешка} end; case a[x,y]^.Figure of{} \'K\',\'P\',\'H\':a[x,y]^.Range:=1;{пешка, король, конь} \'Q\',\'R\',\'B\':a[x,y]^.Range:=7;{ферзь, тура, слон} end; end; close(f); LoadDesk:=NoError; end; procedure RotateDesk(var a:tDesk); {процедура переворачивания доски a-массив данных 8x8} var b:tList; i,j:integer; begin for i:=1 to 4 do for j:=1 to 8 do begin b:=a[i,j]; a[i,j]:=a[9-i,j]; a[9-i,j]:=b; end; end; procedure CheckFigure(a:tDesk;b:char); {процедура подсчета ходов фигур, кроме короля a-массив данных 8x8 b-текущий цвет} var Curstep,CurAttack,CurX,CurY,dX,dY,indexBit,x,y,z:integer; CurDirect:byte; goCheck,inDesk:boolean; begin for x:=1 to 8 do for y:=1 to 8 do if (a[x,y]^.Color=b)and{только текущий цвет} (a[x,y]^.Figure<>\'K\')and{кроме короля} (a[x,y]^.Figure<>\' \')then{пустые клетки пропускаем} begin CurStep:=0;{текущие количество ходов} CurDirect:=a[x,y]^.DirectFree;{загружаем текущее направление} indexBit:=0;{счетчик бит} while CurDirect>0 do begin if odd(CurDirect) then begin NextStepDirection(a[x,y]^.Figure,indexBit,dX,dY);{считаем направление} goCheck:=true;{можно ещё проверять} CurAttack:=0;{указатель на атакуемую фигуру} for z:=1 to a[x,y]^.Range do begin CurX:=x+z*dX;{координаты проверяемого поля} CurY:=y+z*dY; inDesk:=(CurX>0)and(CurX<9)and{проверяем координаты на доске и нулевое приращение} (CurY>0)and(CurY<9)and ((dX<>0)or(dY<>0)); if inDesk then begin if goCheck then begin if a[x,y]^.Figure=\'P\' then CurAttack:=4 else CurAttack:=1; case b of {отмечаем битое поле для белых фигур} \'W\':a[CurX,CurY]^.Step:=a[CurX,CurY]^.Step or 1*CurAttack; {отмечаем битое поле для черных фигур} \'B\':a[CurX,CurY]^.Step:=a[CurX,CurY]^.Step or 2*CurAttack; end; CurAttack:=0; if a[CurX,CurY]^.Figure=\' \'then inc(CurStep){пустое поле увеличиваем счетчик} else begin goCheck:=false;{прекращаем поиск} if a[CurX,CurY]^.Color=b{если цвет совпадает} then a[CurX,CurY]^.NoProtect:=false{ставим флаг защиты} else CurAttack:=z;{цвет не совпадает, запоминаем растояние} end; end else if (CurAttack>0)and(a[x,y]^.Figure<>\' \') then{} if (a[CurX,CurY]^.Figure=\'K\')and(a[CurX,CurY]^.Color<>b){если король противоположного цвета} {помечаем как вожможность шаха, т.е. фигура не двигается} then a[x+CurAttack*dX,y+CurAttack*dY]^.NoAttack:=false else CurAttack:=0;{иначе сбрасываем счетчик} end; end; end; CurDirect:=CurDirect div 2;{переходим к следующему направлению и биту} inc(indexBit); end; if (a[x,y]^.Figure=\'P\') then{только для пешки} begin if (CurStep>0)and(a[x+2,y]^.Figure=\' \')and(x=2)then inc(CurStep);{пешка еще не двигалась} CurX:=x+1; dY:=1; repeat dY:=-dY; CurY:=y+dY; if(CurX>0)and(CurX<9)and (CurY>0)and(CurY<9)then begin {увеличиваем счетчик если там фигура противника} if(a[CurX,CurY]^.Figure<>\' \')and (a[CurX,CurY]^.Color<>b)then begin inc(CurStep); case b of \'W\':a[CurX,CurY]^.Step:=a[CurX,CurY]^.Step or 1;{помечаем поле для белых фигур} \'B\':a[CurX,CurY]^.Step:=a[CurX,CurY]^.Step or 2;{для черных} end; end; end; until dY>0; end; a[x,y]^.NumberStep:=CurStep;{записываем текущее количество ходов} end; end; procedure ShowDesk(a:tDesk;b:byte); const FigureWhite=15; FigureBlack=12; var bgDesk,bgStep:byte; x,y:integer; begin bgDesk:=7;{текущий цвет} for x:=1 to 8 do begin for y:=1 to 8 do begin if((a[x,y]^.Step and b)>0)or{учитываем ход фигуры} ((a[x,y]^.Step and 4*b)>0){учитываем ход пешки} then bgStep:=4 else bgStep:=0; TextBackground(bgDesk+bgStep);{устанавливаем фон} if a[x,y]^.Color=\'W\'{} then TextColor(FigureWhite) else TextColor(FigureBlack); write(a[x,y]^.Figure);{выводим фигуру} bgDesk:=bgDesk xor 7;{меняем цвет} end; writeln; bgDesk:=bgDesk xor 7;{меняем цвет} end; writeln; TextBackground(0); TextColor(7); end; function CheckStep(a:tDesk;b:char):integer; {процедура подсчета ходов} var CurStep,x,y:integer; begin CurStep:=0; for x:=1 to 8 do for y:=1 to 8 do begin if (a[x,y]^.Figure<>\' \')and{если фигура} (a[x,y]^.Color=b)and{если цвет совпадает} (a[x,y]^.NoAttack) then inc(CurStep,a[x,y]^.NumberStep);{и она может двигатся, суммируем} end; CheckStep:=CurStep; end; procedure CheckKing(a:tDesk); var x,y,CurX,CurY,dx,dy:integer; CurDirect,indexBit,CheckProtect:byte; begin for x:=1 to 8 do for y:=1 to 8 do if a[x,y]^.Figure=\'K\' then begin CurDirect:=a[x,y]^.DirectFree;{направление} indexBit:=0; case a[x,y]^.Color of{текущий цвет противника} \'W\':CheckProtect:=2; \'B\':CheckProtect:=1; end; while CurDirect>0 do begin NextStepDirection(a[x,y]^.Figure,indexBit,dX,dY);{считаем очередное направление} CurX:=x+dX;{изменяем координаты проверяемого хода} CurY:=y+dY; if(CurX>0)and(CurX<9)and(CurY>0)and(CurY<9)then begin if(a[CurX,CurY]^.Figure=\' \')and{проверяем пустое поле} ((a[CurX,CurY]^.Step and CheckProtect)=0)then begin inc(a[x,y]^.NumberStep); case a[x,y]^.Color of \'W\':a[CurX,CurY]^.Step:=a[CurX,CurY]^.Step or 1;{помечаем поле для белых фигур} \'B\':a[CurX,CurY]^.Step:=a[CurX,CurY]^.Step or 2;{для черных} end; end; if(a[CurX,CurY]^.Figure<>\' \')and{проверяем занятое поле} (a[x,y]^.Color<>a[CurX,CurY]^.Color)and{фигура противника} (a[CurX,CurY]^.NoProtect)then inc(a[x,y]^.NumberStep);{и она не защищена} end; CurDirect:=CurDirect div 2;{переходим к следующему напрвлению} inc(indexBit); end; end; end; function Control(a:tDesk;c:char):boolean; var q,r,p,h,k,b,n,x,y:integer; begin k:=0; q:=0; r:=0; b:=0; h:=0; p:=0; for x:=1 to 8 do for y:=1 to 8 do if a[x,y]^.Color=c then case a[x,y]^.Figure of \'K\':inc(k); \'Q\':inc(q); \'B\':inc(q); \'R\':inc(r); \'H\':inc(h); \'P\':inc(p); end; n:=k+p+q+b+r+h; Control:=(k=1)and(n<=16)and(p<=8)and(q<=9)and(r<=9)and(b<=9)and(h<=9); end; begin if LoadDesk(desk)and Control(desk,\'W\')and Control(desk,\'B\') then begin CheckFigure(desk,\'W\');{контролируем черные фигуры} RotateDesk(desk);{переворачиваем доску} CheckFigure(desk,\'B\');{контролируем белые фигуры} CheckKing(desk);{контролируем кооролей} writeln(\'White:=\',CheckStep(desk,\'W\'):5); ShowDesk(desk,1);{выводим доску и результаты} writeln(\'Black:=\',CheckStep(desk,\'B\'):5); ShowDesk(desk,2);{выводим доску и результаты} end else writeln(\'wrong data\'); ReadKey; end. Украина, Киев
Тел.: +38-097-953-66-19
Адрес: Украина, Киев

-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

Ответ отправил: Зенченко Константин Николаевич, Модератор
Ответ отправлен: 03.07.2009, 22:34

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

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

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

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

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