Вычёркивание цифр и делимость

[Ktina]

Можно ли, используя по одному разу каждую из цифр от 0 до 9, составить число, обладающее следующими свойствами:
если вычеркнуть двойку, то оно поделится на 2;
если вычеркнуть тройку, то оно поделится на 3;
если вычеркнуть четверку, то оно поделится на 4;
... ;
если вычеркнуть девятку, то оно поделится на 9?
(И. Акулич)

Мне показалось, что число 7154693280 обладает требуемым в условии задачи свойством, или это и вправду так?
В книге указывается число 1346897520, что тоже, вроде бы, неплохо.

Хотелось бы знать, а сколько всего таких чисел?

[Aritaborian]

А если вычеркнуть ноль, оно поделится на ноль.
Набросал код, но жадный Wolfram Programming Lab не даёт мне достаточно машинного времени и оперативной памяти. Если кто-то захочет запустить (и, возможно, оптимизировать), привожу ниже.

(Код)

goodNumberQ[a_]:=First[Union[Divisible[FromDigits[DeleteCases[IntegerDigits[a],#]],#]&/@Range[2,9]]]
nums=FromDigits/@Permutations[Range[0,9]];
Length[Select[nums,goodNumberQ]]

[gris]

Ясно, что должно но $0$ кончаться. Это убивает $2,3,5,9$. Перед нулём чётная цифра. Но главное — семёрка. В общем, много их там, кажется. Минимальное же легко написать: $1234795680$.

-- Пн фев 27, 2017 02:12:18 --

Aritaborian, я попробовал

select[range[1700000,14200000],union[integerDigits[ #*7]] ={1,2,3,4,5,6,8,9}&]

Но тоже пришлось кусками. А это лишь первый шаг. Надо ещё проверку на восьмёрку делать. Да ну её. Лучше врукопашную .

[Aritaborian]

gris в сообщении #1195705 писал(а):

Лучше врукопашную

Ну так написанная мной числодробилка должна работать; жаль, Математики на этом компе нет. Впрочем, если постараться оптимизировать количество кандидатов на проверку, может, получится скормить в облако. Плюс скармливать не всё сразу, а по частям.

UPD. Скормил я это всё облаку небольшими порциями чтоб сервера в Иллинойсе в клочья не порвало и был мне Глас свыше, что всего таких чисел — $10774$.

[Dmitriy40]

Подтверждаю, $10774$ штук. Наименьшее $1234795680$, наибольшее $9876351240$. Сумма всех равна $60430096214460$. И $7154693280$ и $1346897520$ оба подходят. Час писания программы и полсекунды счёта.

[Aritaborian]

(Чуть-чуть улучшенный код)

goodNumberQ[a_]:=AllTrue[Range[2,9],Divisible[FromDigits[DeleteCases[IntegerDigits[a],#]],#]&]

-- 27.02.2017, 03:29 --

Dmitriy40 в сообщении #1195708 писал(а):

Час писания программы и полсекунды счёта.

В моём случае наоборот: минута на написание программы и долгие попытки скормить её облаку ;-D

[Aritaborian]

(Ещё немного оптимизации)

goodNumberQ[digits_List]:=AllTrue[Range[2,9],Divisible[FromDigits[DeleteCases[digits,#]],#]&]
nums=Permutations[Range[0,9]];
Length[Select[nums,goodNumberQ]]

[gris]

Всё же приведу свой рукопашный способ
С вариантами $20, 60$ на конце удовлетворяются все пункты, кроме $7$ и $8$. Вот мы их оба частично удовлетворим тремя цифрами $560$. С восьмёркой порядок, она делит тысячу. Осталось в качестве начала числа придумать из $1,2,3,4,9,8$ число, делящееся на $7$. Некоторые пары прямо лезут в глаза, но тройка мешает разбить попарно. Поэтому начинаем делить с самого начала. $12, 123, 1239$. Ура. А $84$ прекрасно дополняет. Семёрку можно засунуть на любое место, кроме трёх последних.
И вот: $7123984560$. Как пример подойдёт. Ну а количество без компъютера можно только за большие деньки посчитать.

[Ktina]

Aritaborian
gris
Dmitriy40
Большое спасибо!