Отправляет email-рассылки с помощью сервиса Sendsay

Олимпиадные задачи с решениями на Turbo Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.825 RSS
←   Июнь 2003   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


За последние 60 дней ни разу не выходила


Открыта: 02-12-2001

Автор
Aslof

Статистика

3.825 подписчиков
0 за неделю
←   Все выпуски   →

Олимпиадные задачи с решениями на Turbo Pascal


Информационный Канал Subscribe.Ru

Здравствуйте, уважаемые подписчики. Каюсь, пилотный выпуск рассылки был тестовым. Он вызвал просто бурю эмоций. Такого отклика не получили даже мои рассуждения на тему "Истина одна!" в рассылке "Мудрость тысячелетий"
http://subscribe.ru/catalog/lit.quotation.mudrost
обьем корреспонденции достиг 0.8% - это около 50 писем. Для одной маленькой задачки это фантастически много. В противовес этому совсем не было отписавшихся. (Рейтинг рассылки упал в день выпуска на одного человека). Практика показывает, что даже более мягкая смена ведущего инициирует падение рейтинга на 20-30 человек.
sergtemp! Ты предлагал сотрудничество. Ну, и где задачи :-)?
Предложили не публиковать код решения сразу. Пожалуй так и будет. Предлагаю на следующий раз такую задачу.

Подсчитать количество цифр в квадрате произведения всех делителей данного числа N, где N<10000000.

Пример: N = 30
Квадрат произведения делителей = (2*3*5*6*10*15)^2 = 729000000
Результат: 9

Примечание: стандартные способы здесь не работают, так как квадрат в большинстве случаев получается очень большим числом, выходящим за рамки возможностей Pascal'a. приходится либо работать по принципу символьных вычислений, либо идти на разные извратные способы: типа разделения большого чила на два маленьких (X := a1a2a3aa4a5a6 * 10^6 + b1b2b3b4b5b6) и работа с ними по отдельности.

Я не решал ещё её! Поэтому и сложность не знаю :-) Будем решать?
Просьба! Проверяйте код, который шлёте мне на работоспособность.
Я решил опубликовать новое решение задачи из прошлого номера, навеянное письмами читателей. Введён вывод нулей в начале номера для Evgeniy. По многочисленным просьбам не используется goto. Кстати, не пишите мне о том, что для циклов нужно использовать переменную i. Взгляните на клавиатуру! Будет q и точка. И она будет без ограничений использоваться в процедурах, это удобнее и, кажется, быстрее. q, w, e, r, t. По остальному оформлению комментарии приветствуются. На волне оптимизации решил ввести использование директивы {$I}. Надеюсь, все знают, что это за директива?
Спасибо vordegus за оригинальную идею использовать индекс строки для проверки. Евгений, я думал-думал, но так и не понял твой алгоритм уменьшения количества проходов (может напишешь код и пришлёшь?). А сама идея оптимизации вылилась в проверку только каждого 9 билета, начиная с первого счастливого и первого счастливого после перерыва. (Не надо обьяснять, что только каждый девятый билет может быть счастливым, а реально их ещё в 2 раза меньше?). Можно конечно написать код поиска первого счастливого и дальше проверять только каждый девятый, а не как у меня. Это бы дало ещё где-то 5% (или 15, если номера билетов не выводить) скорости, но усложнило бы код.
Вообщем, код теперь работает в восемь раз быстрее. Что скажете, Vladimir? :-)


ЗАДАЧА. Автобусные билеты в рулоне пронумерованы от 000001 до 999999. Составить программу, выводящую на экран количество и номера (в несколько столбиков) всех счастливых билетов в некотором диапазоне, организовав запрос начального и конечного номера билета диапазона.

Примечание: Счастливым считать тот билет, у которого сумма первых трех цифр равна сумме трех последних. 

uses crt;
var start,stop:longint;
    q:longint;
    st:string;
    num:longint;
function number(st:string):integer;
var err,sumb:integer;
  begin
    val(st,sumb,err);
    number:=sumb;
  end;
Begin
  clrscr;
  Writeln('Список всех счастливых билетов в выбранном диапазоне.');

  {$I-}
  Writeln('Введите корректный начальный номер билета');
  repeat
    write('от 000001 до 999999 ');
    readln(start);
  until (IOResult=0)and(start<1000000)and(start>0);

  writeln('Спасибо. Теперь введите корректный конечный номер билета ');
  repeat
    write('от 000001 до 999999, но меньше ',start, ' ');
    readln(stop);
  until
(IOResult=0)and(stop<1000000)and(stop>0)and(stop>
=start);
  {$I+}

  num:=0;q:=start;
  repeat
    str(q,st);while length(st)<6 do st:='0'+st;
    if ((number(st[1])+number(st[2])+number(st[3]))=
        (number(st[4])+number(st[5])+number(st[6])))
       then begin
         num:=num+1;q:=q+8;
         if num mod 10<>0 then write(st, ' ')else
writeln(st);
       end;
  q:=q+1;
  until (q>=stop);
  writeln;
  writeln(num);
  readln;
end.

Новый ведущий, Aslof aslof@mail.ru
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное