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

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

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

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

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

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

Вопрос № 175648: Доброй ночи. Необходима помощь в решении задачки. В одномерном массиве, состоящем из N вещественных элементов вычислить: Сумму элементов массива с нечетными номерами. Сумму элементов массива, расположенных между первым и последним отрицател...

Доброй ночи. Необходима помощь в решении задачки.
В одномерном массиве, состоящем из N вещественных элементов вычислить:
Сумму элементов массива с нечетными номерами.
Сумму элементов массива, расположенных между первым и последним отрицательным элементом.
Сжать массив,удалив из него все элементы, модуль которых не превышает единицу.Освободившиеся в конце массива элементы заполнить нулями.

Отправлен: 27.12.2009, 06:31
Вопрос задал: Александр Белов, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; const nmax=100;{максимальный размер массива} var a:array[1..nmax] of real;{тип массива} n,i,i1,ip,j,k:byte;{размер, индексы, счетчики циклов} s:real;{суммы} begin clrscr; randomize; repeat{в цикле вводим размер} write(\'Размер массива от 1 до \',nmax,\' n=\'); readln(n); until n in [1..100];{пока он не будет в диапазоне} writeln(\'Исходный массив:\'); for i:=1 to n do begin a[i]:=3*random-1;{вещественные числа от -1 до 2} write(a[i]:6:2); end; writeln; writeln; s:=0; for i:=1 to n do if i mod 2<>0 then s:=s+a[i];{считаем сумму на нечетных местах} writeln(\'Сумма элементов с нечетными номерами=\',s:0:2); writeln(\'Сумма элементов между первым и последним отрицательными элементами:\'); i1:=0;{индекс первого отрицательного} for i:=1 to n do{идем с начала массива} if a[i]<0 then{нашли отрицательный} begin i1:=i;{запомнили индекс} break;{дальше не ищем} end; ip:=0;{индекс последнего отрицательного} for i:=n downto 1 do{идем с конца массива} if a[i]<0 then{нашли отрицательный} begin ip:=i;{запомнили индекс} break;{дальше не ищем} end; if i1=0 then writeln(\'В массиве нет отрицательных элементов! \') else if i1=ip then writeln(\'В массиве только один отрицательный элемент!\') else if ip-i1=0 then writeln(\'Между отрицательными нет элементов!\') else begin s:=0; for i:=i1+1 to ip-1 do{считаем сумму между первым и последним отрицательными} s:=s+a[i];{} writeln(\'Сумма=\',s:0:2); end; writeln(\'Массив после сжатия:\'); k:=0;{количество удалений} i:=1;{начало массива} while i<=n do{пока не конец массива} if abs(a[i])<1 then{если модуль меньше 1} begin k:=k+1;{считаем} for j:=i to n-1 do{сдвигаем хвост масива к этому элементу} a[j]:=a[j+1];{на 1 позицию} n:=n-1;{уменьшаем размер масива} end else i:=i+1;{если больше 1, пропускаем} if k=0 then write(\'Элементов меньших 1 по модулю нет!\') else begin for i:=n+1 to n+k do a[i]:=0;{добавляем в конец массива к нолей} for i:=1 to n+k do{выводим массив} write(a[i]:6:2); end; readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 27.12.2009, 09:50

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

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

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

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

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

нужно решить
Дано натуральное число N. Определить длину периода 1/n. Период дроби равен периоду в последовательности остатков. Построить график зависимости периода от N.

Отправлен: 27.12.2009, 15:34
Вопрос задал: Benqq, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
var N,i,j:byte; r:integer; a:integer; ost:array[0..255] of byte; begin readln(N); r:=10; write(\'0.\'); while r<N do begin r:=r*10; write(\'0\'); end; i:=0; repeat inc(i); write(r div N); r:=r mod N; ost[i]:=r; r:=r*10; j:=1; while (ost[j]<>ost[i]) do inc(j); until j<i; writeln; writeln(i-j); readln; end.

Ответ отправил: Сергей Бендер, 3-й класс
Ответ отправлен: 28.12.2009, 18:26

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

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

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

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

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

Добрый День Буду очень признательна за помощь в решение данного задания :)))
Предприятие имеет местную телефонную станцию на 20 номеров. Телефонный справочник данного предприятия для каждого номера телефона содержит номер помещения и список служащих, сидящих в данном помещении.
Составить программу, которая:
Корректирует базу;
По номеру телефона выдает номер помещения и список сидящих в нем людей;
По номеру помещения выдает номер телефона;
По фамилии выдает номер телефона и номер помещения.
Номер телефона-двузначный. В одном помещении может находиться от одного до четырех служащих.

Отправлен: 27.12.2009, 17:46
Вопрос задал: BlackCanary, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{ Предприятие имеет местную телефонную станцию на 20 номеров. Телефонный справочник данного предприятия для каждого номера телефона содержит номер помещения и список служащих, сидящих в данном помещении. Составить программу, которая: Корректирует базу; По номеру телефона выдает номер помещения и список сидящих в нем людей; По номеру помещения выдает номер телефона; По фамилии выдает номер телефона и номер помещения. Номер телефона-двузначный. В одном помещении может находиться от одного до четырех служащих. } program p175664; uses crt; const MaxRoom = 20; MinPhone = \'01\'; MaxPhone = \'99\'; MaxCapacity = 4; Type TRecNo = LongInt; TRoomNo = 1..MaxRoom; TPhone = string[2]; TPerson = string[10]; TPersons = array[1..MaxCapacity] of TPerson; TRoom = record RoomNo: TRoomNo; phone: TPhone; persons: TPersons; end; TFunc = function(rec, etalon: TRoom): boolean; TRoomFile = file of TRoom; var iChoice : integer; fH: TRoomFile; IsOpen: boolean; SearchFunc : TFunc; etalon, FoundRoom: TRoom; FoundRec: TRecNo; i, j: integer; procedure Create( var fH: TRoomFile ); forward; { Создание файла } procedure Input( var fH: TRoomFile ); forward; { Ввод данных } procedure Menu; forward; procedure Open( var fH: TRoomFile ); forward; { Открытие файла } procedure Print( var fH: TRoomFile ); forward; { Вывод данных } procedure SayGoodBye; forward; { Выход } function Search( var fH: TRoomFile; f: TFunc; etalon: TRoom; var r: TRoom ): TRecno; forward; { Поиск по условию } {$F+} function SearchName( rec, etalon: TRoom ): boolean; forward; { Поиск по фамилии } {$F-} {$F+} function SearchPhone( rec, etalon: TRoom ): boolean; forward; { Поиск по номеру телефона } {$F-} procedure Create( var fH: TRoomFile ); var fName: string; { имя файла } begin { если открыт, закроем } if IsOpen then begin Close( fH ); IsOpen := false; end; write(\'Полный путь к файлу :\'); readln(fName); {$I-} Assign(fH, fName); Rewrite(fH); {$I+} if (IOResult <> 0) then Writeln(\'Файл уже существует\') else begin IsOpen := true; Writeln(\'Файл успешно создан\'); end; readln; end; { Create } procedure Input( var fH: TRoomFile ); var r: TRoom; count: integer; i: integer; begin write(\'Комната: \'); readln(r.RoomNo); write(\'Телефон: \'); readln(r.phone); for i:= 1 to MaxCapacity do begin write(\'ФИО: \'); readln(r.persons[i]); end; seek( fH, FileSize( fH ) ); write( fH, r ); readln; end; { Input } procedure Menu; begin clrscr; Writeln( \' 0: Выход\' ); Writeln( \' 1: Создание файла\' ); { Создание файла } Writeln( \' 2: Открытие файла\' ); { Открытие файла } Writeln( \' 3: Ввод данных\' ); { Ввод данных } Writeln( \' 4: Печать файла\' ); { Вывод данных } Writeln( \' 5: Поиск по номеру телефона\' ); { Поиск по номеру телефона } Writeln( \' 6: Поиск по фамилии\' ); { Поиск по фамилии } Write( \' Выбран пункт:\'); end; { Menu } procedure Open( var fH: TRoomFile ); { Открытие файла } var fName: string; { имя файла } begin { если открыт, закроем } if IsOpen then begin Close( fH ); IsOpen := false; end; write(\'Полный путь к файлу:\'); readln(fName); {$I-} Assign(fH, fName); Reset(fH); {$I+} if ((IOResult <> 0) or (fName = \'\')) then Writeln(\'Файл не существует\') else begin IsOpen := true; Writeln(\'Файл успешно создан\'); end; readln; end; { Open } procedure Print( var fH: TRoomFile ); { Вывод данных } var r: TRoom; i: integer; { счетчик записей } j: integer; { счетчик сотрудников } begin write( \'----------------\'); for j:= 1 to MaxCapacity do write( \'-------------\'); writeln; write( \'Комната Телефон\' ); for j:= 1 to MaxCapacity do write( \' Сотрудник \', j, \' \'); writeln; write( \'-----------------\'); for j:= 1 to MaxCapacity do write( \'-------------\'); writeln; seek(fH, 0); i := 0; while not( eof( fH ) ) do begin read( fH, r ); inc( i ); write( r.RoomNo:7, r.Phone:7); for j:= 1 to MaxCapacity do write( r.persons[j]: 13); writeln; if i mod 10 = 0 then readln; { 10 в списке } end; { while } readln; end; { Print } procedure SayGoodBye; { Выход } begin writeln( \'Удачи!\' ); readln; end; { SayGoodBye } function Search( var fH: TRoomFile; f: TFunc; etalon: Troom; var r: TRoom): TRecno; { Поиск } var rec: TRoom; i: LongInt; found : boolean; begin seek(fH, 0); i:= 0; found := false; while not (eof(fH)) and (not(found)) do begin read(fH, rec); if f(rec, etalon) then found := true; inc(i); end; if found then begin r := rec; search := i-1; end else search := -1; end; { Search } {$F+} function SearchName( rec, etalon: TRoom ): boolean; var i: 0..MaxCapacity; found : boolean; begin i:= 0; found := false; while (i<= MaxCapacity) and not(found) do begin inc(i); if rec.persons[i]=etalon.persons[1] then found := true; end; SearchName := found; end; { SearchName } {$F-} {$F+} function SearchPhone( rec, etalon: TRoom ): boolean; begin SearchPhone := rec.phone=etalon.phone; end; { SearchPhone } {$F-} begin { Main } iChoice := 0; IsOpen := false; while true do begin Menu; Readln( iChoice ); case iChoice of 0: begin if IsOpen then Close( fH ); SayGoodBye; exit end; 1: Create( fH ); { Создание файла } 2: Open( fH ); { Открытие файла } 3: Input( fH ); { Ввод данных } 4: Print( fH ); { Вывод данных } 5: begin etalon.phone := \'99\'; write(\'Телефон: \'); readln(etalon.phone); if (etalon.phone>\'00\') and (etalon.phone<\'99\') then begin FoundRec := Search( fH, SearchPhone, etalon, FoundRoom); if FoundRec <> -1 then begin write(\'Комната: \', FoundRoom.RoomNo); for j:= 1 to MaxCapacity do write(FoundRoom.persons[j], \';\'); writeln; end else writeln(\'Телефон не найден\'); end else writeln(\'Неверный формат номера\'); readln; end; 6: begin etalon.persons[1] := \'$\'; write(\'ФИО :\'); readln(etalon.persons[1]); if etalon.persons[1]<>\'$\' then begin FoundRec := Search( fH, SearchName, etalon, FoundRoom); if FoundRec <> -1 then writeln(\'Комната: \', FoundRoom.RoomNo, \' Телефон: \', FoundRoom.Phone) else writeln(\'Сотрудник не найден\'); end else writeln(\'Неверный формат фамилии\'); readln; end; end; { case } end; { while } end.

Ответ отправил: lamed, Практикант
Ответ отправлен: 01.01.2010, 15:29

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

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

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

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

Помогите пожалуйста.

Дан двухмерный массив B (12,12) тип вещественный. Сформировать массив С из положительных элементов главной диагонали массива B. Вывести полученный результат.

Отправлен: 27.12.2009, 18:31
Вопрос задал: rutra, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; const n=12; var b:array[1..n,1..n] of real; c:array[1..n] of real; k,i,j:byte; begin clrscr; randomize; writeln(\'Массив В:\'); k:=0; for i:=1 to n do begin for j:=1 to n do begin b[i,j]:=10*random-4; if (i=j)and(b[i,j]>0) then{если это главная диагональ и элемент положительный} begin k:=k+1;{считаем} c[k]:=b[i,j];{записываем в массив С} textcolor(12);{выделим ярко-красным цветом} write(b[i,j]:5:1); end else{остальные элементы} begin textcolor(15);{белым, это у меня по умолчанию, напишите свой} write(b[i,j]:5:1); end; end; writeln; end; textcolor(15);{восстановим цвет шрифта} if k=0 then write(\'На главной диагонали нет положительных элементов!\') else begin writeln(\'Массив С:\'); for i:=1 to k do write(c[i]:5:1); end; readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 27.12.2009, 19:58

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

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

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

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

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

Добрый вечер. Понадобилась помощь с задачей.Суть ее такова.
Описать запись с именем Price содержащую поля:
-название товара
-название магазина, в котором продается товар
-стоимость товара в рублях
Написать программу,выполняющую следующие действия:
-ввод данных с клавиатуры в массив,состоящий из восьми элементов типа Price;записи должны быть размещены в алфавитном порядке по названиям товаров
-вывод на экран информации о товаре,название которого введено с клавиатуры;если таких товаров нет, вывести на экран соответствующее сообщение
-запись массива в файл под заданным с клавиатуры именем

Отправлен: 27.12.2009, 21:24
Вопрос задал: Александр Белов, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; const n=8;{количество записей} type price=record{тип запись товар} tov,mgz:string[20];{названия товара и магазина} stm:word;{стоимость} end; var z:array[1..n] of price;{массив записей} x:price;{переменная для считывания и сортировки записей} i,j,k:byte;{счетчики, фиксатор} t:string[20];{переменная для ввода названия товара} f:file of price;{типизированный файл записей} name:string;{переменная для имени файла} begin clrscr; writeln(\'Введите данные о \',n,\' товарах:\'); for i:=1 to n do with z[i] do{пока очередная запись} begin writeln(\'Товар \',i); write(\' Название товара: \');readln(tov); write(\' Название магазина: \');readln(mgz); write(\' Стоимость: \');readln(stm); end; clrscr; for i:=1 to n-1 do{отсортируем записи} for j:=i+1 to n do if z[i].tov>z[j].tov then{по алфавиту(возрастанию) названий товаров} begin x:=z[i]; z[i]:=z[j]; z[j]:=x; end; write(\'Введите название товара для поиска:\'); readln(t); k:=0; for i:=1 to n do if z[i].tov=t then{если поле записи товар совпало с введенным} begin k:=1; writeln(z[i].tov,\' \',z[i].mgz,\' \',z[i].stm);{выводим все поля записи} end; if k=0 then writeln(\'Такого товара нет!\'); write(\'Press Enter...\'); readln; clrscr; write(\'Введите имя файла для записи:\'); readln(name); assign(f,name);{связываем переменную с файлом на диске} rewrite(f);{открываем файл для записи} for i:=1 to n do{по размеру массива} write(f,z[i]);{заносим его элементы в файл записей} writeln(\'Содержание файла:\'); reset(f);{откроем файл для чтения} while not eof(f) do{пока не конец файла} begin read(f,x);{читаем записи в переменную} writeln(x.tov,\' \',x.mgz,\' \',x.stm);{выводим на экран поля записи} end; close(f);{закрываем файл} write(\'Press Enter...\'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 29.12.2009, 08:55

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

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

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

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

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

Отправлен: 27.12.2009, 21:33
Вопрос задал: BlackCanary, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; const nmax=100;{максимальный размер массива} var x:array[1..nmax] of integer;{тип массива} n,i,imx,i1,i2,k,j:byte;{размер, разные счетчики и индексы} b:integer;{буфер для обмена элементов} p:longint;{произведение} begin clrscr;{очищаем экран} randomize;{генерация псевдо случайных чисел} repeat{в цикле с проверкой вводим размер массива} write(\'Размер массива от 1 до \',nmax,\' n=\'); readln(n); until n in [1..nmax];{если в диапазоне, заканчиваем} writeln(\'Введите \',n,\' элементов массива:\'); for i:=1 to n do begin write(\'x[\',i,\']=\');{вводим элементы массива} readln(x[i]); end; clrscr;{очищаем экран от ввода} writeln(\'Массив Х:\');{выводим массив в строку} for i:=1 to n do write(x[i],\' \'); writeln; writeln; imx:=1;{номер максимального, пока=1} for i:=1 to n do if x[i]>x[imx] then imx:=i;{нашли самый большой, запомнили его номер} writeln(\'Номер максимального элемента=\',imx); i1:=0;{ищем первый ноль} for i:=1 to n do if x[i]=0 then{нашли} begin i1:=i;{запомнили индекс} break;{дальше не ищем} end; if i1=0 then writeln(\'В массиве нет нулевых элементов!\') else if i1=n then writeln(\'В массиве один нулевой элемент!\') else begin i2:=0;{ищем второй ноль} for i:=i1+1 to n do{дальше за первым, все так же} if x[i]=0 then begin i2:=i; break; end; if i2=0 then writeln(\'В массиве только один нулевой элемент!\') else if i2-i1=1 then writeln(\'Между нулевыми нет элементов!\') else begin p:=1;{произведение, пока=1} for i:=i1+1 to i2-1 do{между нолями считаем произведение} p:=p*x[i]; writeln(\'Произведение между первым и вторым нулевыми элементами=\',p); end; end; writeln(\'Массив Х после перестановки элементов:\'); k:=0;{количество перестановок элементов, пока=0} for i:=1 to n do if i mod 2=1 then{если индекс нечетный} begin k:=k+1;{считаем} b:=x[i];{запоминаем число} for j:=i downto k+1 do{сдвигаем к нему начало массива} x[j]:=x[j-1];{на позицию} x[k]:=b;{на освободившееся место вставляем число} end; for i:=1 to n do write(x[i],\' \'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 28.12.2009, 13:46

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

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

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

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

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

Еще раз добрый вечер. Возникли трудности с программированием блок схемы в паскаль. Блок схема изображена на картинке

Отправлен: 27.12.2009, 22:01
Вопрос задал: Александр Белов, Посетитель
Всего ответов: 3
Страница вопроса »

Приложение:
uses crt; const n=10; {колличество эллементов массива} var X:array [1..n] of integer; k,i:integer; begin clrscr; {чистим экран} randomize; {Задаем массив случайным образом} for i:=1 to n do X[i]:=random(5); {вывод массива на экран для проверки} for i:=1 to n do write(X[i],\' \'); writeln; {собственно сама блок схема} k:=0; i:=1; while i<=n do begin if X[i]=0 then k:=k+1; i:=i+1; end; writeln(\'k=\',k); readln; end.

Ответ отправил: Ковалев Никита Викторович, 2-й класс
Ответ отправлен: 27.12.2009, 22:18

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

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

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

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

Отвечает Geass, 1-й класс :
Здравствуйте, Александр Белов!
Данная программа определяет кол-во нулевых элементов в массиве

Приложение:
uses crt; type mass=array[1..1000] of real; var a:mass; i,k,n:integer; begin clrscr; read(n); randomize; for i:=1 to n do a[i]:=random(10); k:=0; for i:=1 to n do if a[i]=0 then k:=k+1; writeln(k); end.

Ответ отправил: Geass, 1-й класс
Ответ отправлен: 27.12.2009, 22:21

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

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

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

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

Отвечает Тесля Дмитрий Владимирович, 1-й класс :
Здравствуйте, Александр Белов.
Данная программа подсчитывает количество нулевых элементов массива:

Program pv175681;
Const
N=5;
X: array [1..N] of real=(1,0,-5,0,2);
Var
i,k: integer;
Begin
k:=0;
i:=1;
While i<=N do
begin
if X[i]=0 then k:=k+1;
i:=i+1;
end;
WriteLn('K=',k);
End.

Ответ отправил: Тесля Дмитрий Владимирович, 1-й класс
Ответ отправлен: 28.12.2009, 15:43

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

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

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

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

Добрый вечер,уважаемые эксперты!!!!Помогите пожалуйста проверить,правильно ли написана прога????
файл здесь: http://depositfiles.com/files/oeexstyen
Сделал примеры в одной проге
Жду ответа

Отправлен: 28.12.2009, 00:46
Вопрос задал: angel.nero, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
[code] x=abs(x); for k:=1 to n do Begin k2:=k2/2; xk:=xk*x; kf:=kf/k; y1:=y1+1/sqr(k); y2:=y2+kf; y3:=y3+(kf+sqrt(xk)); y4:=y4+(x+cos(x))*k2; y5:=y5+(sqr(xk)*sin(xk))/sqr(k); end; [/code]

Ответ отправил: Vadim22, 5-й класс
Ответ отправлен: 28.12.2009, 01:14

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

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

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

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

Отвечает lamed, Практикант :
Здравствуйте, angel.nero. Окончательный вариант в приложении. С учетом Вашего сообщения в мини-форуме, изменение незначительное
x^(2*k)=(x^k)^2=xk^2,
тогда y5:=y5+(sqr(xk)*sin(xk))/sqr(k);

Приложение:
program p175683; var y1,y2,y3,y4,y5,x,xk,k2,kf:real; k,n:integer; Begin write(\'n=\'); readln(n); write(\'x=\'); readln(x); y1:=0; y2:=0; y3:=0; y4:=0; y5:=0; kf:=1; xk:=1; k2:=1; for k:=1 to n do Begin k2:=k2/2; xk:=xk*x; kf:=kf/k; y1:=y1+1/sqr(k); y2:=y2+kf; y3:=y3+(kf+sqrt(abs(xk))); y4:=y4+(x+cos(x))*k2; y5:=y5+(sqr(xk)*sin(xk))/sqr(k); end; writeln(\'y1=\',y1:0:4); writeln(\'y2=\',y2:0:4); writeln(\'y3=\',y3:0:4); writeln(\'y4=\',y4:0:4); writeln(\'y5=\',y5:0:4); readln; end.

Ответ отправил: lamed, Практикант
Ответ отправлен: 30.12.2009, 09:00

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

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

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

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

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

Здравствуйте,помогите пожалуйста с 2-мя задачками:
1) Для заданного целого положительного числа получить число с обратным порядком следования чётных цифр числа. Например, если число – 12587, то полученное число – 82. Если число не содержит чётных цифр, выдать об этом сообщение
2) Заменить в целом числе каждую цифру с1 на цифру с2. Если число не содержит цифр с1, выдать об этом сообщение

Отправлен: 28.12.2009, 01:16
Вопрос задал: angel.nero, Посетитель
Всего ответов: 2
Страница вопроса »

uses crt; {подключаем модуль для работы с функциями clrscr и readkey}
{объявляем переменные}
var
    Numb, Err : Integer; {наше число и переменная индикации ошибки}
    I,
J, Dig : Byte;        {счётчики и цифра}
         StrN : String[5]; {cтрока нашего числа}
       Buffer : String[5]; {буфер}
         StrD : String[1]; {строка нашей цифры}
         Flag : Boolean;   {флаг ошибки}
BEGIN
clrscr; {функция очистки экрана}

 Write(' Введите целое число(не больше 32767): ');
  Read(Numb); {вводим}
 Writeln(' Введенное число: ',Numb);

 Str(Numb, StrN); {переводим число в строку и записываем в 
 StrN}

 J := 1; {инициализируем J}

 {цикл по I от конца к началу}
 For I := Length(StrN) DownTo 1 do
  begin
     Val(StrN[I], Dig, Err); {переводим конкретный эл. массива(строки) в цифру}
                                      {переменная Err здесь нужна только для работы функции
                                      {а так используется для индикации ошибки}
      if (Dig MOD 2) = 0     {каждую полученную цифру проверяем на чётность} 
       then begin
              Flag
:= True;    {активируем флаг, если есть чётные}

              Str(Dig, StrD);   {переводим цифру(чётную) в строку и сохраняем в StrD}
              Insert(StrD, Buffer, J); {вставляем эту строку в буфер начиная с J-позиции}
              Inc(J); {увеличиваем J на единицу}
            end;
  end;

  Val(Buffer, Numb, Err); {переводим буфер в число и записываем это значение в Numb}

  If (Flag) then Write(' Четные цифры числа в обратном по
 рядке ',Numb) {выводим если есть чётные}
   else Write(' Число не содержит четных цифр!'); {если нет, получаем ошибку}
readkey; {ожидание нажатия клавиши}
END.

Ответ отправил: Мироненко Николай Николаевич, Студент
Ответ отправлен: 29.12.2009, 18:36

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

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

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

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

Отвечает Пупорев Юрий Борисович, Специалист :
Здравствуйте, angel.nero!
Решения задач в приложении.

Приложение:
№1. uses crt; var m,s:longint; i:byte; begin clrscr; write(\'m=\'); readln(m); s:=0; while m>0 do{пока число не ноль} begin i:=m mod 10;{отделяем с конца цифры} if i mod 2=0 then s:=s*10+i;{если четная, умножаем полученоое число на 10 и прибавляем эту цифру} m:=m div 10;{беоем число без последней цифры и все повторяем} end; write(\'rezult = \',s); readln end. №2. uses crt; var m,s,k:longint; i,c1,c2:integer; begin clrscr; write(\'m=\'); readln(m); repeat write(\'Какую цифру заменить? c1=\'); readln(c1); until c1 in [0..9]; repeat write(\'На какую цифру заменить? c2=\'); readln(c2); until c1 in [0..9]; s:=0;k:=1;{новое число и коэффициент-степень числа 10} while m>0 do begin i:=m mod 10; if i=c1 then i:=c2;{если заданная цифра, меняем} s:=s+i*k;{умножаем ее на степень числа 10 и прибавляем то, что уже было} m:=m div 10; k:=k*10;{увеличиваем степень} end; write(\'rezult = \',s); readln end.

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

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

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

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

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

Уважаемые эксперты!Прошу Вас помочь мне решить задачу(если можно,то с объснением).Заранее благодарна!
Дан файл(содержание на ваш выбор),содержащий текст на русском языке.Выяснить,входит ли данное слово в указанный текст,и если да,то сколько раз

Отправлен: 28.12.2009, 01:16
Вопрос задал: Масленникова Валерия, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
Исходный файл: ЙЦУКЕ орывиорысв ылворсп ЙЦУКЕ ылмор оыврсп ыоур ЙЦУКЕ оырвЙЦУКЕпаоцвр ылво оырвп оырвмс оывмрп ыволмп ыло ы влром ЙЦУКЕ ЙЦУКЕ рпваыоЙЦУКЕ Программа: var f:text; s,w:string; i,j,ls,lw:integer; begin readln(w); {Читается слово} assign(f,\'data.txt\'); reset(f); i:=0; {Открыть файл данных и читать до конца} while not eof(f) do begin readln(f,s); { Прочитывается строка s } j:=pos(w,s); {Ищется слова в строке} while j>0 do { Если найденная позиция ненулева (слово найдено) } begin ls:=length(s); lw:=length(w); if ((j=1) or ((j>1) and (s[j-1]=\' \'))) {Проверка на то, чтобы перед словом был пробел или оно стояло в начале строки, ...} and ((j+lw-1=ls) or ((j+lw-1<ls) and (s[j+lw]=\' \'))) {... и чтобы после него был пробел или слово стояло в конце строки} then inc(i); delete(s,j,length(w)); j:=pos(w,s); {Удаляется найденное и ищется следующее} end; end; close(f); writeln(i); readln; end.

Ответ отправил: Сергей Бендер, 3-й класс
Ответ отправлен: 28.12.2009, 19:24

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

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

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

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

Ещё раз добрый вечер!Уважаемые эксперты,прошу вашей помощи!
такое задание:
6 Исследовать систему: ax+by=c
dx+ey=f
1)на существование единственного решения
2)Проверить, являются ли заданные значения x и y решением системы двух линейных уравнений с двумя неизвестными
3)Проверить, имеет ли система единственное решение, или имеет множество решений или не имеет решений

Отправлен: 28.12.2009, 02:16
Вопрос задал: angel.nero, Посетитель
Всего ответов: 1
Страница вопроса »

Решение системы уравнений
   ax + by = c
   dx + ey = f
Введите значение коэффициента a: 2
Введите
значение коэффициента b: -
Ошибка ввода
Введите значение коэффициента b: -3
Введите значение коэффициента c: 7
Введите значение коэффициента d: 6
Введите значение коэффициента e: -9
Введите значение коэффициента f: 12
Решается система уравнений:
      2.000000x +  -3.000000y =   7.000000
      6.000000x +  -9.000000y =  12.000000

Введите Ваш вариант решения
  Значение x:  1
  Значение y:  2
Значения x =   1.000000 и y =   2
 .000000
 не являются решениями системы уравнений
Количество решений:
   нет решения

Приложение:
TYPE solutions = (sSingle, sMultiple, sNone); {Функция для получения вещественного числа - с проверкой правильности} function GetReal(msg: String): Real; var r: Real; code: Integer; begin repeat Write(msg,\' \'); {$I-} ReadLn(r); {$I+} code := IOResult; if code <> 0 then WriteLn(\'Ошибка ввода\'); until code = 0; GetReal := r end; {Функция для проверки решения} function TestSolution(a, b, c, d, e, f, x, y: Real): Boolean; begin TestSolution := (a*x + b*y = c) and (d*x + e*y = f); end; {Функция для определения числа решений Находим по правилу Крамера http://www.bymath.net/studyguide/alg/sec/alg15.html} function SolutionCount(a, b, c, d, e, f: Real): solutions; var DET: Real; begin DET := (a*e - b*d); if DET <> 0 then SolutionCount := sSingle else begin SolutionCount := sMultiple; {Но именно здесь может получиться, что нет решений. Проблема усложняется тем, что какие-то коэффициенты могту быть равны 0} if (a*f <> c*d) or (b*f <> c*e) then {так записываю отношения, чтобы избежать деления на ноль} SolutionCount := sNone end; end; VAR a, b, c, d, e, f: Real; x, y: Real; BEGIN WriteLn(\'Решение системы уравнений\'); WriteLn(\' ax + by = c\'); WriteLn(\' dx + ey = f\'); a := GetReal(\'Введите значение коэффициента a:\'); b := GetReal(\'Введите значение коэффициента b:\'); c := GetReal(\'Введите значение коэффициента c:\'); d := GetReal(\'Введите значение коэффициента d:\'); e := GetReal(\'Введите значение коэффициента e:\'); f := GetReal(\'Введите значение коэффициента f:\'); WriteLn(\'Решается система уравнений:\'); WriteLn(\' \',a:10:6,\'x + \',b:10:6,\'y = \',c:10:6); WriteLn(\' \',d:10:6,\'x + \',e:10:6,\'y = \',f:10:6); WriteLn; WriteLn(\'Введите Ваш вариант решения\'); x := GetReal(\' Значение x: \'); y := GetReal(\' Значение y: \'); WriteLn(\'Значения x = \',x:10:6,\' и y = \',y:10:6); if NOT TestSolution(a, b, c, d, e, f, x, y) then Write(\' не\'); WriteLn(\' являются решениями системы уравнений\'); WriteLn(\'Количество решений: \'); Case SolutionCount(a, b, c, d, e, f) of sSingle : WriteLn(\' единственное\'); sMultiple: WriteLn(\' множество решений\'); sNone : WriteLn(\' нет решения\'); end; END. Прикрепленный файл: загрузить »

-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 28.12.2009, 14:51

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

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

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

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

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

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