Подмножества с целым средним геометрическим

[Ktina]

Пусть у нас даны натуральные числа от 1 до $n$.
Назовём непустое подмножество множества этих чисел путным, если среднее геометрическое элементов этого подмножества является натуральным числом.
Как определить, чётно или нечётно количество путных подмножеств, в зависимости от $n$?

[Aritaborian]

Немудрёная програмулька (если я ничего не напутал)

goodSubsetQ[subset_] := IntegerQ[GeometricMean[subset]]
Table[Total[Boole[goodSubsetQ /@ Rest[Subsets[Range[i]]]]], {i, 1, 18}]

выдала количества путных подмножеств для $n=1...18$:

1, 2, 3, 6, 7, 8, 9, 12, 19, 20, 21, 28, 29, 30, 31, 40, 41, 70.

Кто-нибудь может подметить какую-либо закономерность?

[grizzly]

Aritaborian в сообщении #1213659 писал(а):

Кто-нибудь может подметить какую-либо закономерность?

Ну если нужна закономерность относительно вопроса задачи (чётное количество или нет), то я рискну заметить, что чётные и нечётные в этой последовательности строго чередуются

[Aritaborian]

Воспарив куда-то выше, этого я заприметить не пожелал BTW, дальше там $71$ и $74$.

[DeBill]

Что то мне подумалось, что на 27-м шаге мы обломаемся. Но, насчитав в разности $a_{27} - a_{26}$ 40 элементов, как то не совсем не уверен в правильности подсчета....

[mihaild]

Закономерность: номера членов, отличающихся от предыдущих больше чем на $1$ - в точности не свободные от квадратов числа.
А еще $f_n - n$ - это A147751

-- 05.05.2017, 00:56 --

И даже понятно, почему так. Если максимальное число в подмножестве раскладывается как $t = p_1 \cdot \ldots \cdot p_n$ (числа не повторяются) и входит в состав $k$-элементного множества, то произведение остальных $k - 1$ членов этого множества не меньше чем $\prod p_i^{k-1}$, и хотя бы одно из них не меньше $t$.

[Aritaborian]

А, ясно. Последовательность, приведённая мною, включала тривиальные (одноэлементные) подмножества (и в OEIS никак не находилась), а эта не включает. OEIS приводит только для $n \leqslant 20$. Имеет ли смысл считать дальше? (Я посчитал до 23. Расчёты оч. долгие получаются, и постепенно больше и больше нагружают оперативку.)

[mihaild]

Досчитал чуть дальше (без учета тривиальных)

(список)

1. 0
2. 0
3. 0
4. 2
5. 2
6. 2
7. 2
8. 4
9. 10
10. 10
11. 10
12. 16
13. 16
14. 16
15. 16
16. 24
17. 24
18. 52
19. 52
20. 54
21. 54
22. 54
23. 54
24. 84
25. 98
26. 98
27. 184
28. 186
29. 186
30. 186
31. 186
32. 300
33. 300
34. 300
35. 300
36. 556
37. 556
38. 556
39. 556
40. 572
41. 572
42. 572
43. 572
44. 574
45. 594
46. 594
47. 594
48. 1112
49. 1134
50. 1274

Если зачем-то нужно, можно посчитать дальше.

[Aritaborian]

mihaild, чем считали?

[mihaild]

Руками. Чем еще?

Используется синтаксис C++

#include <map>
#include <array>
#include <iostream>
#include <utility>

const std::array<int, 6> PRIMES = {2, 3, 5, 7, 11, 13};//, 17, 19};//, 23, 29, 31, 37};

using TFactorization = std::array<int, PRIMES.size()>;
using TProfile = std::pair<int, TFactorization>;

TFactorization factorize(int n) {
    TFactorization result;
    for (auto &x : result) {
        x = 0;
    }
    for (size_t i = 0; i < PRIMES.size(); ++i) {
        while (n % PRIMES[i] == 0) {
            ++result[i];
            n /= PRIMES[i];
        }
    }
    if (n != 1) {
        throw std::exception();
    }
    return result;
}

int main() {
    int n;
    std::cin >> n;
    std::map<TProfile, int> data;
    int r = 0;
    data[{0, factorize(1)}] = 1;
    data[{1, factorize(1)}] = 1;
    //std::cout << "1: 1 ok" << std::endl;
    for (int i = 2; i <= n; ++i) {
        std::map<TProfile, int> next_data(data);
        bool ff = true;
        TFactorization factorization;
        try {
            factorization = factorize(i);
        } catch (...) {
            ff = false;
        }
        if (ff) {
            for (const auto& profile : data) {
                TProfile new_profile(profile.first);
                new_profile.first += 1;
                for (size_t i = 0; i < PRIMES.size(); ++i) {
                    new_profile.second[i] += factorization[i];
                }
                bool ok = new_profile.first > 1;
                for (size_t i = 0; i < PRIMES.size(); ++i) {
                    if (new_profile.second[i] % new_profile.first) {
                        ok = false;
                        break;
                    }
                }
                if (ok) {
                    r += profile.second;
                }
                next_data[new_profile] += profile.second;
            }
        }
        data = next_data;
        std::cout << '(' << i << " " << r << ')' << std::endl;
        std::cerr << '(' << i << " " << r << ')' << ' ' << data.size() << std::endl;
    }
    return 0;
}
 

[Aritaborian]

И как, эти библиотеки быстро считают? Wolfram Mathematica для относительно больших $n$ считает часами. Это обратная сторона лёгкости написания кода, который пишешь, не приходя в сознание, за секунды. (Впрочем, я запускал расчёты на оч. слабеньком лаптопе.)

[DeBill]

Среднее геометрическое нетривиального подмножесва из чисел, не больших $n$, также не больше $n$. Если оно не входит в подмножество, добавим его к подмножеству - и получим новое "путнинское" (а если входит - удалим). (В двухэлементное - не входит). Поэтому все нетривиальные путные подмножества разбиваются на пары. Поэтому их кол-во - четно.

[Aritaborian]

Что ж, вот, наконец, и доказательство Впрочем, структура последовательности по-прежнему малость загадочна.

[mihaild]

Да, я искал, что можно было бы выкинуть из семейства, но не нашел:)
Aritaborian, на 2.4ггц Xeon до 50 ухожит примерно 40 секунд. Тут важнее не платформа, а алгоритм (я перебираю гораздо меньше, чем все подмножества). Mathematica, думаю, с тем же алгоритмом будет медленнее раз в 5.

[Aritaborian]

Теоретически можно переписать ваш алгоритм на Wolfram Language (приведённый же мною перебирает тупо всё в лоб) и даже попросить Математику скомпилировать... Если скомпилирует, по времени будет сравнимо. А так, да, что касается скорости, Математика супротив Си всегда была как плотник супротив столяра, кто ж спорит.