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

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

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

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

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

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

Вопрос № 175205: Добрый день,уважаемые эксперты!!!!Помогите пожалуйста с одной задачкой: Описать функцию подсчёта количества трёхзначных натуральных чисел, сумма цифр которых равна n (1=<n<=27) ...

Добрый день,уважаемые эксперты!!!!Помогите пожалуйста с одной задачкой:
Описать функцию подсчёта количества трёхзначных натуральных чисел, сумма цифр которых равна n (1=<n<=27)

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

Приложение:
var i,m,n,k:integer; begin readln(n); k:=0; for i:=100 to 999 do begin m:=i div 100 + i mod 100 div 10 + i mod 10; if m=n then inc(k); end; writeln(k); readln; end.

Ответ отправил: Сергей Бендер, 2-й класс
Ответ отправлен: 13.12.2009, 22:52

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

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

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

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

Отвечает leonid59, Студент :
Здравствуйте, angel.nero. Ответ в приложении. Turbo Pascal 7. Недостатки: неуниверсальная, не самая быстрая.

Приложение:
program p174593; var n: integer; numbers: integer; function min(a,b:integer): integer; begin if a<b then min := a else min := b; end; function CalcCount3(n: Integer): Integer; var i, j: integer; ostatok1, ostatok2, ostatok3: integer; count: integer; iter: integer; begin count := 0; iter := 0; ostatok1 := n; for i:= 1 to min(9, ostatok1) do begin ostatok2 := ostatok1-i; if ostatok2<=2*9 then begin for j:= 0 to min(9,ostatok2) do begin ostatok3 := ostatok2-j; inc(iter); if ostatok3<=9 then begin write(i,j,ostatok3, \';\'); inc(count); end; end; end; end; writeln; writeln(\'Число итераций=\', iter); CalcCount3 := count; end; begin write(\'n=\'); readln(n); if not (n in [1..27]) then writeln(\'количество чисел, с суммой цифр \', n, \' равно 0\') else begin numbers := CalcCount3(n); writeln(\'количество чисел, с суммой цифр \', n, \' равно \', numbers); end; readln; end.

Ответ отправил: leonid59, Студент
Ответ отправлен: 16.12.2009, 11:33

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

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

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

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

Приветствую вас,уважаемые эксперты,помогите решить задачу.Даны действительные числа a1, a2, … ,an. Поменять местами наименьший из них и наибольший из них.

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

Приложение:
const n=10; var a:array[1..n] of real; i,imin,imax:integer; r:real; begin for i:=1 to n do read(a[i]); imax:=1; imin:=1; for i:=2 to n do begin if a[i]<a[imin] then imin:=i; if a[i]>a[imax] then imax:=i; end; r:=a[imax]; a[imax]:=a[imin]; a[imin]:=r; for i:=1 to n do writeln(a[i]4); writeln; readln; end.

Ответ отправил: Сергей Бендер, 2-й класс
Ответ отправлен: 13.12.2009, 22:08

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

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

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

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

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

Отвечает danilka.pro, 2-й класс :
Здравствуйте, Владимир Савельев! Решение в приложении.

Приложение:
var A: Array[1..100] of Integer; I, C, N, NoC, S, NoS: Integer; begin writeln(\'Enter count of numbers\'); readln(N); for I := 1 to N do begin writeln(\'Enter number a\', I); readln(A[I]); if A[I] > C then begin C := A[I]; NoC := I; end; if (A[I] < S) or (I = 1) then begin S := A[I]; NoS := I; end; end; A[NoC] := A[NoS] + A[NoC]; {с помощью трех команд меняем местами значения ячеек} A[NoS] := A[NoC] - A[NoS]; A[NoC] := A[NoC] - A[NoS]; for I := 1 to N do write(A[I], \' \'); readln; end.

Ответ отправил: danilka.pro, 2-й класс
Ответ отправлен: 16.12.2009, 15:13

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

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

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

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

Еще раз здравствуйте.

Задача на файлы.

Исходный файл состоит из компонента вида:

- название спортивной секции( из фиксированного перечня)
- ФИО спортсмена
- год рождения
- вес
- рост
- адрес

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

Ссылка на исходный файл.
Фиксированный перечень состоит из секций: Баскетбол, Футбол, Гольф.

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

Приложение:
const MaxN=20; { Максимальное число записей в исходном файле } ThisYear=2009; type TSportsman = record sport:string[9]; FIO:string[27]; birth,weight,height:integer; address:string; end; TList = array[1..MaxN] of TSportsman; var f:text; i,j,imin,N:integer; c:char; List:TList; Sportsman:TSportsman; SelectedSport:string[9]; Age:integer; begin { Считывание секции и возраста } writeln(\'Выберите спортивную секцию:\'); writeln(\'1 - Баскетбол\'); writeln(\'2 - Футбол \'); writeln(\'3 - Гольф \'); readln(i); case i of 1:SelectedSport:=\'Баскетбол\'; 2:SelectedSport:=\'Футбол \'; 3:SelectedSport:=\'Гольф \'; end; writeln(\'Введите максимальный возраст\'); readln(Age); { Открывается файл и берется первый элемент массива List } assign(f,\'list1.txt\'); reset(f); i:=1; while not eof(f) and (i<=MaxN) do with List[i] do begin readln(f,c,c,c,c,sport,c,FIO,birth,weight,height,c,address); { Если считанная запись подходит по секции и возрасту, то берется следующего чтения из файла берется следующий элемент List} if (sport=SelectedSport) and (ThisYear-birth<=Age) then inc(i); end; close(f); { Одно увеличение i было лишним } N:=i-1; { Обычная сортировка прямым выбором } for i:=1 to N-1 do with List[i] do begin { Поиск минимального элемента List, начиная с i-го } imin:=i; for j:=i+1 to N do { Условие сортировки: по росту и ФИО } if (List[j].height>height) or ((List[j].height=height) and (List[j].FIO<FIO)) then imin:=j; if imin<>i then begin { Найденный минимальный элемент ставится на место i-го } Sportsman:=List[imin]; List[imin]:=List[i]; List[i]:=Sportsman; end; end; { Результат } for i:=1 to N do with List[i] do writeln(sport,\' \',FIO,\' \',birth,\' \',weight,\' \',height,\' \',address); readln; end.

Ответ отправил: Сергей Бендер, 2-й класс
Ответ отправлен: 13.12.2009, 21:49

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

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

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

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

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

Добрый день,уважаемые эксперты,я некоторое время назад отправлял задачку на массивы с обработкой серий,помогите пожалуйста
Даны натуральное число n и целочисленный массив из n чисел. Подсчитать количество серий из чисел Фибоначчи (первое и второе числа равны 1, а каждое следующее число равно сумме двух предыдущих) и выдать эти серии
p.s. препод сказал что серия может определяться из одного элемента,который по идее может состоять в числах Фибоначчи.
в приложении прога,там при выполнении она считает только одну серию и то только первую, например если вводишь 1,1,2 то прога считает что эта серия ,а если вводишь 3,5,8 то нет,помогите, прошу вас!!!!!

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

Приложение:
program NewFibo; uses crt; const MaxSize=100; { максимальный размер массива } type _int = integer; { для того, чтобы можно было менять int - для отладки, longint для показа } TPtr = ^_int; TVector = array[1..MaxSize] of _int; var i: integer; v, vFibo: TVector; MaxFiboIndex: integer; { максимольно возможный индекс Фибоначчи } size : integer; { текущий (используемый) размер массива } prev, curr: integer; { предыдущий и текущий индексы по массиву Фибоначчи } SeriesCount: integer; { счетчик серий } procedure GenFibo(p: TPtr; size: integer; var MaxIndex: integer); { формирование массива Фибоначчи } var f1, f2, NextFibo: _int; begin f1 := 1; f2 := 1; p^:=f1; inc(p); p^:=f2; MaxIndex := 1; while ( (f1>0) and (f2>0) and (f1+f2>0) ) do begin inc(p); p^:= f1+f2; f1:=f2; f2:=p^; inc(MaxIndex); end; end; { GenFibo } function IndexOf(p: TPtr; size: integer; elem: _int): integer; { поиск в массиве, возвращает индекс элемента, начиная с 0, либо -1, если не найдено } var i: integer; begin i:= 0; IndexOf := -1; while ( (i<size) and (p^ <> elem) ) do begin inc(p); inc(i); end; if p^= elem then IndexOf := i end; { IndexOf } begin ClrScr; { создание глобального массива чисел Фибоначчи } GenFibo(@vFibo, MaxSize, MaxFiboIndex); writeln(\'Вектор Фибоначчи\'); for i:= 1 to MaxFiboIndex do write(vFibo[i],\';\'); writeln; writeln; randomize; { создание массива чисел } { используемый массив } size := 20; { size := random(MaxSize-1); } for i:= 1 to size do v[i] := random(10); { печать массива } writeln(\'Данный массив\'); for i:= 1 to size do write(v[i],\';\'); writeln; readln; prev := -1; SeriesCount := 0; for i:= 1 to size do begin curr := IndexOf(@vFibo, MaxFiboIndex, v[i]); if curr <> -1 then begin if (prev=-1) or (curr-prev<>1) then { новая серия } begin inc(SeriesCount); writeln; write(\'Серия \', SeriesCount, \' => \'); end; write(v[i],\';\'); end; prev := curr; end; writeln; writeln(\'Всего \', SeriesCount, \' серий\' ); readln; end.

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

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

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

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

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

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

Отправлен: 13.12.2009, 21:16
Вопрос задал: Павел Рубцов, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
var a:real; {функция расчета площади треугольника} function S(b:real):real; var c:real; begin {полупериметр p=(a+b+c)/2 } c:=(b+b+b)/2; {формула Герона S=sqrt(p*(p-a)*(p-b)*(p-c)) } S:=sqrt(c*(c-b)*(c-b)*(c-b)); end; begin {вводим длину одной стороны} repeat write(\'Enter A:\'); readln(a); until a>0; {выводим результат} writeln(\'Square:\',(6*S(a)));{считаем по формуле Герона} writeln(\'Check:=\',(6*(sqrt(3)*a*a/4)));{контроль:считаем площадь равностороннего треугольника} readln; end.
-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

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

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

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

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

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

Здравивуйте уважаемые эксперты, моя задачка (заранее благодарна):
Задано некоторое множество М и множество Т такого же типа. Подсчитать, сколько элементов из множества М и Т совпадают.

Отправлен: 13.12.2009, 21:31
Вопрос задал: Катя Жукова, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
type t_m=set of char; var M,T,MT:t_m; i:integer; {процедура вывода множества на экран} procedure WriteSet(a:t_m); begin writeln; for i:=0 to 255 do if chr(i) in a then write(chr(i)); writeln; end; {функция посчета элементов множества} function CheckSet(a:t_m):integer; var j:integer; begin j:=0; for i:=0 to 255 do if chr(i) in a then inc(j); CheckSet:=j; end; begin randomize; {сбрасываем первое множество} M:=[ ]; {генерируем множество, исключая служебные символы и выводим его на экран} for i:=1 to 200 do M:=M+[chr(random(224)+32)]; WriteSet(M); {сбрасываем второе множество} T:=[ ]; {генерируем множество, исключая служебные символы и выводим его на экран} for i:=1 to 200 do T:=T+[chr(random(224)+32)]; WriteSet(T); {пересечение множеств, останутся только те элементы, которые есть в обоих множествах} MT:=M*T; {выводим результат на экран} WriteSet(MT); {выводим количество элементов множества} writeln(\'result:\',CheckSet(MT):5); readln; end.
-----
Итерация от человека. Рекурсия — от Бога. — Л. Питер Дойч

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

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

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

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

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

Здравствуйте, уважаемые эксперты, помогите решить задачку.
"Написать программу для вычисления суммы факториалов всех нечетных чисел от 1 до 9. Выделить и использовать функцию"

Отправлен: 13.12.2009, 22:01
Вопрос задал: Юлия Малышева, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
function factorial(x: longint): longint; var i, result: longint; begin result := 1; for i := 1 to x do result := result * i; factorial := result; end; var s, i: longint; begin s := 0; for i := 1 to 9 do if i mod 2 = 1 then s := s + factorial(i); WriteLn(s); end.

Ответ отправил: Колесников Иван Владимирович, 3-й класс
Ответ отправлен: 13.12.2009, 22:07

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

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

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

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

Отвечает danilka.pro, 2-й класс :
Здравствуйте, Юлия Малышева! Задачу я решил, она в приложении. Функция вычисления факториала использована.

Приложение:
var Y, S: LongInt; function Fakt(I: Integer): LongInt; var Z: Integer; Result: LongInt; begin Result := 1; for Z := 1 to I do Result := Result * Z; Fakt := Result; end; begin for Y := 1 to 9 do S := S + Fakt(Y); writeln(S); readln; end.

Ответ отправил: danilka.pro, 2-й класс
Ответ отправлен: 16.12.2009, 15:10

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

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

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

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

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

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