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

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

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

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

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

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

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

Выпуск № 740
от 29.11.2008, 07:05

Вопрос № 151507: Помогите решить задачу: Задана последовательность из N вещественных чисел. Вычислить корень квадратный из ((XI-M)*(XI-M)/(N-1)), где M - среднее fhbavtnbxtcrjt данной последовательности. Заранее спасибо!!!...

Вопрос № 151.507

Помогите решить задачу: Задана последовательность из N вещественных чисел. Вычислить корень квадратный из ((XI-M)*(XI-M)/(N-1)), где M - среднее fhbavtnbxtcrjt данной последовательности. Заранее спасибо!!!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Lilcrazy! Решение задачи в приложении. Приложение: uses crt; const n=10; {размер массива} var x:array[1..n] of real;{тип массива} i:integer; m:real; begin clrscr; randomize; m:=0; writeln('Ishodnyj massiv:'); for i:=1 to n do begin x[i]:=10*random; {заполняем массив случайными вещественными числами из инт.(0,9)} m:=m+x[i]; {суммируем} write(x[i]:5:2); end; writeln; m:=m/n; {считаем среднее} writeln('Sr.arifmeticheskoe=',m:0:2); writeln('Rezultat:'); for i:=1 to n do begin x[i]:=sqrt(sqr(x[i]-m)/(n-1));{составляем новый массив по формуле} write(x[i]:5:2); end; readln end.

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

Вопрос № 151.510

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

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

Отвечает: SHERRY Здравствуйте, Судейкин Андрей Владимирович! Для выполнения задачи, создадим свой тип TKubik, в котором опишем нужные параметры. А также нам потребуется типизированный файл, для хранения считываемых данных. Код: type TKubik = record {имя_типа = запись} razm: integer; {размер кубика} color: string[20]; {цвет} mater: string[20]; {материал} end; var toy: TKubik; {переменная, в которой будут храниться данные об одном кубике} f: file of TKubik; {типизированный файл для храниния информации типа TKubik} ch: char; {вспомогательная символьная переменная} count, count_2, i: integer; {счётчики} begin ch := '-'; {инициализация переменной} assign(f, 'input.bin'); {зададим файл овой переменной физичиский файл на диске} if FileExists('input.bin') then {если наш файл существует, то} begin Repeat {поинтересуемся у пользователя: возможно он захочет использовать существующий файл?} write('File `input.bin` is already exists. Do you want to use it? (Y/N) '); readln(ch); {ответом должен служить символ Y или N (соотв. "да" или "нет")} Until (ch = 'Y') or (ch = 'N'); if ch = 'Y' then Reset(f); {если будем использовать существующий файл, то откроем его для чтения} end; writeln; {пропустим строку на экране} if (ch = 'N') or (ch = '-') then {если же пользователь возжелал создать новый файл с данными} {или же файла, не существовало вовсе, то} begin Rewrite(f); {создадим файл (пока что он пустой)} writeln('Vvesti dannie o kubikah (0 - konec)'); While true do {запуск аем бесконечный цикл, в котором} begin write('input size: '); readln(toy.razm); {считываем размер кубика} if toy.razm = 0 then break; {если размер равен нулю, то прекратим здесь сбор данных} write('input mater: '); readln(toy.mater); {считываем информацию о материале} write('input color: '); readln(toy.color); {и цвете} write(f, toy); writeln('OK'); {если данные записаны в файл, то на экран выведется сообщение OK} end; {по окончании ввода данных} Close(f); {закроем файл} Reset(f); {и откроем его с возможностью считывания данных} end; writeln; {пропустим строку на экране} count := 0; count_2 := 0; {обнулим счётчики} {данные о каждом кубике находятся на своих позициях и нумеруются с нуля} {количество таких позиций возвращает функция FileSize()} {последняя позиция содержит размер файла, поэтому её мы использовать не будем} for i:=0 to FileSize(f)-1 do begin seek(f, i); {помещаем "указатель" в файле f на позицию i} read(f, toy); {считываем данные из файла в переменную toy} writeln(toy.razm, ' ', toy.mater, ' ', toy.color); {выводим считанные данные на экран} if (toy.mater = 'wood') and (toy.razm = 3) {обрабатываем первое условие} then inc(count); {если условие удовлетворено, то счётчик увеличим на единичку} if (toy.mater = 'metal') and (toy.razm > 5) {аналогично со вторым условием} then inc(count_2); end; writeln; {выведем на экран значения счётчиков} writeln(count, count_2:5); readln; {по окончании работы, файл закроем} Close(f); end. Пример работы программы можно увидеть зДеСь. С во просами и уточнениями обращайтесь в мини-форум или ЛС. Best regard's! --------- Самурай без меча подобен самураю с мечом, только без меча..

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

Вопрос № 151.516

Здравствуйте! Помогите пожалуйста решить такие вот задачи: 1. Известны фамилии 10 учеников. Определить, есть ли в этой группе ученик по фамилии Петров. Вывести его номер по списку. Удалить данную фамилию из списка. 2. Ежедневно в течение месяца ученик отмечал дни, когда его вызывали отвечать к доске. определить, по каким дням - четным или нечетным его спрашивали чаще. 3. дан массив В из 10 элементов. Организовать новый массив, в ктором элементы расположены в обратном порядке. 4. Составить программу, позволяющую найти все числа Фибоначчи, меньшие заданного N. Заранее спасибо за ответ

Отправлен: 23.11.2008, 14:07 Вопрос задал: Волоков Антон Сергеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: SHERRY Здравствуйте, Волоков Антон Сергеевич! Выполним задачу 3 без использования вспомогательного массива: Код: const n = 5; {количество элементов массива} var ms: array [1..n] of integer; {собственно сам массив } i, a: integer; {вспомогательные переменные} begin for i:=1 to n do readln(ms[i]); {считываем значения массива с клавиатуры} for i:=1 to (n div 2) do {выполняем перестановку элементов} begin a := ms[i]; {запоминаем текущий элемент} ms[i] := ms[n-i+1]; {копируем на его нужный} ms[n-i+1] := a; {а на место скопированного вставим запомненный} end; for i:=1 to n do {выведем результат на экран} write(ms[i]:5); readln; end. П ри решении второй задачи, будем вводить числа, по которым вызывали ученика, и анализировать их на предмет чётностинечётности. Код: var day: integer; {число} chetn, ne4etn: integer; {счётчики чётных и нечётных чисел} begin chetn := 0; {обнуляем счётчики} ne4etn := 0; repeat {запускаем бесконечный цикл} readln(day); {считываем число} if day = 0 then break; {если число равно нулю, то ввод данных прекратить (выйти из цикла)} if odd(day) then {если число нечётное, то увеличить соотв. счётчик} inc(ne4etn) else inc(chetn); {иначе увеличить другой счётчик} until false; {цикл бесконечен} if chetn > ne4etn then write('4etnih 4isel bol`she') {вывод результата} else if che tn < ne4etn then write('ne4etnih 4isel bol`she') else write('odinakovo'); readln; end. Best regard's! --------- Самурай без меча подобен самураю с мечом, только без меча..

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

Отвечает: Шевченко Дмитрий Здравствуйте, Волоков Антон Сергеевич! В приложении программа для решения задачи №4. С уважением, Дмитрий. Приложение: var a1,a2,fib:LongWord; n:Real; begin Write('Enter N: ');//вводим N ReadLn(n); fib:=1;//задаём второе число фибоначи a1:=0; a2:=1;//задаём первое число Фибоначчи While fib < n do begin Write(fib,' '); fib:=a1+a2;//находим следующее число Фибоначчи a1:=a2;//запоминаем предыдущее число Фибоначчи и a2:=fib;//текущее, чтобы находить следующее end; end.

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

Вопрос № 151.522

Уважаемые эксперы есть проблема с задачей на паскале просьба решить! Есть текстовый файл, в текстовом файл надо найти слово находящееся между двумя пробелами!! И вывести это слово на экран!

Отправлен: 23.11.2008, 14:59 Вопрос задал: Zvezdachet Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 8)

Отвечает: Boriss Здравствуйте, Zvezdachet! Вот в приложении пример: ищет именно слово, находящееся МЕЖДУ ПРОБЕЛАМИ. Как находит первое из таких, выводит, и работа прекращается Приложение: const FileName: String = '151522.pas'; var t: Text; i, len: Integer; S, buf: String; BEGIN Assign(t, FileName); {$I-} Reset(t); {$I+} if IOResult <> 0 then begin WriteLn('Файл ',FileName,' не найден. Работа программы прекращается'); Halt(1); end; while NOT EOF(t) do begin ReadLn(t, S); len := length(S); i:=1; {Ищем первый не пробел в строке} while (i < len) and (S[i] = ' ') do inc(i); if i = len then Continue; buf:=''; {Копируем в буфер пока не пробел} while (i <= len) and (S[i] <> ' ') do begin buf := buf + S[i]; inc(i) end; {Если буфер не пуст, то выводим его и завершаем цикл} if buf <> '' then begin WriteLn(buf); Break end end; END. --------- Вывод - то место в тексте, где вы устали думать

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

Вопрос № 151.533

Нарисовать правильную пятиугольную звезду. Звезды должны появлятся на экран до нажатия любой клавиши. спс)

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Шпак Олександр Олександрович! Решение задачи в приложении. Приложение: uses crt,graph; type Tpoint=record {тип точка} x,y:integer; end; procedure Zvezda; {процедура рисования звезды} var x1,y1,a,i:integer; p:array[1..11] of Tpoint; {массив из одиннадцати точек} begin x1:=random(600)+40; {задаем случайные координаты появления звезды} y1:=random(400)+40; a:=-18; {начальный угол луча} for i:=1 to 10 do {десять вершин} begin if i mod 2=0 then {если вершина четная} begin p[i].x:=x1+round(40*cos(a*pi/180)); {идем по внутреннему радиусу} p[i].y:=y1-round(40*sin(a*pi/180)); end else {если нечетная} begin p[i].x:=x1+round(20*cos(a*pi/180)); {по внешнему} p[i].y:=y1-round(20*sin(a*pi/180)); end; a:=a+36; {увеличиваем угол на 36 градусов} end; p[11].x:=p[1].x; {замыкаем маршрут} p[11].y:=p[1].y; MoveTo(p[1].x,p[1].y); {устанавливаем курсор в первую вершину} SetColor(random(14)+1); {случайный цвет} for i:=1 to 11 do LineTo(p[i].x,p[i].y); {рисуем звезду} end; var gd,gm:integer; begin clrscr; InitGraph(gd,gm,''); repeat {повторяем} Zvezda; {рисуем очередную звезду} delay(500); {задержка 0,5 секунды} until keypressed; {пока не нажата клавиша} RestoreCrtMode; {выход в текстовый режим} end.

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

Вопрос № 151.535

Нарисуйте окружность состоящую из 36 разноцветных пятиугольных звёзд, цвет которых непрерывно изменяется. Программа прекращает свою работу по нажатию любой клавиши.

Отправлен: 23.11.2008, 15:59 Вопрос задал: UsesGTR (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Шевченко Дмитрий Здравствуйте, Drumn! В приложении код программы для решения задачи №2. С уважением, Дмитрий. Приложение: program z151535; const N = 15; type elem = byte; mas = array[1..N] of elem; Function FMin(m:mas;x:byte):byte; var i,min:byte; begin min:=x+1; For i := x+2 to N do IF m[i] < m[min] then min:=i; FMin:=min; end; Procedure sort(var m:mas); var tmp:elem; i,min:byte; begin For i := 1 to N-1 do begin min:=FMin(m,i); tmp:=m[i]; m[i]:=m[min]; m[min]:=tmp; end; end; Function poisk(m:mas; symb:byte; var num:byte):boolean; var i:byte; begin poisk:=false; For i:= 1 to N do IF m[i] = symb then begin num:=i; poisk:=true; end; end; procedure vivod(m:mas); var i:byte; begin For i:= 1 to N-1 do Write(m[i],' '); WriteLn(m[N]); end; var m:mas; i,symb,num:byte; s:char; begin //Если надо вводить массивы вручную: For i := 1 to N do begin Write('Enter m[',i,']: '); ReadLn(m[i]); end; vivod(m); //Если произвольно заполнить: Randomize; For i := 1 to N do m[i]:=Random(256); vivod(m); //основная часть: sort(m);//сортируем vivod(m);//выводим отсортированный Write('Enter control character: '); ReadLn(s); symb:=ord(s);//номер этого символа по ASCII (как я понял имеется ввиду этот номер) IF poisk(m,symb,num) then//если этот номер есть в массиве WriteLn('Number of this character: ',symb,'; index in mas: ',num);//выводим его и его индекс end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Drumn! Сегодня видимо день звезды, вторую программу пишу на эту тему. Решение с комментариями в приложении. Приложение: uses crt,graph; type Tpoint=record {тип точка} x,y:integer; end; procedure Zvezda; var x,y,r,x1,y1,a,b,i:integer; p:array[1..11] of Tpoint; begin x:=getmaxX div 2;y:=getmaxY div 2;r:=150; {центр окружности, радиус} for a:=0 to 360 do begin x1:=x+round(r*sin(a*pi/180)); {"рисование" окружности} y1:=y-round(r*cos(a*pi/180)); if a mod 10=0 then {через 10 градусов рисуем звезды} begin b:=-18; {начальный угол луча} for i:=1 to 10 do {10 вершин} begin if i mod 2=0 then {четные вершины} begin p[i].x:=x1+round(20*cos(b*pi/180)); {внешний радиус} p[i].y:=y1-round(20*sin(b*pi/180)); end else {нечетные} begin p[i].x:=x1+round(10*cos(b*pi/180)); {внутренний радиус} p[i].y:=y1-round(10*sin(b*pi/180)); end; b:=b+36; {увеличиваем угол на 36 градусов} end; p[11].x:=p[1].x; {замыкаем маршрут} p[11].y:=p[1].y; MoveTo(p[1].x,p[1].y); {курсор в первую вершину} SetColor(random(14)+1); {случайный цвет} for i:=1 to 11 do {рисуем звезду} LineTo(p[i].x,p[i].y); end; end; end; var gd,gm:integer; begin clrscr; InitGraph(gd,gm,''); repeat Zvezda; {рисуем} delay(500); {задержка 0,5 сек} until keypressed; {ожидаем нажатие клавишы} RestoreCrtMode; {выход в текстовый режим} end.

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

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