Форум программистов, компьютерный форум, киберфорум
QBasic
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 4.73/40: Рейтинг темы: голосов - 40, средняя оценка - 4.73
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8

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

01.08.2015, 06:55. Показов 8925. Ответов 120
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Когда я обратился к поисковой системе, то я не нашёл
ни одного упоминания о рекурсии. Испытав шок, я
решил создать эту тему на 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
1
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
01.08.2015, 06:55
Ответы с готовыми решениями:

решение задач с использованием рекурсии
Ув Форумчане подскажите пожалуйста либо ресурс где это можно прочитать мне нужно эту тему расписать помогите пожалуйста :)

Решение задач по обработке информации с включением рекурсии
кто знает как делать? или как должно выглядеть хоть? "Решение задач по обработке информации с включением рекурсии" если кто знает...

Решение задач с применением операции рекурсии к функциям
Добрый день! Помогите написать небольшую процедуру применения операции примитивной рекурсии к функциям g(x) , h(x,y,z) и по переменной...

120
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
03.12.2015, 17:33  [ТС]
Студворк — интернет-сервис помощи студентам
Совсем новое дерево (2000 лет). От Пифагора.

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
REM
REM  ДЕРЕВО ПИФАГОРА
REM
 
DECLARE SUB DRW (x!, y!, l!, a!)
DECLARE SUB RECT (x1!, y1!, l!, a1!)
 
CLS
CONST q = 1.4142
CONST p2 = 1.5708
CONST p4 = .7854
n = 100
 
SCREEN 11
 
CALL DRW(280, 460, n, 0)
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB DRW (x, y, l, a)
IF l > 4 THEN
   z11 = x - l * SIN(a)
   z12 = y - l * COS(a)
   z21 = x - l * SIN(a) + l / q * COS(a + p4)
   z22 = y - l * COS(a) - l / q * SIN(a + p4)
 
   CALL RECT(x, y, l, a)
   CALL DRW(z11, z12, l / q, a + p4)
   CALL DRW(z21, z22, l / q, a - p4)
END IF
END SUB
 
SUB RECT (x1, y1, l, a1)
  
   LINE (x1, y1)-(x1 + l * COS(a1), y1 - l * SIN(a1))
   LINE -(x1 + l * q * COS(a1 + p4), y1 - l * q * SIN(a1 + p4))
   LINE -(x1 + l * COS(a1 + p2), y1 - l * SIN(a1 + p2))
   LINE -(x1, y1)
END SUB
Миниатюры
Решение задач с использованием рекурсии  
1
 Аватар для Pro_grammer
6807 / 2839 / 527
Регистрация: 24.04.2011
Сообщений: 5,308
Записей в блоге: 10
03.12.2015, 19:48
Цитата Сообщение от geh Посмотреть сообщение
Совсем новое дерево (2000 лет). От Пифагора.
У меня тоже получилось!
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
03.12.2015, 20:42  [ТС]
Очень приятно, что я не один.
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
04.12.2015, 10: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
REM
REM  КАНТОРОВО МНОЖЕСТВО
REM
 
DECLARE SUB KVAD (x!, y!, n!, size!)
SCREEN 11
n = 4
 
CALL KVAD(320, 220, n, 100)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB KVAD (x, y, n, size)
 
IF n - 1 > 0 THEN
      s = size / 2
      CALL KVAD(x - size, y + size, n - 1, s)
      CALL KVAD(x - size, y - size, n - 1, s)
      CALL KVAD(x + size, y + size, n - 1, s)
      CALL KVAD(x + size, y - size, n - 1, s)
END IF
LINE (x - size, y - size)-(x + size, y + size), , B
END SUB
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
04.12.2015, 10:35  [ТС]
Добавлена всего одна строка. А каков результат!

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
REM
REM  КАНТОРОВО МНОЖЕСТВО 2
REM
 
DECLARE SUB KVAD (x!, y!, n!, size!)
SCREEN 11
n = 4
 
CALL KVAD(320, 220, n, 100)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB KVAD (x, y, n, size)
 
IF n - 1 > 0 THEN
      s = size / 2
      CALL KVAD(x - size, y + size, n - 1, s)
      CALL KVAD(x - size, y - size, n - 1, s)
      CALL KVAD(x + size, y + size, n - 1, s)
      CALL KVAD(x + size, y - size, n - 1, s)
END IF
LINE (x - size, y - size)-(x + size, y + size), , B
LINE (x + 1 - size, y + 1 - size)-(x - 1 + size, y - 1 + size), 0, BF
END SUB
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
04.12.2015, 16:01  [ТС]
...
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
REM  Круг
 
DECLARE SUB krug (x!, y!, r!, n!)
CLS
SCREEN 11
n = 4
 
CALL krug(320, 240, 80, n)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB krug (x, y, r, n)
   CIRCLE (x, y), r
   k = .3
 
   IF n = 1 THEN EXIT SUB
   CALL krug(x - 2 * r, y, k * r, n - 1)
   CALL krug(x + 2 * r, y, k * r, n - 1)
   CALL krug(x, y - 2 * r, k * r, n - 1)
   CALL krug(x, y + 2 * r, k * r, n - 1)
END SUB
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
04.12.2015, 17:19  [ТС]
Прилагается два рисунка при n=4 и n=6

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
REM
REM КРУГ 4-6
REM
 
DECLARE SUB krug (x!, y!, r!, n!)
CLS
CONST k = .5
SCREEN 11
n = 4
 
CALL krug(320, 240, 200, n)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB krug (x, y, r, n)
   IF n = 1 THEN EXIT SUB
 
   CIRCLE (x, y), r
 
   CALL krug(x + k * r, y, k * r, n - 1)
   CALL krug(x - k * r, y, k * r, n - 1)
   CALL krug(x, y + k * r, k * r, n - 1)
   CALL krug(x, y - k * r, k * r, n - 1)
END SUB
Миниатюры
Решение задач с использованием рекурсии   Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
04.12.2015, 19:12  [ТС]
Если вы дошли до этого места, то предлагаю вам отдохнуть и
посмотреть совсем маленькую программу. Она вычисляет
количество цифр в числе (число положительное)

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
REM
REM Вычисление количества цифр в числе
REM
 
DECLARE FUNCTION KOL% (a AS LONG)
CLS
DIM a AS LONG
INPUT "A = "; a
 
PRINT KOL(a)
END
 
FUNCTION KOL% (a AS LONG)
   IF a < 10 THEN
      KOL = 1
   ELSE
      KOL = 1 + KOL(a \ 10)
   END IF
END FUNCTION
0
 Аватар для Pro_grammer
6807 / 2839 / 527
Регистрация: 24.04.2011
Сообщений: 5,308
Записей в блоге: 10
04.12.2015, 19:36
Ссылка для дальнейшего вдохновения:
Фракталы
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
05.12.2015, 14: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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
REM      Curve of Gilbert
 
DECLARE SUB ABC (x2!, y2!)
DECLARE SUB A (i!)
DECLARE SUB B (i!)
DECLARE SUB C (i!)
DECLARE SUB D (i!)
 
DIM SHARED p
DIM SHARED n
CLS
CLEAR , , 2900
 
p = 5
n = 12
SCREEN 11
PSET (500, 50)
 
CALL A(p)
PRINT "Enter"
SLEEP 0
SCREEN 0
END
 
SUB A (i)
   IF i > 0 THEN
      CALL D(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL A(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL A(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL B(i - 1)
   END IF
END SUB
 
SUB ABC (x2, y2)
   x1 = POINT(0)
   y1 = POINT(1)
   IF x1 <> x2 THEN
      LINE (x1, y1)-(x2, y2)
   ELSE
      LINE (x1, y1)-(x2, y2)
   END IF
END SUB
 
SUB B (i)
   IF i > 0 THEN
      CALL C(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL B(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL B(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL A(i - 1)
   END IF
END SUB
 
SUB C (i)
   IF i > 0 THEN
      CALL B(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL C(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL C(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL D(i - 1)
   END IF
END SUB
 
SUB D (i)
   IF i > 0 THEN
      CALL A(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL D(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL D(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL C(i - 1)
   END IF
END SUB
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
05.12.2015, 14:40  [ТС]
...
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
REM Пружина
 
DECLARE SUB otrezok (l!, ug!, n!)
CLS
SCREEN 11
WINDOW (0, 0)-(800, 2000)
CONST pi = 3.1416
n = 36
PSET (400, 300)
DIM SHARED dx
DIM SHARED dy
dx = 0
dy = 20
 
CALL otrezok(20, 0, n)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB otrezok (l, ug, n)
 
dx = dx + l * COS(ug * pi / 180)
dy = dy + l * SIN(ug * pi / 180)
 
LINE -STEP(dx, dy)
 
IF n = 1 THEN EXIT SUB
CALL otrezok(l + 20, ug + 90, n - 1)
END SUB
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
06.12.2015, 10:55  [ТС]
Программа запрашивает число. И выводит на экран все
делители этого числа. Посмотрите сколь проста и совершенна
рекурсивная процедура. Всего три строчки.
1. Строка 17 - проверка на выход из процедуры
2. Строка 18 - печатает делитель, если он делитель
3. Строка 19 - процедура вызывает сама себя в очередной раз

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
REM       Разлагает числа до 4000
REM Если делитель равен 1, то число простое
REM
 
DECLARE SUB DCH (D AS INTEGER)
CLS
CLEAR , , 28600
DIM SHARED n AS INTEGER
INPUT "N = "; n
 
CALL DCH(n \ 2)
'PRINT FRE(-2)
END
 
SUB DCH (D AS INTEGER)
  
   IF n = 0 THEN EXIT SUB
   IF n MOD D = 0 THEN PRINT D;
   IF D > 1 THEN CALL DCH(D - 1)
END SUB
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
08.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
31
32
33
34
35
36
37
38
39
40
41
42
43
REM
REM        DEREWO 3
REM
 
DECLARE SUB DER (x1!, y1!, x2!, y2!, h!)
 
CLS
CONST f = .3
CONST k = 1.4
h = 130
 
SCREEN 11
WINDOW (-320, 480)-(320, 0)
 
   CALL DER(0, 20, 0, 150, 100)
   CALL DER(0, 50, 0, 150, 100)
   CALL DER(0, 80, 0, 150, 100)
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB DER (x1, y1, x2, y2, h)
   IF h < 20 THEN EXIT SUB
 
   LINE (x1, y1)-(x2, y2)
 
   x11 = x2
   y11 = y2
   
   x12 = x2 + ((x2 - x1) * COS(f) - (y2 - y1) * SIN(f)) / k
   y12 = y2 + ((y2 - y1) * COS(f) + (x2 - x1) * SIN(f)) / k
 
   x21 = x2
   y21 = y2
 
   x22 = x2 + ((x2 - x1) * COS(f) + (y2 - y1) * SIN(f)) / k
   y22 = y2 + ((y2 - y1) * COS(f) - (x2 - x1) * SIN(f)) / k
 
   CALL DER(x11, y11, x12, y12, h / k)
   CALL DER(x21, y21, x22, y22, h / k)
END SUB
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
08.12.2015, 11:41  [ТС]
Это наиболее сложная программа рисующая деревья.
Дерево рисуется по точкам. При желании вы можете его
украсить. Например нарисовать листья. Это просто. Надо
задать массив с координатами листьев и образец одного
листа.
PS.
Деревья меня более не интересуют.
Я сделал основной код ...

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
REM
REM        DEREWO 4
REM
 
DECLARE SUB DER (x1!, y1!, x2!, y2!, x!, y!, h!)
 
CLS
CONST f = .6
CONST k = .63
 
SCREEN 11
WINDOW (-320, 460)-(320, -20)
LINE (-20, 0)-(20, 0)
 
FOR t = 0 TO 3.1416 STEP .01
   x = 16 * COS(t)
   y = 200 * SIN(t)
   CALL DER(0, 0, 0, 180, x, y, 160)
NEXT t
 
PRINT "ENTER"
SLEEP 0
SCREEN 0
END
 
SUB DER (x1, y1, x2, y2, x, y, h)
   IF h < 20 THEN EXIT SUB
 
   PSET (x, y)
 
   x12 = x2 + ((x2 - x1) * COS(f) - (y2 - y1) * SIN(f)) * k
   y12 = y2 + ((y2 - y1) * COS(f) + (x2 - x1) * SIN(f)) * k
 
   x22 = x2 + ((x2 - x1) * COS(f) + (y2 - y1) * SIN(f)) * k
   y22 = y2 + ((y2 - y1) * COS(f) - (x2 - x1) * SIN(f)) * k
 
   xi1 = x2 + ((x - x1) * COS(f) - (y - y1) * SIN(f)) * k
   yi1 = y2 + ((y - y1) * COS(f) + (x - x1) * SIN(f)) * k
 
   xi2 = x2 + ((x - x1) * COS(f) + (y - y1) * SIN(f)) * k
   yi2 = y2 + ((y - y1) * COS(f) - (x - x1) * SIN(f)) * k
 
   CALL DER(x2, y2, x12, y12, xi1, yi1, h * k)
   CALL DER(x2, y2, x22, y22, xi2, yi2, h * k)
END SUB
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
08.12.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
REM
REM Удаление всех пробелов из строки
REM
 
DECLARE SUB PROBEL (s AS STRING)
CLS
 
CONST p = " "
DIM s AS STRING
s = "1 2  34   56 7"
 
PRINT s: PRINT
 
CALL PROBEL(s)
PRINT s
PRINT "LEN(S) ="; LEN(s)
END
 
SUB PROBEL (s AS STRING)
   DIM s1 AS STRING
   DIM s2 AS STRING
  
   IF LEN(s) = 1 THEN
      IF s = p THEN s = ""
   ELSE
      s1 = LEFT$(s, LEN(s) \ 2)
      s2 = MID$(s, LEN(s) \ 2 + 1)
      CALL PROBEL(s1)
      CALL PROBEL(s2)
      s = s1 + s2
   END IF
END SUB
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
09.12.2015, 11:49  [ТС]
Эта программа вычисляет функцию arcsin(x).
Удивительная красота идеального кода не оставит
Вас равнодушными к совершенному творению разума.
Вы будете приходить сюда вновь и вновь ...
Такое не забывается ...

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
REM 
REM   Arcsin(x)
REM
 
DECLARE FUNCTION SSTR$ (x!)
DECLARE FUNCTION arcsin! (x!)
 
CLS
INPUT "X ="; x
 
PRINT "Arcsin(" + SSTR(x) + ") ="; arcsin(x)
END
 
FUNCTION arcsin (x)
 
   IF ABS(x) < .001 THEN
      arcsin = x
   ELSE
      x2 = SQR((1 - SQR(1 - x ^ 2)) / 2)
      arcsin = 2 * SGN(x) * arcsin(x2)
   END IF
END FUNCTION
 
FUNCTION SSTR$ (x)
   SSTR = LTRIM$(STR$(x))
END FUNCTION
Эта формула положена в основу программы. Рекурсия заканчивается
когда x станет по модулю меньше 0,001 и можно будет применить
приближенную формулу arcsin(x)=x (!!)
Миниатюры
Решение задач с использованием рекурсии  
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
09.12.2015, 16:25  [ТС]
Удивительной красоты программа не оставит равнодушным
Вас в ближайшую тысячу лет ...
Эта программа вычисляет натуральный логарифм (ln(x))
Принцип рекурсии прост: ln(x)=2ln(SQR(x)) и так до тех пор
пока x не станет близким к 1, тогда ln(x) = 1 - x (!!!)

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
REM
REM  ln(x)  (x >= 1)
REM
 
DECLARE FUNCTION ln! (x!)
DECLARE FUNCTION SSTR$ (x!)
 
CLS
INPUT "X = "; x
 
PRINT "ln(" + SSTR(x) + ") ="; ln(x)
END
 
FUNCTION ln (x)
 
   IF x < 1.0001 THEN
      ln = x - 1
   ELSE
      ln = 2 * ln(SQR(x))
   END IF
END FUNCTION
 
FUNCTION SSTR$ (x)
   SSTR = LTRIM$(STR$(x))
END FUNCTION
1
 Аватар для vlisp
1064 / 985 / 153
Регистрация: 10.08.2015
Сообщений: 5,375
09.12.2015, 19:23
Цитата Сообщение от geh Посмотреть сообщение
Удивительной красоты программа
А теперь так же элегантно напиши функцию, вычисляющую квадратный корень
И не забывай про комментарии
1
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
10.12.2015, 11:37  [ТС]
Эта программа извлекает квадратный корень из числа,
которое больше 1. Алгоритм прост.
1. Число x приводится к виду x=100^k*x, где новое х лежит
в интервале (1, 100). Далее используется метод половинного
деления. И при выводе результата нам остается умножить
найденное число на величину 10^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
29
30
31
32
33
34
35
36
37
DECLARE FUNCTION y! (z!)
DECLARE SUB QQ (a!, b!)
DECLARE FUNCTION SSTR$ (x!)
CLS
DIM SHARED c
DIM SHARED d
CLEAR , , 28000
INPUT "x = "; x
 
DO WHILE x > 100
  x = x / 100
  k = k + 1
LOOP
d = x
 
CALL QQ(1, x)
PRINT "SQR(" + SSTR(d) + ") = "; c * 10 ^ k
END
 
SUB QQ (a, b)
 
   IF ABS(b - a) < .00001 THEN
      c = (a + b) / 2
   ELSE
      c = (a + b) / 2
      IF y(a) * y(c) <= 0 THEN b = c ELSE a = c
      CALL QQ(a, b)
   END IF
END SUB
 
FUNCTION SSTR$ (x)
   SSTR = LTRIM$(STR$(x))
END FUNCTION
 
FUNCTION y (z)
   y = z ^ 2 - d
END FUNCTION
0
Регистрация: 23.10.2013
Сообщений: 5,076
Записей в блоге: 8
10.12.2015, 21:16  [ТС]
Здесь я написал универсальную программу, вычисляющую
квадратный корень. В основу положена рекурсия вида
SQR(x)=a*SQR(x/a^2) (при x > 1 и a > 1)
Конкретно
SQR(x)=1.01*SQR(x/1.01^2) = 1.01*SQR(x/1.0201)
А для x < 1 формула имеет такой вид
SQR(x)=SQR(1.01^2*x)/1.01 = SQR(1.0201*x)/1.01

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
REM
REM  Вычисление квадратного корня
REM
 
DECLARE FUNCTION QQ (x!)
DECLARE FUNCTION SSTR$ (x!)
CLS
CLEAR , , 20000
INPUT "x = "; x
 
PRINT "SQR(" + SSTR(x) + ") = "; QQ(x)
END
 
FUNCTION QQ (x)
 
   IF ABS(x - 1) < .01 THEN
      QQ = 1 + (x - 1) / 2 - (x - 1) ^ 2 / 8
   ELSE
      IF x >= 1 THEN QQ = 1.01 * QQ(x / 1.0201)
      IF x < 1 THEN QQ = QQ(1.0201 * x) / 1.01
   END IF
END FUNCTION
 
FUNCTION SSTR$ (x)
   SSTR = LTRIM$(STR$(x))
END FUNCTION
А это формула для выхода из рекурсии.
Она более точно извлекает квадратный корень
Миниатюры
Решение задач с использованием рекурсии  
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
10.12.2015, 21:16
Помогаю со студенческими работами здесь

Решение задачи с использованием рекурсии
Здравствуйте. Возникли затруднения с решением задачи. Задача: Пусть {a}_{1}=u; {b}_{1}=v; {a}_{i}=\frac{{2}^{i}}{{a}_{i-1}*{b}_{i-1}};...

Решение уравнения 0.7х = 2 с использованием рекурсии
Здравствуйте, форумчане! Возникла такая вот проблемка: как решить уравнение 0.7х = 2 с помощью рекурсии. Вот код, который не работает...

Решение уравнения методом бисекции с использованием рекурсии
Добрый день! Задачу задали в универе... Написать-то написал, сам метод халявный, но с рекурсией что-то запарился. 1....

Решение задач с использованием процедур
Написать процедуру рисования фигуры из звездочек: ******** *** *** ** ** * * * * ** ** *** *** ********

Решение задач с использованием процедур
Написать процедуру рисования фигуры из звездочек: ******** *** *** ** ** * * * * ** ** *** *** ********


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
100
Ответ Создать тему
Новые блоги и статьи
SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий
8Observer8 02.03.2026
Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11680&amp;d=1772460536 Одним из. . .
Реалии
Hrethgir 01.03.2026
Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .
Ритм жизни
kumehtar 27.02.2026
Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .
SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten
8Observer8 27.02.2026
Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами
8Observer8 20.02.2026
Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .
Конвертировать закладки radiotray-ng в m3u-плейлист
damix 19.02.2026
Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI
Eddy_Em 18.02.2026
Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .
Камера Toupcam IUA500KMA
Eddy_Em 12.02.2026
Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru