Перестановки. 9-й класс. Задача на четность

    image

    Май выдался холодным, отопление отключили, а вычислительные (и обогревательные) мощности какие-никакие, а простаивают. Так почему бы не загрузить их чем-нибудь бесполезным, что и согреет, и развлечёт.

    Но начну издалека. На днях попалась на глаза задачка для средней школы со следующей формулировкой: «Несколько последовательных натуральных чисел выписали в строку в таком порядке, что сумма каждых трёх подряд идущих чисел делится нацело на самое левое число этой тройки. Какое максимальное количество чисел могло быть выписано, если последнее число строки нечётно?»

    При таком ограничении нетрудно доказать, что в каждой тройке нечётных чисел будет больше, чем чётных. И поскольку разница между ними не может быть больше единицы, максимальная длина последовательности ограничена пятью числами. А в качестве примера можно привести последовательность 4 5 3 2 1.

    Подробное доказательство можно найти здесь.

    Но что если убрать указанное ограничение на нечётность последнего числа? Тогда справа можно добавить числа 7 6 8, расширив последовательность до восьми чисел. Можно ещё и десятку добавить, а недостающую девятку присоединить слева. Ну и, наверное, это будет не единственная и не самая длинная перестановка.

    Собственно, стараясь рассуждать логически, я не нашёл доказательства ограниченности таких последовательностей и решил привлечь к анализу домашний обогреватель вычислитель. Грубый полный перебор всех N! вариантов быстро показал несостоятельность метода, а вот направленный перебор позволил значительно продвинуться, и результат оказался и ожидаемым и неожиданным одновременно.

    Выяснилось, что для всех N до 29 включительно такие перестановки чисел от 1 до N действительно находятся, правда, для длин 27 и 29 в единственном варианте. А вот дальше появляются пробелы. Для перестановок с размерами 30, 31, 32 и 33 решений нет, для числа 34 есть одно.

    такое
    33 23 10 13 7 6 1 29 27 2 25 21 4 17 15 19 11 8 3 5 31 9 22 14 30 26 34 18 16 20 12 28 32 24

    Далее снова два пробела. Для значений 37 и 38 подобные последовательности есть и не единичные, а затем провал. Я даже было отчаялся, следующий десяток оказался полностью пустым, но удача улыбнулась, для N=51 таки находится нужная перестановка.

    вот она
    46 45 1 44 49 39 10 29 21 37 5 32 23 41 51 31 20 11 9 2 43 35 8 27 13 14 25 3 47 40 7 33 16 17 15 19 26 50 28 22 6 38 34 4 30 18 42 48 36 12 24

    Их даже две, но они пересекаются по большей части.

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

    Если свести найденные количества возможных вариантов в одну таблицу, можно построить следующий график



    Ну да, есть над чем помедитировать.

    В исходной задаче не было требования начинать натуральный ряд с единицы. Главное чтобы в последовательности встречались все числа от a до b. Но я пробовал, становится только хуже, вариантов находится еще меньше. Что, собственно, объяснимо. Чем большее число стоит на левой позиции тройки, тем меньшую кратность можно получить суммой двух других, т.е. тем меньше доступных вариантов. Ну а вопрос верхнего предела длин таких последовательностей остается открытым. С ростом размерности вероятность успеха явно снижается, но вот обнуляется ли? Или дальше так и будут, пусть и редко, встречаться такие вот (не)интересные перестановки.

    Напоследок, пожалуй, можно привести код программы-грелки,

    правда, он на Хаскеле
    вариант с учётом комментариев про наибольший общий делитель

    import Data.IntSet (IntSet, notMember, insert, fromList)
    import Control.Parallel.Strategies
    import System.Environment
    
    pvc :: Int -> Int -> Int -> Int -> IntSet -> [[Int]]
    pvc _ 1 a b _  = [[a,b]]
    pvc n k a b xs = 
        let c = a - mod b a
        in  [a:ys | 
            x <- [c, c+a .. n], 
            notMember x xs, 
            k * gcd b x <= n,
            ys <- pvc n (k-1) b x (insert x xs)]
    
    gen :: Int -> [[[Int]]]
    gen n = 
        let ab = [(a, b) | 
                 a <- [1..n], b <- [1..n], 
                 gcd a b == 1, a /= b]
        in  map hlp ab `using` parList rseq
        where
        hlp (a,b) = pvc n (n-1) a b $ fromList [a, b]
    
    main = do
        [n] <- getArgs
        print $ concat $ gen $ read n
    

    AdBlock похитил этот баннер, но баннеры не зубы — отрастут

    Подробнее
    Реклама

    Комментарии 36

      0
      Прочитав название уж испугался, что в 8 классе серьезно проходят перестановки.
        +1
        да, ошибся на год
          0
          Странно, я с перестановками познакомился на первом курсе — для вывода определителя матрицы
            0
            Теперь новая мода — теорвер читают в школе, а со следующего года грозятся ввести в ЕГЭ. И это будут кранты.
              0
              Это же сложная тема — школа разве может нормально объяснить, а у школьников хватит знаний чтобы понять?
              Может сразу комплексный анализ давать и теорию обслуживания?
              Совсем они там с дуба рухнули… сочувствую
        0
        Код на Хаскеле, конечно не соответствует духу времени. Актуален Cobol, на худой конец Fortran или Algol.
          0
          LISP тогда уж. Я его забыть успел, а он помирать не собирается
          0
          Не знаком с Хаскелем, но тупо взял ваш код и попытался запустить в онлайн-сервисах.
          Так вот, все они ругаются, что не понимают вот этого подключения:
          import Control.Parallel.Strategies
            0
            просто удалите ее и удалите половину строки с `using` parList rseq, оставив только in map hlp ab
            эта часть отвечает за распараллеливание вычислений. Одним ядром не согреешься )
              +1
              Для онлайн сервисов нужен, пожалуй, код попроще
              import Data.List (delete)
              
              pvc :: Int -> Int -> [Int] -> [[Int]]
              pvc a b [] = [[a,b]]
              pvc a b xs = [a:ys | 
                  x <- xs, 
                  mod (a + b + x) a == 0, 
                  ys <- pvc b x (delete x xs)]
              
              gen :: Int -> [[Int]]
              gen n = do
                  a <- [1..n]
                  b <- delete a [1..n]
                  pvc a b $ delete a $ delete b [1..n]
              
              main = do
                  putStr "Input N > "
                  n <- readLn
                  print $ gen n
              

              но числа больше 25 лучше не вводить, может быть очень долго
              0
              using System;
              using System.Collections.Generic;
              
              public class Test
              {
                  static int n;
              
                  static IEnumerable<IEnumerable<int>> Solution(List<int> SubResult)
                  {
                      var count = SubResult.Count;
                      if (count == n)
                      {
                          yield return SubResult;
                          yield break;
                      }
                      for (var i = 1; i <= n; i++)
                      {            
                          if (SubResult.Contains(i))
                          {
                              continue;
                          }
                          if ((count >= 2) && ((i+SubResult[count-1]) % SubResult[count-2] != 0))
                          {
                              continue;
                          }
                          SubResult.Add(i);
                          foreach (var c in Solution(SubResult))
                          {
                              yield return c;
                          }
                          SubResult.RemoveAt(count);
                      }
                  }
              
                  public static void Main()
                  {
                      var s = Console.ReadLine();
                      n = Int32.Parse(s);
                      var count = 0;
                      foreach (var c in Solution(new List<int>()))
                      {
                          foreach (var num in c)
                          {
                              Console.Write($"{num} ");
                          }
                          count++;
                          Console.WriteLine();
                      }
                      Console.WriteLine($"Count = {count}");
                      Console.ReadKey();
                  }
              }
                0
                Спасибо, отличный пример задачи класса NP!
                Такой вопрос: сколько времени у вас работала программа для N=51?
                  0
                  Где-то 7-8 часов. Каждый шаг увеличивал время примерно в полтора раза
                  0
                  промахнулся
                    +1
                    Перебор и поиск с возвратом,
                    так тут нужен Пролог!
                    good([_,_]):-!.
                    good([A,B,C|T]):- (A+B+C) mod A=:=0, good([B,C|T]).
                    
                    main(N):-numlist(1,N,X), permutation(X,Sol),good(Sol),writeln(Sol).


                    Попробуйте
                      0
                      Да, занятно, тоже жив, курилка. Но полный перебор я пробовал. Я с этого начал на Питоне, но дальше N=12 не продвинулся. И проблема не (только) в языке, факториал — это круче, чем экспонента.
                      А так да, Вы правы, перебор и поиск с возвратом )
                        +1
                        Согласен, мне кажется, выразительность Прологом хороша,
                        но конечно можно и эффективнее (правда с реверсом):
                        good([_]):-!.
                        good([_,_]):-!.
                        good([A,B,C|T]):- (A+B+C) mod C=:=0, good([B,C|T]).
                        
                        make([],Cur,Sol):-reverse(Cur,Sol).
                        make(X,Cur,Sol) :-select(A,X,T), good([A|Cur]), make(T,[A|Cur],Sol).
                        
                        main(N):-numlist(1,N,X), make(X,[],Sol), writeln(Sol).

                        Смотрите
                          0
                          Пролог прекрасен, спору нет )
                          И если Кложур называют наследником Лиспа, то то же можно сказать и про Хаскель с Прологом. Внешне программы очень похожи.
                          good [_,_] = True
                          good (a:b:c:t) = mod (a+b+c) a == 0 && good (b:c:t)
                            0
                            Спасибо, но я не понял еще этих формализмов )
                            А вот Эрланг действительно похож,
                            вот так работает:
                            good([_]) -> true;
                            good([_,_]) -> true;
                            good([A,B,C|T]) when (A+B+C)rem A=:=0 -> good([B,C|T]);
                            good(_) -> false.
                            
                            perm([])->[[]];
                            perm(L) ->[[X|T] || X<-L, T<-perm(L--[X]), good([X|T])].
                            
                            main(N)->perm(lists:seq(1,N)).
                              0
                              Да, точно, Эрланг. Можно поизучать. Мне Хаскель по книжкам тоже не зашел, а вот курс на Степике здорово помог, Москвин молодец.
                              Но комментарий ниже прекрасно демонстрирует, что это все игрушки, по большому счету. Если нужна производительность — изучай C.
                      +1
                      Я соптимизировал программу на C#, насколько смог, и поставил на ночь, чтобы узнать, есть ли там дальше решения. К сожалению:
                      N: 51; results: 2; Time: 600 sec
                      N: 52; results: 0; Time: 919 sec
                      N: 53; results: 0; Time: 1491 sec
                      N: 54; results: 0; Time: 2033 sec
                      N: 55; results: 0; Time: 2600 sec
                      N: 56; results: 0; Time: 3552 sec
                      N: 57; results: 0; Time: 4415 sec
                      N: 58; results: 0; Time: 6778 sec
                      N: 59; results: 0; Time: 10950 sec
                      N: 60; results: 0; Time: 14867 sec

                        0
                        О, спасибо огромное. А отрицательный результат — тоже результат. Прекрасно показывает разницу в производительности.
                        У Вас, кстати, основание экспоненты роста тоже оказалось около полутора, точнее 1.4 в среднем. А может там e/2?
                          0
                          Действительно, похоже на e/2! Я, правда, не представляю, как это можно доказать (хотя достаточно просто показать, что скорость роста не превосходит e^N). Но например, если доказать, что для большинства последовательностей в переборе алгоритм доходит как минимум до длины N/2, то это даст нижнюю оценку в (e/2)^N.

                          Насчет производительности: к сожалению, из-за экспоненциального роста оптимизация в разы дает только константное увеличение N. Например, даже если я ускорю программу в 10 раз, запустив на компьютере с 40 ядрами (вместо 4), то, в лучшем случае, я смогу проверить только 6-7 дополнительнх значений для N. Надо искать алгоритм с лучшей асимптотикой, но совсем не факт, что он существует.

                          Вообще, имхо, эта задача интересна с точки зрения теории чисел. Например, она в чем-то похожа на проблему нахождения простых чисел Мерсенна (простые числа, на единицу меньшие степени двойки). Их до сих пор найдено только около 50, и до сих пор неизвестно, конечно или бесконечно ли их число.
                            0
                            То, что сложность не превосходит e^N, я, кстати, могу попробовать доказать.

                            Для каждой тройки при произвольной второй позиции количество вариантов для третьего числа однозначно определяется первым числом в тройке и самим числом N.
                            Если первым числом в тройке стоит единица, то на третьей позиции допустимы все N чисел независимо от числа в центре. Если первой идет двойка, то для сохранения делимости допустимы уже не все, а каждое второе число, если тройка — каждое третье и т.д. Т.е. если слева в тройке стоит число k, то при произвольном центре, справа получаем N/k вариантов (округленное вниз, но для верхней оценки это не важно). А поскольку (почти) каждое число в какой-нибудь тройке окажется на первом месте, а центр произволен только для самой левой тройки (в остальных он является третьим числом для соседней тройки, а значит мы его уже посчитали), общее количество вариантов можно оценить произведением этих самых N/k для всех k, т.е. получаем N^N/N!.. Факториал можно оценить формулой Стирлинга и получить искомое O(e^N).

                            Немного «на пальцах», но, думаю, сойдет.

                            А задача действительно занятная, сам не ожидал.
                              0

                              А вы не пробовали заполнять массив с конца.
                              Тогда первое число должно быть делителем суммы двух последующих? Это сильно сократит перебор.

                                0
                                ну вообще говоря и при прямом заполнении используется проверка:
                                (x[n]+x[n-1])%x[n-2] == 0
                                  0

                                  Список делителей для суммы можно посчитать заранее.

                                    0
                                    Да, это одна из первых оптимизаций, которые я пробовал. Удивительно, но это не принесло никакого эффекта, время работы практически не изменилось!
                                    Думаю, что время работы программы линейно зависит от количества перебранных вариантов (то есть, максимальных последовательностей длины N1<=N), а их количество не зависит от того, идем мы с начала или с конца.
                                  0
                                  Не понял, в чем должна быть разница, это все равно, что решать зеркальную задачу. Но ради интереса проверил — суть та же
                                    +1
                                    Я это в конце концов понял, но вначале я рассуждал как Deosis, и мне тоже казалось, что это должно сильно ускорить поиск: для числа n количество его делителей d(n) растет очень медленно, см. ссылку: d(n)=O(n^ε) для любого ε.

                                    Однако, в той же ссылке приведено, что сумма d(n) по всем n<N будет порядка N*lnN.
                                    А при поиске вперед для любого n мы просматриваем N/n вариантов. Если просуммировать, то получим Sum(N/n)=N*Sum(1/n) ~ N*lnN, то есть, в среднем оба метода дают одинаковое количество итераций.
                                  0
                                  Да, я тоже дошел до N^N/N! = O(e^N) ( кстати, получилась хорошая задачка! ), но дальше не смог продвинуться: для улучшения оценки надо учитывать, что, так как все числа должны быть разные, много вариантов для третего числа отбрасываются.
                                  Я, кстати, посчитал количество обработанных последовательностей для каждого N. Что и можно было ожидать, их количество растет ровно с той же скоростью, что и сложность алгоритма:

                                  количество обработанных последовательностей
                                  N;T
                                  1;0
                                  2;2
                                  3;6
                                  4;14
                                  5;44
                                  6;74
                                  7;178
                                  8;356
                                  9;664
                                  10;1108
                                  11;2507
                                  12;3613
                                  13;7492
                                  14;12848
                                  15;17958
                                  16;29204
                                  17;52600
                                  18;82337
                                  19;142021
                                  20;213898
                                  21;288938
                                  22;503015
                                  23;889394
                                  24;1223213
                                  25;1779565
                                  26;3162532
                                  27;4099666
                                  28;6244828
                                  29;10259350
                                  30;14284616
                                  31;22991248
                                  32;34802092
                                  33;46037659
                                  34;76188311
                                  35;101677055
                                  36;143918357
                                  37;220971634
                                  38;362406125
                                  39;463107021
                                  40;629878454
                                  41;1029107063
                                  42;1426971086
                                  43;2321033618
                                  

                            +1
                            Если кому-то захочется поиграться, вот

                            код на c#
                            using System;
                            using System.Collections.Generic;
                            using System.Linq;
                            using System.Text;
                            using System.Threading.Tasks;
                            
                            namespace ShaleNumbers
                            {
                                public class ShaleSequence
                                {
                                    private static readonly object syncRoot = new object();
                            
                                    private int Length;
                                    private int[] Sequence;
                                    private byte[] Bucket;
                            
                                    public ShaleSequence(int N, int a, int b)
                                    {
                                        Sequence = new int[N];
                                        Bucket = new byte[N];
                                        for (int i = 0; i < Bucket.Length; i++) Bucket[i] = 1;
                                        Add(a);
                                        Add(b);
                                    }
                            
                                    public int N => Bucket.Length;
                            
                                    public int[] ToArray() => Sequence.Take(Length).ToArray();
                            
                                    public override string ToString() => String.Join(" ", ToArray());
                            
                                    public bool IsFound => Length == Sequence.Length;
                            
                                    private bool IsSet(int n) => Bucket[n - 1] == 1;
                            
                                    private void Add(int x)
                                    {
                                        Sequence[Length++] = x;
                                        Bucket[x - 1] = 0;
                                    }
                            
                                    private void Remove(int x)
                                    {
                                        Length--;
                                        Bucket[x - 1] = 1;
                                    }
                            
                                    public void Scan()
                                    {
                                        Scan(Sequence[0], Sequence[1]);
                                    }
                            
                                    private void Scan(int a, int b)
                                    {
                                        if (IsFound)
                                        {
                                            string info = ToString();
                                            lock (syncRoot) Console.WriteLine(info);
                                            return;
                                        }
                            
                                        for (int c = a - (b % a); c <= N; c += a)
                                        {
                                            if (!IsSet(c)) continue;
                                            Add(c);
                                            Scan(b, c);
                                            Remove(c);
                                        }
                                    }
                            
                                    public static void FindShaleSequences(int N)
                                    {
                                        DateTime start = DateTime.UtcNow;
                                        List<Task> tasks = new List<Task>();
                            
                                        for (int a = 1; a <= N; a++)
                                        {
                                            for (int b = 1; b <= N; b++)
                                            {
                                                if (a == b) continue;
                            
                                                ShaleSequence sequence = new ShaleSequence(N, a, b);
                                                Task task = Task.Factory.StartNew(sequence.Scan);
                                                tasks.Add(task);
                                            }
                                        }
                                        Task.WaitAll(tasks.ToArray());
                                        DateTime end = DateTime.UtcNow;
                                        Console.WriteLine($"N: {N}; Time: {(int)(end - start).TotalSeconds} sec");
                                    }
                            
                                }
                            
                                public class Program
                                {
                                    public static void Main(string[] args)
                                    {
                                        for(int N = 3; N <= 100; N++)
                                        {
                                            ShaleSequence.FindShaleSequences(N);
                                        }
                                    }
                                }
                            }
                            

                              0
                              Польщен именами, спасибо ) поизучаю.
                              +1
                              Я нашел одну реально работающую оптимизацию, с помощью которой удалось ускорить алгоритм примерно в пять раз, и добить до N=70 (запустив на ночь на восьмиядерной машине). К сожалению,
                              больше последовательностей так и не найдено
                              N: 51; Results: 2; Time: 91 sec
                              N: 52; Results: 0; Time: 89 sec
                              N: 53; Results: 0; Time: 213 sec
                              N: 54; Results: 0; Time: 204 sec
                              N: 55; Results: 0; Time: 336 sec
                              N: 56; Results: 0; Time: 316 sec
                              N: 57; Results: 0; Time: 438 sec
                              N: 58; Results: 0; Time: 453 sec
                              N: 59; Results: 0; Time: 1109 sec
                              N: 60; Results: 0; Time: 974 sec
                              N: 61; Results: 0; Time: 2230 sec
                              N: 62; Results: 0; Time: 2357 sec
                              N: 63; Results: 0; Time: 3099 sec
                              N: 64; Results: 0; Time: 3016 sec
                              N: 65; Results: 0; Time: 4896 sec
                              N: 66; Results: 0; Time: 4462 sec
                              N: 67; Results: 0; Time: 9399 sec
                              N: 68; Results: 0; Time: 9157 sec
                              N: 69; Results: 0; Time: 12960 sec
                              N: 70; Results: 0; Time: 12709 sec

                              Суть оптимизации вот в чем:
                              Понятно, что первые два числа в последовательности не могут быть одновременно четными, так как тогда все остальные числа тоже будут четными. Более того, четных чисел только N/2, поэтому два подряд четных числа могут встретиться только во второй половине последовательности. Аналогично, если два идущих подряд числа делятся на три, то все следующие числа тоже делятся на три, поэтому они могут встретиться только в последней трети последовательности. Обобщая, если два идущих подряд числа a, b имеют наибольший общий делитель g, то индекс числа a не может быть меньше N — N/g. В частности, в первой половине последовательности идущие подряд числа взаимно просты.
                                +1
                                модифицировал ваш алгоритм, а потом увидел ваш комментарий:

                                public static int GCD(int a, int b)
                                        {
                                            if(a<b)
                                            {
                                                int c = a;
                                                a = b;
                                                b = c;
                                            }
                                            int d = a % b;
                                            return (d == 0) ? b : ShaleSequence.GCD(b, d);
                                        }
                                
                                if (a==b || ShaleSequence.GCD(a,b)!=1) continue; //вместо if (a==b) continue;
                                
                                
                                  0
                                  Да! Отличное идея. И не в 5 раз, а на скорее порядок, занятно, что четные длины нередко обрабатываются быстрее предыдущих нечетных.
                                  Жаль, что результат нулевой, но это все равно отличная эвристика. Она именно сокращает дерево перебора. Я все и пытался выяснить как в начале цепочки определить, что потом зайдем в тупик.
                                  И мне кажется основание экспоненты роста уменьшается.

                                Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

                                Самое читаемое