Помощь - Поиск - Пользователи - Календарь
Полная версия: Игра с калькулятором
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Учинек
В калькулятор вводится натурально число К и нажимается клавиша "+". Калькулятор все еще показывает К. Цель игры: получить на экране число, состоящее из одинаковых цифр. Для ее достижения можно производить только одно действие - нажимать на клавишу "=" (возможно, 0 раз). После первого нажатия получается результат К+К, после очередного нажатия результат увеличивается на К. Требуется определить, удастся ли достичь цели, а если удастся, то какое число, состоящее из одинаковых цифр, будет получено первым. Количество отображаемых калькулятором цифр считать неограниченным, время работы батареек - тоже.
Ограничения: 1<=K<=999, время 1с.
Вводится одно число - К.
Вывести если цели достичь невозможно "No", если возможно, вывести два числа через пробел: цифру, из которой состоит искомое число, и количество цифр в числе.

Пример.
ввод№1
37
вывод№1
1 3

ввод№2
25
вывод
No




Я даже не знаю, что делать. Тупой перебор не пойдет потому как числа могут быть очень большие....как мне кажется должна быть формула, но вот только какая.... wacko.gif

И еще по-моему числа которые заканчиваются на 0 не будут образовывать число с одинаковыми цифрами, сколько их не складывай.
maksimla
а я такой тупой что непонел примеров даже от куда взялись такие цифры можешь обеснить показать как цифры вычислялись
Учинек
37+37+37=111.

Цифра 1 встретилась 3 раза.
maksimla
а тебе что нужно чтобы цифра 1 встретилась пару раз или как непонел ?
то могу написать
25+25+25=75
Цифра 7 встретилась 1 раза.
или
25+25+25+25= 100
Цифра 1 встретилась 1 раза.
Учинек
Цитата(Учинек @ 23.12.2008 16:30) *

...Цель игры: получить на экране число, состоящее из одинаковых цифр. ....
Требуется определить, удастся ли достичь цели, а если удастся, то какое число, состоящее из одинаковых цифр, будет получено первым. .....


Это ответ на вопрос.


Т.е. если будет число 44, то вывести надо: 4 2.

А 25 сколько раз не складывай - не получиться число в котором будут все одинаковые цифры.
Lapp
Цитата(Учинек @ 23.12.2008 16:30) *
И еще по-моему числа которые заканчиваются на 0 не будут образовывать число с одинаковыми цифрами, сколько их не складывай.
Хорошее соображение - числа, большие нуля (по условию), не могут состоять из одних нулей smile.gif. Это я, кстати, использую ниже.

Цитата(Учинек @ 23.12.2008 16:30) *
Я даже не знаю, что делать. Тупой перебор не пойдет потому как числа могут быть очень большие....как мне кажется должна быть формула, но вот только какая....
Не думаю, чтоб была какая-то полезная формула на этот счет. Как грится, "трясти надо!" (с). Это тебе кажется, что числа будут очень большие: у страха глаза велики smile.gif. Вот, смотри.

Многократное сложение есть на самом деле умножение. Исходное число не больше тысячи. После умножения его на 1000 комбинации низших трех разрядов начнут повторяться:
...
123 * 1000 = 123000
123 * 1000 + 123 = 123123
...
Поэтому достаточно рассмотреть не более чем тысячекратное сложение. А это значит, что числа будут не больше 999999. Таким образом, работаем с типом LongInt и забываем о проблеме "больших чисел" smile.gif.


Подходов я вижу два: один прямой, другой "с заднего кирильца" (с). Первый - тупо в лоб складывать числа, как написано в условии, и проверять. Вот он:
function Digit(n: LongInt; p: byte): byte;
var
i: integer;
m: LongInt;
begin
m:=1;
for i:=2 to p do m:=m*10;
Digit:=n div m mod 10
end;

var
a,k: LongInt;
i: integer;
d,j,p,n: byte;

begin
ReadLn(k);
a:=0;
for i:=1 to 999 do begin
a:=a+k;
j:=7;
repeat
Dec(j);
d:=Digit(a,j)
until d>0;
n:=j;
Dec(j);
while (j>0)and(Digit(a,j)=d) do Dec(j);
if j=0 then begin
WriteLn(d,' ',n);
exit
end
end;
WriteLn('No')
end.

Выглядит громоздко даже с функцией.. А если не уложимся во время (хотя, 1 сек - не так и мало), то придется вставить вычисление цифры прямо в код.

Второй метод основан на том, что чисел, состоящих из одинаковых цифр в диапазоне до миллиона не так уж и много (а точнее, 6*9=54). Перебираем их все и делим на данное число. Если остаток равен нулю - нам повезло smile.gif. Этот способ гораздо изящнее и заведомо укладывается в сотые доли секунды, полагаю..
Вот он:
var
a,k: LongInt;
i,j: byte;

begin
ReadLn(k);
a:=0;
for i:=1 to 6 do begin
a:=a*10+1;
for j:=1 to 9 do if a*j mod k=0 then begin
WriteLn(j,' ',i);
exit
end
end;
WriteLn('No')
end.


Вот и все.
Как грится - хорошо smile.gif, но мало.. sad.gif

Добавлено через 10 мин.
Еще, вот это понравилось:
Цитата(Учинек @ 23.12.2008 16:30) *
В калькулятор вводится натурально число К ...
Так и хочется добавить: "чисто конкретно" - и расставить пальцы.. smile.gif
Учинек
да так было бы довольно просто, но достоверно известно, что для числа 997 ответ будет 1 166...

все-таки получается число с очень большими цифрами, даже если использовать инт64(можно использовать фри паскаль) то не войдет...


именно поэтому мне, казалось, что должна быть какая-то формула.
Lapp
Цитата(Учинек @ 24.12.2008 21:29) *
достоверно известно, что для числа 997 ответ будет 1 166...
Да??.. blink.gif
Хм.. надо подумать...
Мое рассуждение про тысячу действительно не очень строгое... надо подумать! smile.gif

volvo
Цитата
именно поэтому мне, казалось, что должна быть какая-то формула.

Посмотри здесь: Smallest multiple of n using a single digit with multiplicity, or 0 if no such number exists., там есть комментарии, которые могут оказаться полезными...
Lapp
Вот:
var
i,j,k,n,a: integer;
d: byte;
r: array[1..999]of boolean;

begin
ReadLn(k);
for d:=1 to 9 do begin
for j:=1 to k do r[j]:=false;
a:=d;
n:=1;
repeat
r[a]:=true;
while a<k do begin
a:=a*10+d;
Inc(n)
end;
while a>=k do a:=a-k
until (a=0) or r[a];
if a=0 then begin
WriteLn(d,' ',n);
exit
end
end;
WriteLn('No')
end.

Да, сглупил я, однако.. sad.gif
Но зато - оказалось, что не только хорошо, но и не очень мало! smile.gif

Вот контрольная выдача:
Код
Running "...uchinek-2.exe"
123
1 15
Running "...uchinek-2.exe"
37
1 3
Running "...uchinek-2.exe"
997
1 166
Running "...uchinek-2.exe"
25
No
Учинек
да задача хороша=)

только в вашей задаче на некоторые числа(это те которые я протестировал) к примеру:
1)99
1 18
2)77
1 6
3)33
1 6
3)333
1 9
4)999
1 27

может быть в начале поставить проверку на то если число уже с одинаковыми числами, то вывести его.
Lapp
Цитата(Учинек @ 24.12.2008 23:22) *
к примеру:
1)99
1 18
2)77
1 6
3)33
1 6
3)333
1 9
4)999
1 27

может быть в начале поставить проверку на то если число уже с одинаковыми числами, то вывести его.
Боюсь, это не решит проблему...
Дело в том, что сначала проверяются единицы (любое число единиц), потом двойки, и т.д. Поэтому число из единиц (если оно есть) находится раньше, чем из других цифр, даже если оно больше его.

Надо подумать...


Добавлено через 11 мин.
Вот. Надеюсь, "это есть наш последний" (С) smile.gif
var
i,j,k,m,n,a: integer;
c,d: byte;
r: array[1..999]of boolean;

begin
ReadLn(k);
c:=0;
m:=MaxInt;
for d:=1 to 9 do begin
for j:=1 to k do r[j]:=false;
a:=d;
n:=1;
repeat
r[a]:=true;
while a<k do begin
a:=a*10+d;
Inc(n)
end;
while a>=k do a:=a-k
until (a=0) or r[a];
if a=0 then if n<m then begin
c:=d;
m:=n
end
end;
if c=0 then WriteLn('No') else WriteLn(c,' ',m)
end.


Добавлено через 9 мин.
Цитата(Учинек @ 24.12.2008 23:22) *
да задача хороша=)
Собственно, в ней ничего нет, кроме деления "уголком". Но простота тоже красива smile.gif
klem4
Ухх, тысячу лет на Паскале не писал)))) Вот еще вариант:

function solve(const k: integer): longint;
var
i, count: byte;
n, value: longint;
found: boolean;
begin
found := false;
i := 1;
while not (found) and ( i < 10 ) do begin
n := 10;
value := i;
count := 1;
while not(found) and (n <= 1000000) do begin
inc(count);
inc(value, i * n);
found := value mod k = 0;
if not found then n := n * 10;
end;
if not found then inc(i);
end;
if found and ( value <> k ) then writeln(i, ',', count) else writeln('no');
end;

var
k, v: longint;

begin
{* for k := 1 to 999 do *}
k := 123;
solve(k);
end.


rolleyes.gif
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.