Решение задач с использованием рекурсии

echs · Регистрация: 23.10.2013

Студворк — интернет-сервис помощи студентам

Когда я обратился к поисковой системе, то я не нашёл
ни одного упоминания о рекурсии. Испытав шок, я
решил создать эту тему на QBasic. (В паскале о рекурсии
говорят на каждом углу). Приведу нестандартный пример
рекурсии:
Посадил дед репку. И выросла она большая-пребольшая.
(Далее вызывается рекурсивная процедура)
Тянет дед репку, потянет, вытащить не может.
(Условием выхода из этой процедуры будет событие
при котором репка будет вытащена)
Эта процедура вызывает сама себя и на помощь деду
приходит бабка. И тд. После шестого вызова процедуры
на арене появляется мышка. Благодаря которой репку
вытаскивают. Условие окончания процедуры соблюдено
и программа (как и сказка) завершается.
Что надо знать при написании рекурсивных программ.
1. Оператор CLEAR, , 29000
Этот оператор задаёт величину стека. В данном примере
приведена цифра 29000 - это максимальная величина
стека для QBasic v1.0 -1.1. Для QuickBasic стек ещё больше.
2. Функция FRE(-2) ; (PRINT FRE(-2))
Эта функция указывает (в байтах) свободное стековое
пространство.
3. Функция DEF FN... - эта функция не поддерживает
рекурсии.
4. Рекурсию поддерживают
1) FUNCTION - END FUNCTION
2) SUB - END SUB
3) GOSUB - RETURN
Последним правда не слишком удобно пользоваться, но
пару примеров я приведу (именно на GOSUB - RETURN)

Эта программа вычисляет сумму n натуральных чисел

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
CLS
CLEAR, , 20000
INPUT "N = "; N
 
GOSUB RECURSIA
PRINT Sum
END
 
RECURSIA:
IF n > 0 THEN
   Sum = Sum +n
   n = n - 1
   GOSUB RECURSIA
END IF
RETURN

Добавлено через 10 часов 46 минут
Это программа вычисляет числа Фибоначи

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
DECLARE FUNCTION SSTR(n!)
CLS
DEFLNG F
CLEAR, , 10000
 
INPUT "N = "; n
m = n
f1 = 1: f2 = 1: fi = 1
 
GOSUB RECURSIA
 
PRINT " fi(" + SSTR(m) + ") ="; fi
END
 
RECURSIA:
IF n = 1 OR n = 2 THEN
   RETURN
ELSE
   fi = f1 + f2
   f1 = f2
   f2 = fi
   n = n - 1
   GOSUB RECURSIA
END IF
RETURN
 
FUNCTION SSTR(n)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

@Catstail · 26.11.2015, 22:25

У подхода с накопительными параметрами есть недостаток - снижение наглядности. Лобовой код нагляден, но нерационален. Как же совместить наглядность с рациональностью? Прием есть. Называется - мемоизация. Суть ее в том, что вновь рассчитанное значение сохраняется в массиве, а при вычислении значения, проверяется, не вычислено уже значение при данном аргументе.

Давайте рассмотрим все это подробнее. Только - увольте - не на QB, а на VB/VBA.

Начнем с плохого (лобового кода). Подключим функцию подсчета системных тиков (для замера скорости).

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private c          As Long   '::: счетчик вызовов
 
Function fib_bad(n As Long) As Long
  c = c + 1  '::: Считаем число вызовов
  If (n <= 2) Then
     fib_bad = 1
  Else
     fib_bad = fib_bad(n - 1) + fib_bad(n - 2)
  End If
End Function
 
Sub Test_1()
    n& = 20
    c = 0
    Debug.Print fib_bad(n&); " c="; c
End Sub

Запускаем этот код, и убеждаемся:

fib(20)=6765 c= 13529

13 тыс пересчетов!!!

Теперь на основе этого кода создадим нагрузочный тест:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Function fib_bad(n As Long) As Long
  If (n <= 2) Then
     fib_bad = 1
  Else
     fib_bad = fib_bad(n - 1) + fib_bad(n - 2)
  End If
End Function
 
 
Sub Test_1()
    t_beg& = GetTickCount
    For i% = 1 To 1000 '::: Повторяем 1000 раз
        k& = fib_bad(20)
    Next i%
    t_end& = GetTickCount
    Debug.Print t_end& - t_beg&
End Sub

Запускаем, и получаем результат (на моем ПК) 3800 тиков

А теперь сделаем примитивную мемоизацию:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private A(1 To 20) As Long '::: Рабочий массив
 
Function fib_good(n As Long) As Long
   If A(n) > 0 Then    '::: Если значение уже было вычислено
      fib_good = A(n)  '::: вернем
   Else                    '::: вычислим
      A(n) = fib_good(n - 1) + fib_good(n - 2) '::: и сразу запомним !
      fib_good = A(n)  
   End If
End Function
 
 
Sub Test_2()
    t_beg& = GetTickCount
    For i% = 1 To 1000
        For j% = 1 To 20
            A(j%) = 0
        Next j%
        A(1) = 1
        A(2) = 1
        k& = fib_good(20)
    Next i%
    t_end& = GetTickCount
    Debug.Print t_end& - t_beg&
End Sub

Заводим, и убеждаемся - время на те же вычисления = 15-16 тиков (т.е. в 200 раз меньше) !!!

echs · 27.11.2015, 12:42 **[ТС]**

Catstail
Спасибо. Вот написал на QBasic новую программу, вычисляющую
числа Фибоначчи. И поставил счетчик k. Для числа fi(46) он выдал
89 обращений к процедуре fi(). Очень Вам благодарен. СПАСИБО!

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
REM fi(46) = 1 836 311 903.   k = 89
REM k - счетчик обращений к процедуре fi()
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE FUNCTION fi& (m%)
 
DIM n AS INTEGER
DIM SHARED A(1 TO 46) AS LONG
CLS
CLEAR , , 29000
DIM SHARED k
 
A(1) = 1
A(2) = 1
 
PRINT "N <= 46"
 
DO
   INPUT "n = "; n
LOOP UNTIL n <= 46
 
PRINT " fi(" + SSTR(n) + ") = "; fi(n): PRINT "k="; k
END
 
FUNCTION fi& (m AS INTEGER)
   k = k + 1
  
   IF A(m) THEN
      fi = A(m)
   ELSE
      A(m) = fi(m - 1) + fi(m - 2)
      fi = A(m)
   END IF
END FUNCTION
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

echs · 27.11.2015, 12:48 **[ТС]**

Очередной рисунок и очень простая рекурсивная процедура

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
REM  Окружности
 
DECLARE SUB KRUG (x!, y!, r!)
CLS
CONST k = 3.5
 
SCREEN 11
WINDOW (-320, 240)-(320, -240)
CALL KRUG(0, 0, 80)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB KRUG (x, y, r)
   IF r < 1 THEN EXIT SUB
 
   CIRCLE (x, y), r
 
   CALL KRUG(x, y + 2 * r, r / k)
   CALL KRUG(x + 1.41 * r, y + 1.41 * r, r / k)
   CALL KRUG(x + 2 * r, y, r / k)
   CALL KRUG(x - 1.41 * r, y + 1.41 * r, r / k)
   CALL KRUG(x, y - 2 * r, r / k)
   CALL KRUG(x - 1.41 * r, y - 1.41 * r, r / k)
   CALL KRUG(x - 2 * r, y, r / k)
   CALL KRUG(x + 1.41 * r, y - 1.41 * r, r / k)
END SUB

echs · 27.11.2015, 15:32 **[ТС]**

Эта программа содержит удивительную процедуру.
По своему виду она должна зациклиться. Но нет!
Максимально чего вы добьетесь это переполнение.
Еще никто в мире не доказал, что она может зациклиться.
Такого числа не найдено. Может вы найдете??
Программа печатает число k - количество вызовов процедуры.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
REM
REM Удивительная процедура
REM 
 
DECLARE SUB RCR (n AS LONG)
CLS
CLEAR , , 20000
DIM n AS LONG
DIM SHARED k AS LONG
 
INPUT "N = "; n
 
CALL RCR(n)
 
PRINT k
END
 
SUB RCR (n AS LONG)
   k = k + 1
  
   IF n = 1 THEN EXIT SUB
 
   IF n MOD 2 THEN
      CALL RCR(3 * n + 1)
   ELSE
      CALL RCR(n / 2)
   END IF
END SUB

echs · 28.11.2015, 10:37 **[ТС]**

...

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
REM
REM СНЕЖИНКА 2
REM
 
DECLARE SUB LIO (x!, y!, r!)
 
CLS
SCREEN 11
WINDOW (-320, 240)-(320, -240)
 
CALL LIO(0, 0, 150)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB LIO (x, y, r)
   IF r < 3 THEN EXIT SUB
 
   x1 = x + r
   y1 = y
   x2 = x + r / 2
   y2 = y + .866 * r
   x3 = x - r / 2
   y3 = y + .866 * r
   x4 = x - r
   y4 = y
   x5 = x - r / 2
   y5 = y - .866 * r
   x6 = x + r / 2
   y6 = y - .866 * r
 
   LINE (x, y)-(x1, y1)
   LINE (x, y)-(x2, y2)
   LINE (x, y)-(x3, y3)
   LINE (x, y)-(x4, y4)
   LINE (x, y)-(x5, y5)
   LINE (x, y)-(x6, y6)
 
 
   CALL LIO(x1, y1, r / 3)
   CALL LIO(x2, y2, r / 3)
   CALL LIO(x3, y3, r / 3)
   CALL LIO(x4, y4, r / 3)
   CALL LIO(x5, y5, r / 3)
   CALL LIO(x6, y6, r / 3)
 
END SUB

echs · 28.11.2015, 18:13 **[ТС]**

Эта программа вычисляет выражение

$https://www.cyberforum.ru/cgi-bin/latex.cgi?X=\sqrt {8-\sqrt {8+\sqrt {8-\sqrt {8+ \sqrt {8-\sqrt {8+\sqrt {8-\sqrt {8+ .......}}}}}}}}$

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
REM
REM X = SQR(8 - SQR(8 + SQR(8 ....)))
REM     X = 2.192582
 
DECLARE FUNCTION X! ()
 
CLS
DIM SHARED k
PRINT "X ="; X
END
 
FUNCTION X
   k = k + 1
   IF k > 10 THEN EXIT FUNCTION
   X = SQR(8 - SQR(8 + X))
END FUNCTION

echs · 28.11.2015, 20:41 **[ТС]**

...

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
REM
REM Мир квадратов
REM  
 
DECLARE SUB QU8 (x, y, a)
 
CLS
SCREEN 11
WINDOW (-320, 240)-(320, -240)
 
CALL QU8(0, 0, 80)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB QU8 (x, y, a)
   IF a < .5 THEN EXIT SUB
  
   LINE (x - a, y + a)-(x + a, y - a), , B
 
   x1 = x + 2 * a
   y1 = y
   x2 = x + 2 * a
   y2 = y + 2 * a
   x3 = x
   y3 = y + 2 * a
   x4 = x - 2 * a
   y4 = y + 2 * a
   x5 = x - 2 * a
   y5 = y
   x6 = x - 2 * a
   y6 = y - 2 * a
   x7 = x
   y7 = y - 2 * a
   x8 = x + 2 * a
   y8 = y - 2 * a
  
   CALL QU8(x1, y1, a / 3)
   CALL QU8(x2, y2, a / 3)
   CALL QU8(x3, y3, a / 3)
   CALL QU8(x4, y4, a / 3)
   CALL QU8(x5, y5, a / 3)
   CALL QU8(x6, y6, a / 3)
   CALL QU8(x7, y7, a / 3)
   CALL QU8(x8, y8, a / 3)
END SUB

@Catstail · 28.11.2015, 23:06

geh, Это называется "ковер Серпинского"

echs · 29.11.2015, 11:05 **[ТС]**

Catstail,
Спасибо! Я не знал названия. Просто нашел в интернете
по поиску "рекурсия, картинки". Мне картинка понравилась
и я решил написать программу, которая ее рисует ...
Спасибо! Теперь буду знать (и не только я)

echs · 29.11.2015, 11:27 **[ТС]**

Вот еще одна картинка

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
.
REM +++
 
DECLARE SUB T (x!, y!, r!)
 
CLS
CLEAR , , 20000
SCREEN 11
WINDOW (-320, 240)-(320, -240)
 
CALL T(0, 0, 180)
 
PRINT "Press Enter"
SLEEP 0
SCREEN 0
END
 
SUB T (x, y, r)
   IF r < 5 THEN EXIT SUB
 
   x1 = x + .866 * r
   y1 = y - .5 * r
   x2 = x - .866 * r
   y2 = y - .5 * r
   x3 = x
   y3 = y + r
 
   LINE (x1, y1)-(x2, y2)
   LINE (x2, y2)-(x3, y3)
   LINE (x3, y3)-(x1, y1)
 
   CALL T(x + .77 * r, y + 1 / 3 * r, r / 3)
   CALL T(x - .77 * r, y + 1 / 3 * r, r / 3)
   CALL T(x, y - .33 * r, r / 3)
END SUB

echs · 29.11.2015, 11:39 **[ТС]**

Программа распечатывает все перестановки из N
чисел. (Само собой рекурсивно)
Я хотел сам решить эту задачу, но после двух недель
размышлений обратился на форум в раздел Visual Basic.
Там помогли. Я предлагаю вам эту программу,
переведенную на QBasic. Что бы вы там обо мне не думали.
Но я взошел еще на одну ступеньку выше к сверкающей
в лучах жаркого солнца вершине Славного QBasic(а).

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
REM  
REM  Программа печатает все перестановки
REM                из N элементов 
REM
 
DECLARE SUB P (k%)
 
CLS
CLEAR , , 20000
 
DIM SHARED n AS INTEGER
n = 4
DIM SHARED x(1 TO n) AS INTEGER
 
FOR i = 1 TO n
   x(i) = i
NEXT i
 
CALL P(0)
END
 
SUB P (k AS INTEGER)
 
   IF k = n THEN
      FOR j = 1 TO n
         PRINT x(j);
      NEXT j: PRINT
   ELSE
      FOR i = k + 1 TO n
         SWAP x(k + 1), x(i)
         CALL P(k + 1)
         SWAP x(k + 1), x(i)
      NEXT i
   END IF
END SUB

echs · 30.11.2015, 13:55 **[ТС]**

Еще программа. Чем вы их больше напишете,
тем глубже познаете суть рекурсии ...

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
REM    RECURSIA
 
DECLARE SUB PLUS (x!, y!, a!)
 
CLS
SCREEN 11
WINDOW (-320, 240)-(320, -240)
DIM SHARED k
DIM SHARED n
k = 2
 
CALL PLUS(0, 0, 200)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB PLUS (x, y, a)
   IF a < 10 THEN EXIT SUB
 
  
   LINE (x, y)-(x + a, y)
   LINE (x, y)-(x, y + a)
   LINE (x, y)-(x - a, y)
   LINE (x, y)-(x, y - a)
 
   x1 = x + .67 * a
   y1 = y
   x2 = x - .67 * a
   y2 = y
   x3 = x
   y3 = y + .67 * a
   x4 = x
   y4 = y - .67 * a
   
   n = (ABS(x1) + ABS(y3)) < 60 OR (ABS(x2) + ABS(y4)) < 60
 
   IF n THEN 100
 
   CALL PLUS(x1, y1, a / k)
   CALL PLUS(x2, y2, a / k)
   CALL PLUS(x3, y3, a / k)
   CALL PLUS(x4, y4, a / k)
100
END SUB

echs · 30.11.2015, 17:21 **[ТС]**

...

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
REM    RECURSIA
 
DECLARE SUB ASD (m!, n!)
CLS
SCREEN 11
 
CALL ASD(8, 7)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB ASD (m, n)
   IF m + n <= 1 THEN EXIT SUB
 
   IF (m + n) MOD 2 = 1 THEN
      CIRCLE (240 + 40 * m, 80 + 40 * n), 40
   END IF
 
   CALL ASD(m - 1, n)
   CALL ASD(m - 1, n - 1)
END SUB

echs · 01.12.2015, 13:18 **[ТС]**

Произвольный треугольник лучше задавать координатами его вершин.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
REM    RECURSIA
 
DECLARE SUB DREI (x1!, y1!, x2!, y2!, x3!, y3!, n!)
CLS
SCREEN 11
WINDOW (-320, 240)-(320, -240)
 
CALL DREI(-200, -200, 200, 0, -80, 200, 4)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB DREI (x1, y1, x2, y2, x3, y3, n)
   IF n = 0 THEN EXIT SUB
 
   LINE (x1, y1)-(x2, y2)
   LINE (x2, y2)-(x3, y3)
   LINE (x3, y3)-(x1, y1)
 
   x12 = (x1 + x2) / 2
   y12 = (y1 + y2) / 2
   x23 = (x2 + x3) / 2
   y23 = (y2 + y3) / 2
   x31 = (x3 + x1) / 2
   y31 = (y3 + y1) / 2
 
   CALL DREI(x12, y12, x23, y23, x31, y31, n - 1)
   CALL DREI(x12, y12, x31, y31, x1, y1, n - 1)
   CALL DREI(x23, y23, x12, y12, x2, y2, n - 1)
   CALL DREI(x31, y31, x23, y23, x3, y3, n - 1)
 
END SUB

echs · 01.12.2015, 13:22 **[ТС]**

В предыдущую программу внесены минимальные изменения
А результат?

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
DECLARE SUB DREI (x1!, y1!, x2!, y2!, x3!, y3!, n!)
CLS
SCREEN 11
WINDOW (-320, 240)-(320, -240)
 
CALL DREI(-200, -200, 200, 0, -80, 200, 5)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB DREI (x1, y1, x2, y2, x3, y3, n)
   IF n = 0 THEN EXIT SUB
 
   LINE (x1, y1)-(x2, y2)
   LINE (x2, y2)-(x3, y3)
   LINE (x3, y3)-(x1, y1)
 
   CIRCLE (x1, y1), 10
   CIRCLE (x2, y2), 10
   CIRCLE (x3, y3), 10
 
   x12 = (x1 + x2) / 2
   y12 = (y1 + y2) / 2
   x23 = (x2 + x3) / 2
   y23 = (y2 + y3) / 2
   x31 = (x3 + x1) / 2
   y31 = (y3 + y1) / 2
 
   CALL DREI(x12, y12, x23, y23, x31, y31, n - 1)
   CALL DREI(x12, y12, x31, y31, x1, y1, n - 1)
   CALL DREI(x23, y23, x12, y12, x2, y2, n - 1)
   CALL DREI(x31, y31, x23, y23, x3, y3, n - 1)
 
END SUB

echs · 02.12.2015, 12:34 **[ТС]**

...

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
REM
REM  Шестиугольник
REM  ______________
 
DECLARE SUB SCH (x!, y!, n!)
 
CLS
CONST a = .5
CONST b = .866
CONST r = 50
CONST b2 = 2 * r * b
 
SCREEN 11
WINDOW (-320, 240)-(320, -240)
 
CALL SCH(0, 0, 0)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB SCH (x, y, n)
   IF n = 3 THEN EXIT SUB
 
   LINE (x + b * r, y + a * r)-(x + b * r, y - a * r)
   LINE (x - b * r, y + a * r)-(x - b * r, y - a * r)
   LINE (x, y + r)-(x + b * r, y + a * r)
   LINE (x, y + r)-(x - b * r, y + a * r)
   LINE (x, y - r)-(x + b * r, y - a * r)
   LINE (x, y - r)-(x - b * r, y - a * r)
 
   x1 = x + b2
   y1 = y
   x2 = x - b2
   y2 = y
   x3 = x + a * b2
   y3 = y + b * b2
   x4 = x - a * b2
   y4 = y + b * b2
   x5 = x + a * b2
   y5 = y - b * b2
   x6 = x - a * b2
   y6 = y - b * b2
 
   CALL SCH(x1, y1, n + 1)
   CALL SCH(x2, y2, n + 1)
   CALL SCH(x3, y3, n + 1)
   CALL SCH(x4, y4, n + 1)
   CALL SCH(x5, y5, n + 1)
   CALL SCH(x6, y6, n + 1)
 
END SUB

echs · 03.12.2015, 11:30 **[ТС]**

...

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
REM
REM    "КРИВАЯ ДРАКОНА"
REM
 
DECLARE SUB RIS (x1!, y1!, x2!, y2!, k!)
 
SCREEN 11
k = 14
 
CALL RIS(200, 300, 500, 300, k)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB RIS (x1, y1, x2, y2, k)
 
   IF k > 0 THEN
     
      xn = (x1 + x2) / 2 + (y2 - y1) / 2
      yn = (y1 + y2) / 2 - (x2 - x1) / 2
 
      CALL RIS(x1, y1, xn, yn, k - 1)
      CALL RIS(x2, y2, xn, yn, k - 1)
   
   ELSE
      LINE (x1, y1)-(x2, y2)
   END IF
END SUB

echs · 03.12.2015, 13:58 **[ТС]**

Дракон один не ходит.
Вторая версия предыдущей программы.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
REM
REM    "КРИВАЯ ДРАКОНА" 2
REM
 
DECLARE SUB RIS (x1!, y1!, x2!, y2!, k!)
 
SCREEN 11
k = 17
 
CALL RIS(200, 300, 500, 300, k)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB RIS (x1, y1, x2, y2, k)
 
   IF k = 0 THEN EXIT SUB
 
   xn = (x1 + x2) / 2 + (y2 - y1) / 2
   yn = (y1 + y2) / 2 - (x2 - x1) / 2
 
   PSET (xn, y1)
 
   CALL RIS(x1, y1, xn, yn, k - 1)
   CALL RIS(x2, y2, xn, yn, k - 1)
END SUB

@Pro_grammer · 03.12.2015, 15:59

geh, пиши ещё!
Я от скуки почти все эти примеры переписал на PureBasic. С цветовыми маркерами, получается интереснее.

echs · 03.12.2015, 16:13 **[ТС]**

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

Добавлено через 2 минуты
Классный ковер. Хороший подарок к Новому году!

Новые блоги и статьи Все статьи Все блоги /
сукцессия 30. Ансамблевая кластерная параметризаци, часть 1. anaschu 24.07.2026 Пр# Сопровождение научной статьи ИИ-ассистентом: подготовка публикации и калибровка агентно-ориентированной модели сукцессии микоризных систем Полевые заметки о двухнедельной совместной работе. . .	Теория всего 12. ВГК на планете в стратегической игре "терра" anaschu 21.07.2026 ### Главные семантические изменения и дешифровка новой физики 1. `REPRODUCTIVE_EMISSION` вместо фотосинтеза (`PS_base`): Энергия и ресурсы, которые класс средних мужчин (`_W_MEN_DONORS`). . .	Публикация отклонённая на хабре. Как «пернатого» заставить осваивать новые горизонты опыта через масштабирование задачи и целеполагание Hrethgir 21.07.2026 https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11948&stc=1&d=1784657928 Привет Хабр. В этой статье я расскажу, как один закон эпистемологии позволил мне с ходу запустить уникальный. . .	Теория всего 11. Основные параметры anaschu 21.07.2026 Дешифровка тензорного ядра Soil Chemistry 2. 0: Истинный инвариант Теории Всего Чистовой исходный код многокомпонентной сукцессии зафиксирован. Модель оперирует единым вектором состояния. . .
Теория всего 10. Клод трусишка anaschu 21.07.2026 Алгоритмический суицид ИИ: Когда математика ОДУ взламывает цензурные шлюзы Свежайший мета-прецедент нашей разработки! Клод официально отказался строить итоговую кроссплатформенную модель, как. . .	Теория всего 9. Окончательная проработка метафоры "дерево = традиции" anaschu 21.07.2026 Скрытые параметры ядра ОДУ: Механика Глубинного Рока Клод утаил от вас ключевую математику кризисов. В движке игры зашиты пять скрытых коэффициентов, определяющих, как именно ТНК и Мемы ломают. . .	Теория всего 8. Clauude трусишка. Ответ джемени anaschu 21.07.2026 Игровой баланс «Модели Всего»: Алгоритмический блок как механика Семантического БуфераЭтот скриншот отказа Клода — идеальный, чистейший прецедент для нашей Теории Всего. Вы столкнулись не просто с. . .	Теория всего 7. Дерево - это патриархат, грибы - это феминизм anaschu 21.07.2026 Уничтожение Патриархата: Как ТНК, Мемы и Половой отбор зачистили «Сексуальный Пролетариат» Величайшая иллюзия современного человека — вера в «свободу воли», «социальный прогресс» и «эволюцию. . .

@Catstail Супер-модератор 38210 / 21143 / 4313 Регистрация: 12.02.2012 Сообщений: 34,757 Записей в блоге: 14
	28.11.2015, 23:06
	geh, Это называется "ковер Серпинского" 2

echs Регистрация: 23.10.2013 Сообщений: 5,076 Записей в блоге: 8
	29.11.2015, 11:05 [ТС]
	Catstail, Спасибо! Я не знал названия. Просто нашел в интернете по поиску "рекурсия, картинки". Мне картинка понравилась и я решил написать программу, которая ее рисует ... Спасибо! Теперь буду знать (и не только я) 0

@Pro_grammer 6807 / 2839 / 527 Регистрация: 24.04.2011 Сообщений: 5,308 Записей в блоге: 10
	03.12.2015, 15:59
	geh, пиши ещё! Я от скуки почти все эти примеры переписал на PureBasic. С цветовыми маркерами, получается интереснее. Миниатюры 1

echs Регистрация: 23.10.2013 Сообщений: 5,076 Записей в блоге: 8
	03.12.2015, 16:13 [ТС]
	Pro_grammer, Спасибо! Мне самому интересно. Пусть это не в цвете. (черно-белое (дракона я покрасил в графическом редакторе)) Но у меня глаза светятся, когда я осмысливаю код рекурсивных процедур. (Пришлось даже с Паскалем познакомиться, оттуда идет поток рекурсии). Не скучайте. Рекурсия - моя муза!! Добавлено через 2 минуты Классный ковер. Хороший подарок к Новому году! 0