Эксперименты с цифровым корнем

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

Что такое цифровой корень ?

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

Таким образом, можно заключить, что функция вполне тривиальна и реализуется через рекурсию, однако не все было так просто и с первого раза реализовать вычисление этой функции получилось только для для двухзначных чисел… Несмотря на это устойчивую функцию цифрового корня все-таки удалось реализовать:

procedure ciphroot(x)
local s
s := 0
if (*x) = 1 then return x else {
  every i := !x do {
     s +:= i
  }
  if (*s) = 1 then return s else return ciphroot(s)
}
return s
end

Для того, чтобы испытать эту функцию, необходимо ей на выход подать любое целое неотрицательное число: например, для числа 1234 функция ciphroot выдаст 1, а для числа 990 функция выдаст 9.

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

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

procedure colorizeGrid(x,y,w,h)
local i,j,num,col
num := 0
col := ["red","pink","orange","yellow","white","green","cyan","blue","violet","grey"]
every i := 0 to x by w do {
   every j := 0 to y by h do {
      Fg(col[ciphroot(num)+1])
      FillRectangle(i,j,w,h)
      num +:= 1
   }
}
end

где x,y — это размеры окна с графикой, а w,h — длина и ширина «квадратиков» (строго говоря, прямоугольников).

Этот код работает крайне просто: вначале определяется переменная-накопитель num, которая будет отражать номер квадратика в некоторой матрице квадратиков, а также определяется таблица цветов, которыми будут раскрашены квадратики в матрице (очевидно, что цифровой корень принимает значения от 0 до 9, и поэтому потребуется 10 цветов для раскраски), затем в цикле происходит отрисовка самих квадратиков с выбором их цвета (индексация списков в Icon начинается с 1, поэтому потребуется номер цвета на 1 больше, чем значение, выдаваемое функцией цифрового корня).

Экспериментируя с размерами квадратиков можно получать самые разнообразные покрытия узорами, например:

colorizeGrid(500,500,20,20)

выдаст вот такую картинку:

Помимо эффектов с квадратиками, функция цифрового корня в сочетании с периодическими функциями может давать крайне забавный эффект, который я назвал «множественные гармоники».

Итак, код эффекта:

link graphics

procedure main()
local W,i,x,y
W := WOpen("size=500,500")
i := -250
col := ["red","pink","orange","yellow","white","green","cyan","blue","violet","grey"]
while i <= 250 do {
   t := ciphroot(integer(abs(1000*i)))
   f := sin(i/200.0) * t
   Fg(col[t+1])
   DrawPoint(250 + i,250 - 10 * f)
   i +:= 0.001
}
WDone()
end

procedure ciphroot(x)
local s
s := 0
if (*x) = 1 then return x else {
  every i := !x do {
     s +:= i
  }
  if (*s) = 1 then return s else return ciphroot(s)
}
return s
end

И как результат, получаем вот такую забавную картинку:

Немного пояснений о том, как оно работает.

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

Однако, цифровой корень работает только для целых неотрицательных чисел, а в данном отрывке кода он применяется ко всем без исключения числам, в том числе и к отрицательным и к дробным.

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

Исходя из вышеописанного, в принципе можно получить процедуру для получения "спектрального" отображения периодических функций, однако, я этого не сделал :)

Напоследок, скриншоты еще парочки функций: