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

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

@CoderHuligan · 01.08.2015, 18:06

Сообщение от geh

2. Функция FRE(-2) ; (PRINT FRE(-2))
Эта функция указывает (в байтах) свободное стековое
пространство.

И одновременно очищает все переменные и массивы

echs · 01.08.2015, 18:19 **[ТС]**

Вы неправы. Очищает все переменные и массивы
оператор CLEAR. Все нормально. Мне это известно.
Однако спасибо!

@CoderHuligan · 01.08.2015, 18:23

Да вы правы. Спутал с clear

echs · 01.08.2015, 18:46 **[ТС]**

Возведение в целую степень числа а.
Рекуррентная формула: f(n)= a^n
0 при а = 0
1 при n = 0
f(n - 1)*a при n > 0
f(n + 1)/a при n < 0

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
DECLARE FUNCTION f! (n%)
 
DIM n AS INTEGER
DIM SHARED a
 
CLS
CLEAR, , 29000
INPUT "a, n = "; a, n
IF a = 0 THEN
   PRINT " a^n = "; 0
ELSE
   PRINT " a^n = "; f(n)
END IF
END
 
FUNCTION f! (n AS INTEGER)
   IF n = 0 THEN
      f = 1
   ELSE
      IF n > 0 THEN f = f(n - 1)*a
      IF n < 0 THEN f = f(n - 1)/a
   END IF
END FUNCTION

echs · 03.08.2015, 14:18 **[ТС]**

Быстрое возведение в целую степень числа а.
Определение рекуррентной формулы
f(n) = a^n
f(n) = 1 при n = 0
= f(n \ 2)^2 при чётном n
= a * f(n \ 2)^2 при нечётном n

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
DECLARE FUNCTION F!(N%)
 
DIM N AS INTEGER
DIM SHARED A
 
CLS
CLEAR, , 20000
INPUT "A, N = "; A, N
IF N > 0 THEN
   PRINT A; " ^"; N; "="; F(N)
ELSE
   PRINT A; " ^"; N; "="; 1/F(N)
END IF
END
 
FUNCTION F!(N AS INTEGER)
   IF N = 0 THEN
      F = 1
   ELSE
      IF N MOD 2 THEN F = A * F(N \ 2)^2 ELSE F = F(N \ 2)^2
   END IF
END FUNCTION

Добавлено через 18 часов 51 минуту

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   немало рекуррентных определений.
REM   Вот одно из них (менее известное).
REM   Рекуррентное определение умножения
REM   целых чисел a, b.       a*b= f(a, b) =
REM                        0                              при  b = 0
REM    f(10*a, b \ 10) + a*(b MOD 10) при  b > 0
 
DECLARE FUNCTION f& (a&, b&)
DEFLNG A-B
 
CLS
CLEAR , , 29000
INPUT "a,b = "; a, b
PRINT "A * B = "; f(a, b)
END
 
DEFSNG A-B
FUNCTION f& (a AS LONG, b AS LONG)
DEFINT A-B
 
   IF b THEN
      f = f(10 * a, b \ 10) + a * (b MOD 10)
   ELSE
      f = 0
   END IF
END FUNCTION

========

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            Max (a, b) = 1771
REM  Рекуррентное определение сложения
REM           a + b  =   f(a, b) =  
REM               a            при   b=0
REM      f(a + 1, b - 1)  при   b>0
REM      f(a - 1, b + 1)  при   b<0
 
DECLARE FUNCTION f% (a%, b%)
 
DIM a AS INTEGER
DIM b AS INTEGER
 
CLS
CLEAR , , 29000
INPUT "a, b = "; a, b
IF b > a THEN SWAP a, b
PRINT a; "+"; b; "="; f(a, b)
PRINT FRE(-2)
END
 
FUNCTION f% (a AS INTEGER, b AS INTEGER)
   IF b = 0 THEN
      f = a
   ELSE
      IF b > 0 THEN f = f(a + 1, b - 1)
      IF b < 0 THEN f = f(a - 1, b + 1)
   END IF
END FUNCTION

=========

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 Программа запрашивает ввод чисел
REM         (0 - конец ввода)
REM  И выводит эти числа на экран
REM        в обратном порядке.
REM ?????????????????
REM      Как полон код любви 
REM      Как логика цветиста
REM      Как чуден алгоритм
REM      И как IF THEN ветвиста
REM ?????????????????
 
DECLARE SUB FOX ()
 
CLS
CLEAR , , 20000
CALL FOX
END
 
SUB FOX
DIM n  AS INTEGER
   INPUT n
   IF n THEN CALL FOX
   IF n THEN PRINT n;
END SUB

=========

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
REM   Рекуррентная формула перевода числа
REM   из десятичной СС в семиричную
REM   f(N) = 10 * f(N \ 7) + N MOD 7
 
DECLARE FUNCTION f& (n AS LONG)
DIM SHARED n AS LONG
CLS
 
CLEAR , , 20000
INPUT "n = "; n
PRINT f(n)
END
 
FUNCTION f& (n AS LONG)
  
   IF n < 7 THEN
      f = n
   ELSE
      f = 10 * f(n \ 7) + n MOD 7
   END IF
END FUNCTION

=========

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
82
83
84
85
86
87
88
89
90
REM  Дано семизначное число. (например 1234567)
REM  Требуется вставить между цифрами этого числа
REM  три знака сложения таким образом, чтобы сумма
REM  четырех полученных чисел была минимальна.
REM  Вывести на экран: 
REM  1. число
REM  2. число вместе с тремя знаками сложения
REM  3. и сумму. Для числа 1234567 это может выглядеть
REM  так: 1234567   12+34+56+7   Min = 109
 
DECLARE SUB SUM (n%, s1 AS STRING)
DECLARE SUB VST (n%)
DECLARE FUNCTION SSTR$ (k%)
CLS
 
DIM S AS STRING
DIM SHARED s1 AS STRING
DIM s0 AS STRING
DIM smi AS STRING
DIM min AS INTEGER
DIM SHARED su2 AS INTEGER
min = 310
 
S = SSTR(INT(9 * RND) + 1)
 
FOR i = 2 TO 7
   S = S + SSTR(INT(10 * RND))
NEXT i
PRINT S
PRINT
S = S + "+"
 
FOR i1 = 0 TO 1
FOR i2 = 0 TO 1
FOR i3 = 0 TO 1
FOR i4 = 0 TO 1
FOR i5 = 0 TO 1
FOR i6 = 0 TO 1
   s1 = S
   
   IF i1 + i2 + i3 + i4 + i5 + i6 = 3 THEN
      IF i6 THEN CALL VST(7)
      IF i5 THEN CALL VST(6)
      IF i4 THEN CALL VST(5)
      IF i3 THEN CALL VST(4)
      IF i2 THEN CALL VST(3)
      IF i1 THEN CALL VST(2)
      
      su2 = 0
      s0 = s1
      CALL SUM(4, (s1))
      s1 = s0
      IF su2 < min THEN
         min = su2
         smi = s1
      END IF
   END IF
NEXT i6, i5, i4, i3, i2, i1
 
PRINT LEFT$(smi, LEN(smi) - 1)
PRINT
PRINT "Min ="; min
 
END
 
FUNCTION SSTR$ (k AS INTEGER)
   SSTR = LTRIM$(STR$(k))
END FUNCTION
 
SUB SUM (n AS INTEGER, s11 AS STRING)
   DIM m AS INTEGER
   DIM ss AS INTEGER
 
   IF n > 0 THEN
      m = INSTR(1, s11, "+")
      IF m = 0 THEN EXIT SUB
      ss = VAL(LEFT$(s11, m - 1))
      s11 = RIGHT$(s11, LEN(s11) - m)
      su2 = su2 + ss
      CALL SUM(n - 1, s11)
   END IF
END SUB
 
SUB VST (n AS INTEGER)
   DIM s2 AS STRING
   DIM s3 AS STRING
   s2 = LEFT$(s1, n - 1)
   s3 = RIGHT$(s1, LEN(s1) - (n - 1))
   s1 = s2 + "+" + s3
END SUB

=========

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               Chislo Sochetani  
REM          Рекуррентная формула
REM   C(n, m) = C(n - 1, m - 1) + C(n - 1, m)
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE FUNCTION C& (n%, m%)
DIM m AS INTEGER
DIM n AS INTEGER
 
CLS
CLEAR , , 20000
INPUT "n >= m >= 0  n,m = "; n, m
PRINT " C(" + SSTR(n) + "," + SSTR(m) + ") ="; C(n, m)
END
 
DEFINT M-N
FUNCTION C& (n AS INTEGER, m AS INTEGER)
   IF m = 0 OR m = n THEN
      C = 1
   ELSE
      C = C(n - 1, m - 1) + C(n - 1, m)
   END IF
END FUNCTION
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

=========

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
REM  Дана квадратная матрица
REM  Надо вычислить ее определитель, используя
REM  метод разложения по первой строке
REM  (такая формула есть в курсе линейной алгебры)
REM  В данной программе смотрите функцию DET().
REM  Время вычисления пропорционально n!
REM  Для n = 9 это примерно 3 секунды 
REM  Для n = 10 это примерно 30 секунд.  (!!) и тд.
 
DECLARE FUNCTION DET& (n AS INTEGER, a() AS INTEGER)
DECLARE SUB ALG (j%, n%, a() AS INTEGER, b() AS INTEGER)
 
OPTION BASE 1
DEFINT I-J
RANDOMIZE TIMER
 
CLS
CLEAR , , 20000
DIM SHARED n AS INTEGER
INPUT "n = "; n
 
DIM a(n, n) AS INTEGER
 
FOR i = 1 TO n
   FOR j = 1 TO n
      a(i, j) = 9 * RND
      PRINT a(i, j);
   NEXT j
   PRINT
NEXT i
 
PRINT : PRINT
PRINT "|A| = "; DET(n, a())
END
 
SUB ALG (j AS INTEGER, n AS INTEGER, a() AS INTEGER, c() AS INTEGER)
   DEFINT K-L
 
   FOR k = 1 TO n - 1
      FOR l = 1 TO n - 1
         IF l < j THEN
            c(k, l) = a(k + 1, l)
         ELSE
            c(k, l) = a(k + 1, l + 1)
         END IF
      NEXT l
   NEXT k
END SUB
 
FUNCTION DET& (n AS INTEGER, a() AS INTEGER)
   DIM D AS LONG
   DIM m AS INTEGER
   DIM b(n, n) AS INTEGER
 
   IF n = 1 THEN
      DET = a(1, 1)
   ELSE
      D = 0
 
      FOR m = 1 TO n
         CALL ALG((m), n, a(), b())
         D = D - (-1) ^ m * a(1, m) * DET(n - 1, b())
      NEXT m
 
      DET = D
   END IF
END FUNCTION

=========

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
REM                       METOD Dichotomy 
REM  Программа вычисляет корень уравнения
REM  x * x * x - 9 = 0. (вы можете ввести в текст
REM  программы свое уравнение)
REM  Программа запрашивает вас ввести интервал
REM  Если функция на этом интервале не меняет знака, 
REM  то программа просит ввести другой интервал.
 
DECLARE FUNCTION f! (x!)
DECLARE FUNCTION D! (a!, b!)
 
DIM SHARED eps
DIM SHARED a AS SINGLE
DIM SHARED b AS SINGLE
 
CLS
CLEAR , , 20000
eps = .000001
DO
   INPUT "a, b = "; a, b
LOOP UNTIL f(a) * f(b) <= 0
PRINT "x = "; D(a, b)
END
 
FUNCTION D (a, b)
   c = (a + b) / 2
   IF ABS(b - a) < eps THEN
      D = c
   ELSE
      IF f(a) * f(c) < 0 THEN
         D = D(a, c)
      ELSE
         D = D(c, b)
      END IF
   END IF
END FUNCTION
 
FUNCTION f (x)
   f = x * x * x - 9
END FUNCTION

=========

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  делится ли число N на 7
REM  Алгоритм:
REM  Число N = 10*А + В делится на 7 тогда 
REM  и только тогда, когда на 7 делится число
REM  М = А + 5*В
 
DECLARE FUNCTION f$ (n&)
DIM SHARED n AS LONG
 
CLS
CLEAR , , 28000
INPUT "n = "; n
PRINT f(n)
END
 
FUNCTION f$ (n AS LONG)
   SELECT CASE n
      CASE 0, 7, 49
         f = "Yes"
      CASE 1 TO 6
         f = "No"
      CASE ELSE
         n = n \ 10 + 5 * (n MOD 10)
         f = f(n)
   END SELECT
END FUNCTION

=========

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
REM  Дана строка длиной 20, состоящая из цифр.
REM  Выкинуть, начиная слева, из этой строки 
REM  все цифры, которые встречаются два и более раз. 
REM
REM  Оператор DEL удаляет символы из строки
REM  Синтаксис:            DEL s$, p%, l%
REM  где       s$ - строка
REM  p% - номер позиции, с которой происходит удаление
REM  l% - число удаляемых символов
 
DECLARE SUB DEL (s AS STRING, n%, m%)
DECLARE FUNCTION SSTR$ (k AS INTEGER)
DECLARE FUNCTION EIN$ (s AS STRING)
 
CLS
RANDOMIZE TIMER
CLEAR , , 20000
DIM s AS STRING
DIM n AS INTEGER
 
FOR i = 1 TO 20
   n = 9 * RND
   s = s + SSTR(n)
NEXT i
 
PRINT s
PRINT
PRINT EIN(s)
END
 
SUB DEL (s AS STRING, n AS INTEGER, m AS INTEGER)
   DIM s1 AS STRING
   DIM s2 AS STRING
 
   s1 = LEFT$(s, n - 1)
   s2 = RIGHT$(s, LEN(s) - n - m + 1)
   s = s1 + s2
END SUB
 
FUNCTION EIN$ (t AS STRING)
   DIM t1 AS STRING
   DIM ts AS STRING
   DIM n1 AS INTEGER
  
   IF LEN(t) = 1 THEN
      EIN = t
   ELSE
      t1 = MID$(t, 1, 1)
      IF INSTR(2, t, t1) THEN
         n1 = INSTR(2, t, t1)
         DEL t, n1, 1
         EIN = EIN(t)
      ELSE
         DEL t, 1, 1
         EIN = t1 + EIN(t)
      END IF
   END IF
END FUNCTION
 
FUNCTION SSTR$ (k AS INTEGER)
   SSTR = LTRIM$(STR$(k))
END FUNCTION

echs · 03.08.2015, 19:56 **[ТС]**

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
'     COMPILER     2015
'   =================
'  Программа выполняет четыре арифметических действия,
'  различает унарный минус и скобки. Компилятор устроен просто.
'  Сначало он преобразует строку в массив, попутно собирая все
'  цифры в число. Далее (работа с массивом) он ищет первую
'  закрывающую скобку, а перед ней первую открывающую скобку.
'  И определяет (в скобках) первую исполняемую операцию в
'  порядке их приоритета (унарный минус имеет высший приоритет).
'  Все адреса операций заносятся в специальный массив АО() в
'  порядке их выполнения. Далее следует найти для каждой операции
'  операнды и занести их адреса в два массива o1() и o2() ...
'  Необходимо понять, что мы еще ничего не вычисляем. Мы не знаем
'  заданные операции и числа. Но мы должны найти их Адреса, а через
'  них мы вычислим что угодно!! Для упрощения поиска адресов
'  операндов использована процедура FILTER. Она заменяет все числа
'  символом "R". И наконец для каждой операции (в порядке их
'   выполнения) программа ищет слева и справа символ "R"
'   (наше число) и адрес этого символа сохраняет в массивы o1() и o2().
'   А куда поместить результат? Ведь это тоже операнд для одной из
'   следующих операций?! Результат, а точнее символ "R", помещаем
'   на адрес текущей операции, а предыдущий символ "R" заменяем
'   на пробел. Вот и все. Остается только вычислить. Посмотрите!
'   Как красиво работает функция BASIC: адреса операций и операндов
'   известны. Итак вычисляем первую операцию, вторую, третью ...
'   Результат находится по адресу последней операции.
 
DECLARE SUB Cubo ()
                    ' recursive procedure Mai()
DECLARE SUB Mai ()
DECLARE SUB Mai2 (c1%, c2%)
DECLARE SUB FILTER ()
DECLARE SUB LETO ()
DECLARE SUB LES (SM() AS STRING, BM() AS STRING)
DECLARE FUNCTION BASIC! ()
DECLARE FUNCTION M$ (n AS INTEGER)
DECLARE FUNCTION Symb% (s AS STRING)
DECLARE FUNCTION Ziff% (s AS STRING)
 
CLS
CLEAR , , 20000
OPTION BASE 1
DIM SHARED s AS STRING
DIM SHARED o AS INTEGER
DIM SHARED Col AS INTEGER
DIM s2 AS STRING
DIM SHARED AO(40) AS INTEGER
DIM SHARED SM(80) AS STRING
DIM SHARED BM(80) AS STRING
DIM SHARED FM(80) AS STRING
DIM SHARED o1(40) AS INTEGER
DIM SHARED o2(40) AS INTEGER
DIM SHARED c1 AS INTEGER
DIM SHARED c2 AS INTEGER
 
REM  S - Контрольное выражение, которое вычисляет
REM  этот компилятор. Можете ввести свое и проверить
 
s = "-(7.7+1.1)*(10-1.2)"
' _______________________________
s2 = s
s = "(" + s + ")"
 
DO WHILE INSTR(1, s, "(-")
   i = INSTR(1, s, "(-")
   MID$(s, i + 1, 1) = "="
LOOP
CALL Cubo
LES SM(), BM()
CALL Mai
LES BM(), SM()
CALL FILTER
CALL LETO
 
PRINT s2; " = "; BASIC
 
IF o THEN CLS : PRINT "Division by 0"
END
 
FUNCTION BASIC
   DIM U AS STRING
   DIM u1 AS STRING
   DIM u2 AS STRING
   DIM A AS INTEGER
   DIM a1 AS INTEGER
   DIM a2 AS INTEGER
 
IF Col THEN
   FOR i = 1 TO Col
      A = AO(i)
      U = SM(A)
      a1 = o1(i)
      a2 = o2(i)
      u1 = SM(a1)
      u2 = SM(a2)
 
      SELECT CASE U
         CASE "="
            SM(A) = STR$(-VAL(u2))
         CASE "*"
            SM(A) = STR$(VAL(u1) * VAL(u2))
         CASE "/"
            IF VAL(u2) THEN
               SM(A) = STR$(VAL(u1) / VAL(u2))
            ELSE
               o = 1
               EXIT FUNCTION
            END IF
         CASE "+"
            SM(A) = STR$(VAL(u1) + VAL(u2))
         CASE "-"
            SM(A) = STR$(VAL(u1) - VAL(u2))
      END SELECT
   NEXT i
   BASIC = VAL(SM(A))
ELSE
   BASIC = VAL(SM(2))
END IF
END FUNCTION
 
SUB Cubo
   DIM i AS INTEGER
   DIM j AS INTEGER
   DIM k AS INTEGER
 
   i = 1
   k = 1
   DO
      IF Ziff(M(i)) THEN
         j = i
         DO WHILE Ziff(M(j))
            SM(k) = SM(k) + M(j)
            j = j + 1
         LOOP
         i = j
      ELSE
         SM(k) = M(i)
         i = i + 1
      END IF
      k = k + 1
   LOOP UNTIL i > LEN(s)
END SUB
 
SUB FILTER
   FOR i = 1 TO 80
      IF BM(i) <> "" THEN
         IF Symb(BM(i)) THEN
            FM(i) = " "
         ELSE
            FM(i) = "R"
         END IF
      ELSE
         EXIT FOR
      END IF
   NEXT i
   FM(1) = "R"
END SUB
 
SUB LES (SM() AS STRING, BM() AS STRING)
   FOR i = 1 TO 80
      IF SM(i) <> "" THEN BM(i) = SM(i)
   NEXT i
END SUB
 
SUB LETO
   DIM i AS INTEGER
   DIM j AS INTEGER
   DIM k AS INTEGER
 
   FOR i = 1 TO Col
      k = AO(i)
      FOR j = k - 1 TO 1 STEP -1
         IF FM(j) = "R" THEN
            o1(i) = j
            FM(j) = " "
            EXIT FOR
         END IF
      NEXT j
 
      FOR j = k + 1 TO 80
         IF FM(j) = "R" THEN
            o2(i) = j
            FM(j) = " "
            EXIT FOR
         END IF
      NEXT j
      FM(k) = "R"
   NEXT i
END SUB
 
FUNCTION M$ (n AS INTEGER)
   M = MID$(s, n, 1)
END FUNCTION
 
SUB Mai
   DIM i AS INTEGER
   DIM j AS INTEGER
   DIM k AS INTEGER
   
   FOR i = 1 TO 80
      IF SM(i) = ")" THEN
         c2 = i
         FOR j = c2 TO 1 STEP -1
            IF SM(j) = "(" THEN
               c1 = j
               GOTO 100
            END IF
         NEXT j
      END IF
   NEXT i
 
   Col = 0
   FOR i = 1 TO 80
      IF AO(i) THEN Col = Col + 1 ELSE EXIT FOR
   NEXT i
   EXIT SUB
 
100 :
 
CALL Mai2(c1, c2)
CALL Mai
END SUB
 
SUB Mai2 (c1 AS INTEGER, c2 AS INTEGER)
   DIM i AS INTEGER
   STATIC k AS INTEGER
 
   IF k = 0 THEN k = 1
   IF SM(c1 + 1) = "=" THEN AO(k) = c1 + 1: k = k + 1
  
   FOR i = c1 + 1 TO c2 - 1
      IF SM(i) = "*" OR SM(i) = "/" THEN
         AO(k) = i
         k = k + 1
      END IF
   NEXT i
 
   FOR i = c1 + 1 TO c2 - 1
      IF SM(i) = "+" OR SM(i) = "-" THEN
         AO(k) = i
         k = k + 1
      END IF
   NEXT i
 
   FOR i = c1 TO c2
      SM(i) = " "
   NEXT i
END SUB
 
FUNCTION Symb% (s AS STRING)
   Symb = INSTR(1, "(=)+-*/", s)
END FUNCTION
 
FUNCTION Ziff% (s AS STRING)
   Ziff = INSTR(1, "1234567890.", s)
END FUNCTION

========

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
82
83
REM  Сложение двух натуральных чисел
REM  произвольной длины
 
DECLARE SUB DEL (s AS STRING, n%, m%)
DECLARE FUNCTION SSTR$ (n AS INTEGER)
DECLARE FUNCTION SUM$ (s1 AS STRING, s2 AS STRING)
 
CLS
CLEAR , , 20000
DEFSTR S
DIM k AS INTEGER
 
s1 = "999888777666"
s2 = "999000111222"
 
PRINT " " + s1
PRINT "+"
PRINT " " + s2
s1 = " " + s1
 
PRINT " ";
i = 1
 
DO
   PRINT "-";
   i = i + 1
LOOP UNTIL i >= LEN(s1) AND i > LEN(s2)
 
PRINT
k = LEN(s1) - LEN(s2)
 
IF k > 0 THEN
   FOR i = 1 TO k
      s2 = "0" + s2
   NEXT i
ELSE
   FOR i = 1 TO -k
      s1 = "0" + s1
   NEXT i
END IF
 
PRINT SUM(s1, s2)
END
 
SUB DEL (s AS STRING, n AS INTEGER, m AS INTEGER)
   DIM s1 AS STRING
   DIM s2 AS STRING
 
   s1 = LEFT$(s, n - 1)
   s2 = RIGHT$(s, LEN(s) - n - m + 1)
   s = s1 + s2
END SUB
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION
 
FUNCTION SUM$ (s1 AS STRING, s2 AS STRING)
   DIM c1 AS INTEGER, c2 AS INTEGER, c3 AS INTEGER
   
   IF LEN(s1) = 1 AND LEN(s2) = 1 THEN
      c1 = VAL(s1)
      c2 = VAL(s2)
      SUM = SSTR(c1 + c2)
   ELSE
      c1 = VAL(RIGHT$(s1, 1))
      c2 = VAL(RIGHT$(s2, 1))
      c3 = c1 + c2
      DEL s1, LEN(s1), 1
      DEL s2, LEN(s2), 1
     
      IF c3 < 10 THEN
         SUM = SUM(s1, s2) + SSTR(c3)
      ELSE
         s3 = "1"
         FOR i = 1 TO LEN(s1) - 1
            s3 = "0" + s3
         NEXT i
         s1 = SUM(s1, s3)
         SUM = SUM(s1, s2) + SSTR(c3 - 10)
      END IF
   END IF
END FUNCTION

=========

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
REM  Вынести на экран все числа от 1 до 1000, 
REM  сумма цифр которых равна 5.
 
DECLARE FUNCTION f% (n AS LONG)
DIM i AS LONG
 
CLS
CLEAR , , 20000
 
FOR i = 1 TO 1000
   IF f(i) = 5 THEN PRINT i
NEXT i
END
 
FUNCTION f% (n AS LONG)
 
   IF n < 10 THEN
      f = n
   ELSE
      f = n MOD 10 + f(n \ 10)
   END IF
END FUNCTION

=========

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            fi(1) = 1;     fi(2) = 1
REM   fi(n) = fi(n - 1) + fi(n - 2)  при n > 2
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE FUNCTION fi& (m%)
 
DIM n AS INTEGER
CLS
CLEAR , , 29000
INPUT "n = "; n
PRINT " fi(" + SSTR(n) + ")="; fi(n)
END
 
FUNCTION fi& (n AS INTEGER)
   IF n = 1 OR n = 2 THEN
      fi = 1
   ELSE
      fi = fi(n - 1) + fi(n - 2)
   END IF
END FUNCTION
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

==========

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    Определение:  [a] =
REM            0         при  0 <= a < 1
REM    [a - 1] + 1   при      a > 1
REM    [a + 1] - 1   при      a < 0
 
DECLARE FUNCTION f& (a!)
DIM SHARED a
 
CLS
CLEAR , , 29000
INPUT "a = "; a
 
n = 0
e = SGN(a)
DO WHILE ABS(a) > 1000
   a = a - e * 1000
   n = n + 1
LOOP
 
PRINT "[a] = "; f(a) + 1000 * n * e
END
 
FUNCTION f& (a)
   IF (a >= 0) AND (a < 1) THEN
      f = 0
   ELSE
      IF a > 0 THEN f = f(a - 1) + 1
      IF a < 0 THEN f = f(a + 1) - 1
   END IF
END FUNCTION

===========

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
REM       INTERPRETER   2015
REM   ======================
REM  Программа выполняет четыре арифметических действия,
REM  различает унарный минус и скобки. Интерпретатор устроен
REM  очень просто. Сначала функция IND() перебрасывает числа,
REM  входящие в исходное выражение S, в массив A(10 TO 80), 
REM  заменяя эти числа индексами, под которыми они входят 
REM  в массив (обратите внимание, индексы двузначные).
REM  Массив B(10 TO 80) содержит те же числа, что и A(), но
REM  в числовом виде, а не в строковом как в A().
REM  По этим индексам легко вынуть сами числа из массива.
REM  Далее определяется первая пара скобок, не содержащая
REM  других скобок, и вычисления идут в порядке приоритета 
REM  операций. (унарный минус имеет наивысший приоритет)
REM  Программа вычисляет Контрольное арифметическое
REM  выражение  -(1.1+7.7)*(19.1-10.3).    (ответ: -77.44)
REM  Вы можете его заменить на любое другое и проверить.
REM  Функция ARW() рекурсивная и вызывает сама себя до
REM  тех пор, пока не кончатся скобки (конец вычислений),
REM  Ибо все выражение с самого начала заключается в скобки
 
DECLARE FUNCTION M$ (n AS INTEGER)
DECLARE FUNCTION IND$ (s AS STRING)
DECLARE FUNCTION SSTR$ (u AS INTEGER)
DECLARE FUNCTION ARW! (s AS STRING)
DECLARE FUNCTION Ziff% (s AS STRING)
DECLARE SUB ARW2 (c1%, c2%)
DECLARE SUB DEL (s AS STRING, n%, l%)
DECLARE SUB VST (s AS STRING, s2 AS STRING, n%)
 
CLS
 
DIM SHARED A(10 TO 80) AS STRING
DIM SHARED B(10 TO 80)
DIM SHARED s AS STRING
DIM SHARED si AS STRING
DIM SHARED o AS INTEGER
DIM s2 AS STRING
 
CLEAR , , 25000
 
' + +  Enter arithmetical expression  + +
 
   s2 = "-(1.1+7.7)*(19.1-10.3)"
 
' + + + + + + + + + + + + + + + + + + + + + +
 
s = " (" + s2 + ") "
s = IND(s)
 
FOR i = 10 TO 80
   B(i) = VAL(A(i))
NEXT i
 
PRINT s2; " ="; ARW(s)
IF o THEN CLS : PRINT " Division 0"
END
 
FUNCTION ARW (s AS STRING)
   DIM c1 AS INTEGER
   DIM c2 AS INTEGER
   DIM i AS INTEGER
   DIM j AS INTEGER
 
   FOR i = 2 TO LEN(s)
      c2 = INSTR(i, s, ")")
      IF c2 THEN
         FOR j = c2 - 1 TO 1 STEP -1
            IF M(j) = "(" THEN
               c1 = j
               GOTO 100
            END IF
         NEXT j
      ELSE
         ARW = B(10)
         EXIT FUNCTION
      END IF
   NEXT i
100 :
   CALL ARW2(c1, c2)
   IF o THEN EXIT FUNCTION
   MID$(s, c1, 2) = si
   DEL s, c1 + 2, c2 - c1 - 1
   ARW = ARW(s)
END FUNCTION
 
SUB ARW2 (c1 AS INTEGER, c2 AS INTEGER)
   DIM s2 AS STRING
   DIM k AS INTEGER
   DIM k1 AS INTEGER
   DIM k2 AS INTEGER
   DIM k3 AS INTEGER
   DIM k4 AS INTEGER
   DIM i1 AS INTEGER
   DIM i2 AS INTEGER
   s2 = MID$(s, c1 + 1, c2 - c1 - 1)
 
   k1 = INSTR(1, s2, "=")
   
   IF k1 THEN
      i2 = VAL(MID$(s2, k1 + 1, 2))
      b2 = B(i2)
      B(i2) = -b2
      DEL s2, k1, 1
   END IF
   
   DO
      k1 = INSTR(1, s2, "*")
      k2 = INSTR(1, s2, "/")
      k3 = INSTR(1, s2, "+")
      k4 = INSTR(1, s2, "-")
      k = k1 + k2 + k3 + k4
 
   IF k THEN
      IF k1 > 0 AND (k1 < k2 OR k2 = 0) THEN
         i1 = VAL(MID$(s2, k1 - 2, 2))
         i2 = VAL(MID$(s2, k1 + 1, 2))
         b1 = B(i1)
         b2 = B(i2)
         B(i1) = b1 * b2
         DEL s2, k1, 3
      ELSEIF k2 > 0 AND (k2 < k1 OR k1 = 0) THEN
         i1 = VAL(MID$(s2, k2 - 2, 2))
         i2 = VAL(MID$(s2, k2 + 1, 2))
         b1 = B(i1)
         b2 = B(i2)
         IF b2 = 0 THEN o = -1: EXIT SUB
         B(i1) = b1 / b2
         DEL s2, k2, 3
      ELSEIF k3 THEN
         i1 = VAL(MID$(s2, k3 - 2, 2))
         i2 = VAL(MID$(s2, k3 + 1, 2))
         b1 = B(i1)
         b2 = B(i2)
         B(i1) = b1 + b2
         DEL s2, k3, 3
      ELSEIF k4 THEN
         i1 = VAL(MID$(s2, k4 - 2, 2))
         i2 = VAL(MID$(s2, k4 + 1, 2))
         b1 = B(i1)
         b2 = B(i2)
         B(i1) = b1 - b2
         DEL s2, k4, 3
      END IF
   END IF
   LOOP WHILE k
   si = s2
END SUB
 
SUB DEL (s AS STRING, n AS INTEGER, l AS INTEGER)
   DIM s1 AS STRING
   DIM s2 AS STRING
   
   s1 = LEFT$(s, n - 1)
   s2 = RIGHT$(s, LEN(s) - n - l + 1)
   s = s1 + s2
END SUB
 
FUNCTION IND$ (s AS STRING)
   DIM i AS INTEGER
   DIM j AS INTEGER
   DIM k AS INTEGER
   DIM k0 AS INTEGER
   i = 10: k = 0: j = 0
 
   DO
      k = k + 1
      IF Ziff(M(k)) THEN
         k0 = k
         DO WHILE Ziff(M(k))
            A(i) = A(i) + M(k)
            j = j + 1
            k = k + 1
         LOOP
         
         DEL s, k0, j
         VST s, SSTR(i), k0
 
         k = k - j + 1
         i = i + 1
         j = 0
      END IF
   LOOP UNTIL k >= LEN(s)
 
   DO
      k = INSTR(1, s, "(-")
      IF k THEN MID$(s, k + 1, 1) = "="
   LOOP WHILE k
 
   IND = s
END FUNCTION
 
FUNCTION M$ (n AS INTEGER)
   M = MID$(s, n, 1)
END FUNCTION
 
FUNCTION SSTR$ (u AS INTEGER)
   SSTR = LTRIM$(STR$(u))
END FUNCTION
 
SUB VST (s AS STRING, s2 AS STRING, n AS INTEGER)
   DIM s3 AS STRING
   DIM s4 AS STRING
 
   s3 = LEFT$(s, n - 1)
   s4 = RIGHT$(s, LEN(s) - (n - 1))
   s = s3 + s2 + s4
END SUB
 
FUNCTION Ziff% (s AS STRING)
   Ziff = INSTR(1, "1234567890.", s)
END FUNCTION

echs · 03.08.2015, 20:12 **[ТС]**

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  Косвенная рекурсия (A=>B ; B=>A)
REM  Рекуррентное определение функции A(n):
REM                        A(n) =
REM        n                          при n MOD 5 = 0
REM        2*B(n-1)             в остальных случаях
REM                  где B(n) = 
REM       2*n                       при n MOD 7 = 0
REM       A(n+2) + 1           в остальных случаях
REM
REM  Вычислить при 1 <= n <= 100 все A(n) > 1000
REM   и вывести их на экран
 
DECLARE FUNCTION SSTR$ (n AS INTEGER)
DECLARE FUNCTION A& (n AS INTEGER)
DECLARE FUNCTION B& (n AS INTEGER)
 
CLS
CLEAR , , 20000
DIM i AS INTEGER
 
FOR i = 1 TO 100
   IF A(i) > 1000 THEN PRINT "A(" + SSTR(i) + ") ="; A(i)
NEXT i
END
 
FUNCTION A& (n AS INTEGER)
 
   IF n MOD 5 THEN
      A = 2 * B(n - 1)
   ELSE
      A = n
   END IF
END FUNCTION
 
FUNCTION B& (n AS INTEGER)
 
   IF n MOD 7 THEN
      B = A(n + 2) + 1
   ELSE
      B = 2 * n
   END IF
END FUNCTION
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

==========

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
REM   Программа вычисляет десятичный логарифм lgN
REM   где N - натуральное число (1 <= N <= 100)
REM   Если число N составное, то lgN можно вычислить
REM   по формуле lgN = lg(n1*n2) = lg(n1) * lg(n2).
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE FUNCTION f (n%)
DIM n   AS INTEGER
 
CLS
CLEAR , , 2000
INPUT "n = "; n
PRINT "lg(" + SSTR(n) + ") ="; f(n)
END
 
FUNCTION f (n AS INTEGER)
   SELECT CASE n
      CASE 1: f = 0
      CASE 2: f = .3010299
      CASE 3: f = .4771212
      CASE 5: f = .69897#
      CASE 7: f = .845098
      CASE 11: f = 1.041392
      CASE 13: f = 1.113943
      CASE 17: f = 1.230448
      CASE 19: f = 1.278753
      CASE 23: f = 1.361727
      CASE 29: f = 1.462397
      CASE 31: f = 1.491361
      CASE 37: f = 1.568201
      CASE 41: f = 1.612783
      CASE 43: f = 1.633468
      CASE 47: f = 1.672097
      CASE 53: f = 1.724275
      CASE 59: f = 1.770852
      CASE 61: f = 1.785329
      CASE 67: f = 1.826074
      CASE 71: f = 1.851258
      CASE 73: f = 1.863322
      CASE 79: f = 1.897627
      CASE 83: f = 1.919078
      CASE 89: f = 1.94939
      CASE 97: f = 1.986771
      CASE ELSE
         IF n MOD 2 = 0 THEN f = f(n \ 2) + f(2)
         IF n MOD 3 = 0 THEN f = f(n \ 3) + f(3)
         IF n MOD 5 = 0 THEN f = f(n \ 5) + f(5)
         IF n MOD 7 = 0 THEN f = f(n \ 7) + f(7)
   END SELECT
END FUNCTION
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

===========

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
REM   Программа вычисляет десятичный
REM   логарифм рационального числа N/M
REM   lg(N/M) = lg(N) - lg(M)   (1 <= N, M <= 100)
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE FUNCTION f (n%)
DECLARE FUNCTION lg (n%, m%)
DIM n AS INTEGER
DIM m AS INTEGER
 
CLS
CLEAR , , 2000
INPUT "n,m = "; n, m
PRINT "lg(" + SSTR(n) + "/" + SSTR(m) + ")="; lg(n, m)
END
 
FUNCTION f (n AS INTEGER)
   SELECT CASE n
      CASE 1: f = 0
      CASE 2: f = .3010299
      CASE 3: f = .4771212
      CASE 5: f = .69897
      CASE 7: f = .845098
      CASE 11: f = 1.041392
      CASE 13: f = 1.113943
      CASE 17: f = 1.230448
      CASE 19: f = 1.278753
      CASE 23: f = 1.361727
      CASE 29: f = 1.462397
      CASE 31: f = 1.491361
      CASE 37: f = 1.568201
      CASE 41: f = 1.612783
      CASE 43: f = 1.633468
      CASE 47: f = 1.672097
      CASE 53: f = 1.724275
      CASE 59: f = 1.770852
      CASE 61: f = 1.785329
      CASE 67: f = 1.826074
      CASE 71: f = 1.851258
      CASE 73: f = 1.863322
      CASE 79: f = 1.897627
      CASE 83: f = 1.919078
      CASE 89: f = 1.94939
      CASE 97: f = 1.986771
      CASE ELSE
         IF n MOD 2 = 0 THEN f = f(n \ 2) + f(2)
         IF n MOD 3 = 0 THEN f = f(n \ 3) + f(3)
         IF n MOD 5 = 0 THEN f = f(n \ 5) + f(5)
         IF n MOD 7 = 0 THEN f = f(n \ 7) + f(7)
   END SELECT
END FUNCTION
 
FUNCTION lg (n%, m%)
   lg = f(n%) - f(m%)
END FUNCTION
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

==========

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  Дан массив A() из 10 целых чисел
REM  Определить максимальный элемент A()
REM  Рекуррентное решение:
REM  MAX = A(1)   если массив из одного элемента
REM  MAX = MAX(A(), A(n)), 
REM  Здесь A() содержит на один элемент меньше
 
DECLARE SUB f (n%, max%)
 
DIM SHARED n
DIM SHARED A(1 TO 10) AS INTEGER
DIM M AS INTEGER
 
RANDOMIZE TIMER
CLS
CLEAR , , 26000
 
COLOR 15
FOR i = 1 TO 10
   A(i) = 20 * RND
   PRINT A(i);
NEXT i
PRINT : PRINT
 
CALL f(10, M)
 
FOR i = 1 TO 10
   IF A(i) = m THEN
      COLOR 12
      PRINT A(i);
      COLOR 15
   ELSE
      PRINT A(i);
   END IF
NEXT i
END
 
SUB f (n AS INTEGER, max AS INTEGER)
   IF n = 1 THEN
      max = A(1)
   ELSE
      CALL f(n - 1, max)
      IF A(n) > max THEN max = A(n)
   END IF
END SUB

echs · 04.08.2015, 07:28 **[ТС]**

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
REM  Дано множество, состоящее из чисел 
REM  1, 2, ... , 17 в виде массива.
REM  Один элемент массива заменен на 0.
REM  Найти этот элемент. 
 
DECLARE FUNCTION f! (n%)
 
DIM SHARED n AS INTEGER
DIM i AS INTEGER
DIM j AS INTEGER
DIM SHARED M(1 TO 17) AS INTEGER
 
CLS
CLEAR , , 20000
RANDOMIZE TIMER
n = 17
 
FOR i = 1 TO n
   M(i) = i
NEXT i
 
FOR i = 1 TO n
   j = n * RND + .5
   SWAP M(i), M(j)
NEXT i
 
FOR i = 1 TO n
   PRINT M(i);
NEXT i
 
PRINT : PRINT
j = n * RND + .5
M(j) = 0
 
FOR i = 1 TO n
   PRINT M(i);
NEXT i
 
PRINT : PRINT
PRINT f(n)
END
 
FUNCTION f (n AS INTEGER)
   DIM k AS INTEGER
 
   IF n = 1 THEN
      f = 1
   ELSE
      IF M(n) = n THEN
         f = f(n - 1)
      ELSE
         FOR i = 1 TO n
            k = -1
            IF M(i) = n THEN
               k = 0
               SWAP M(i), M(n)
               f = f(n - 1)
            END IF
         NEXT i
         IF k THEN f = n
      END IF
   END IF
END FUNCTION

=========

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
REM  Дан массив размером 17
REM  Он состоит из чисел 1, 2,... , 16.
REM  Одно число повторяется дважды.
REM  Найти это число.
 
DECLARE FUNCTION f! (n AS INTEGER)
 
DIM SHARED n AS INTEGER
DIM o AS INTEGER
DIM i AS INTEGER
DIM j AS INTEGER
DIM SHARED M(1 TO 17) AS INTEGER
 
CLS
CLEAR , , 20000
RANDOMIZE TIMER
n = 17
 
FOR i = 1 TO n
   M(i) = i
NEXT i
 
M(17) = (n - 1) * RND + .5
 
FOR i = 1 TO n
   j = n * RND + .5
   SWAP M(i), M(j)
NEXT i
 
COLOR 15
FOR i = 1 TO n
   PRINT M(i);
NEXT i
 
PRINT : PRINT
o = f(n)
 
FOR i = 1 TO n
   IF M(i) = o THEN
      COLOR 12
      PRINT M(i);
      COLOR 15
   ELSE
      PRINT M(i);
   END IF
NEXT i
END
 
FUNCTION f (n AS INTEGER)
   DIM k AS INTEGER
 
   IF n = 2 THEN
      f = M(1)
   ELSE
      k = 0
      FOR i = 1 TO n - 1
         IF M(i) = M(n) THEN k = -1
      NEXT i
      IF k THEN
         f = M(n)
         EXIT FUNCTION
      ELSE
         f = f(n - 1)
      END IF
   END IF
END FUNCTION

==========

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
REM  Дана квадратная матрица A() размером N*N
REM  Найти максимальный элемент этой матрицы,
REM  используя рекуррентное соотношение
REM  max(An) = max(max(Am),  a(n,1),  a(1,n),  ...  a(n,n))
REM  где 
REM  max(a, b, c, ...) - максимальное из чисел a, b, c, ... 
REM        An матрица размером n*n; 
REM        Am матрица размером (n-1)*(n-1)
 
DECLARE FUNCTION f% (n AS INTEGER)
 
DIM SHARED n AS INTEGER
RANDOMIZE TIMER
CLS
CLEAR , , 20000
INPUT "n = "; n
PRINT
DIM SHARED a(1 TO n, 1 TO n) AS INTEGER
 
COLOR 15
FOR i = 1 TO n
   FOR j = 1 TO n
      a(i, j) = 20 * RND
      PRINT USING "####"; a(i, j);
   NEXT j
   PRINT
NEXT i
PRINT
Max = f(n)
 
FOR i = 1 TO n
   FOR j = 1 TO n
      IF a(i, j) = Max THEN
         COLOR 12
         PRINT USING "####"; a(i, j);
         COLOR 15
      ELSE
         PRINT USING "####"; a(i, j);
      END IF
   NEXT j
   PRINT
NEXT i
 
END
 
FUNCTION f% (n AS INTEGER)
   DIM M AS INTEGER
   DIM M2 AS INTEGER
 
   IF n = 1 THEN
      f = a(1, 1)
   ELSE
      M = a(n, n)
      FOR i = 1 TO n - 1
         IF a(i, n) > M THEN M = a(i, n)
         IF a(n, i) > M THEN M = a(n, i)
      NEXT i
      M2 = f(n - 1)
      IF M > M2 THEN f = M ELSE f = M2
   END IF
END FUNCTION

=========

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
REM   Я нашел эту задачу на Киберфоруме и решил
REM   (сам решил, хотя на это ушел целый год)
REM   -----------------------------------------
REM   И был на форум путь тернист
REM   Во мне родился программист.
REM   -----------------------------------------
REM   Дано натуральное число N.
REM   Каждое натуральное N может быть за k шагов
REM   приведено к 1 по алгоритму:
REM   Если N делится на 3, то его надо разделить на 3.
REM   Если нет, то вычесть 1.
REM   И так далее, пока не получится 1.
REM   Написать программу, где вводится число
REM   шагов k (0 <= k <= 56) и находится  Наименьшее
REM   число N, соответствующее этому числу шагов k.
 
DECLARE FUNCTION SSTR$ (N%)
DECLARE FUNCTION N& (k%)
DIM k AS INTEGER
 
CLS
CLEAR , , 29000
DO
INPUT "0<=k<=56, k = "; k
LOOP UNTIL 0 <= k AND k <= 56
PRINT "N(" + SSTR(k) + ") = "; N(k)
END
 
FUNCTION N& (k AS INTEGER)
SELECT CASE k
   CASE 0
      N = 1
   CASE 1
      N = 2
   CASE 2
      N = 4
   CASE ELSE
      N = 3 * N(k - 3) + 2
END SELECT
END FUNCTION
 
FUNCTION SSTR$ (N AS INTEGER)
   SSTR = LTRIM$(STR$(N))
END FUNCTION

=========

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  program NOD(a, b) 
REM  Рекуррентное определение NOD(a, b)
REM         NOD(a, b) =
REM   a + b   если   ab = 0
REM   NOD(a MOD b, b)    при a > b
REM   NOD(a, b MOD a)    при а <= b
 
DECLARE FUNCTION NOD& (a&, b&)
DIM a  AS LONG
DIM b  AS LONG
 
CLS
CLEAR , , 20000
INPUT "a, b = "; a, b
PRINT "NOD("; a; ","; b; ") = "; NOD(a, b)
END
 
FUNCTION NOD& (a&, b&)
DEFLNG A-B
   IF (a = 0) OR (b = 0) THEN
      NOD = a + b
   ELSE
      IF a > b THEN
         NOD = NOD(a MOD b, b)
      ELSE
         NOD = NOD(a, b MOD a)
      END IF
   END IF
END FUNCTION

==========

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  его индекс. Если нет, то "No".
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE SUB f (n AS INTEGER)
 
DIM SHARED A(30) AS INTEGER
DIM SHARED B(30)  AS INTEGER
DIM SHARED m AS INTEGER
DIM SHARED i AS INTEGER
RANDOMIZE TIMER
CLS
CLEAR , , 26000
 
m = 8
FOR i = 1 TO m
   A(i) = 30 * RND - 10
   PRINT A(i);
NEXT i
 
FOR i = 1 TO m
   B(i) = A(m + 1 - i)
NEXT i
 
CALL f(m)
PRINT
 
IF i < 9 THEN
   PRINT "A(" + SSTR(i) + ")= "; A(i)
ELSE
   PRINT "No"
END IF
END
 
SUB f (n AS INTEGER)
   IF B(n) < 0 OR n = 0 THEN
      i = m + 1 - n
   ELSE
      f (n - 1)
   END IF
END SUB
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

=========

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  Программа преобразует число в число
REM  с обратным порядком цифр.
 
DECLARE FUNCTION f& (n AS LONG)
DIM SHARED n AS LONG
 
CLS
CLEAR , , 20000
COLOR 15
INPUT "n = "; n
COLOR 11
PRINT f(n)
END
 
FUNCTION f& (n AS LONG)
   STATIC m AS LONG
 
   IF n < 10 THEN
      f = 10 * m + n
   ELSE
      m = 10 * m + n MOD 10
      f = f(n \ 10)
   END IF
END FUNCTION

=========

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
REM  Дано число. Определить расположены
REM  ли его цифры по возрастанию (Yes).
REM  В противном случае — "No".
 
DECLARE FUNCTION f$ (n%)
DIM n AS INTEGER
DIM SHARED s AS STRING
 
CLS
CLEAR , , 26000
INPUT "abcde... = "; s
n = LEN(s)
PRINT f(n)
END
 
FUNCTION f$ (n AS INTEGER)
DIM a AS STRING
DIM b AS STRING
 
   IF n = 1 THEN
      f = "Yes"
   ELSE
      a = MID$(s, 1, 1)
      b = MID$(s, 2, 1)
      IF a > b THEN
         f = "No"
         EXIT FUNCTION
      ELSE
         s = RIGHT$(s, LEN(s) - 1)
         f = f(n - 1)
      END IF
   END IF
END FUNCTION

=========

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
REM  Вычислить сумму цифр числа.
 
DECLARE FUNCTION f& (n AS LONG)
DIM SHARED n   AS LONG
 
CLS
CLEAR , , 26000
INPUT " n = "; n
PRINT "Summa = "; f(n)
END
 
FUNCTION f& (n AS LONG)
 
   IF n < 10 THEN
      f = n
   ELSE
      f = n MOD 10 + f(n \ 10)
   END IF
END FUNCTION

=========

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
REM  Сумма квадратов цифр числа.
 
DECLARE FUNCTION f& (n AS LONG)
DIM SHARED n   AS LONG
 
CLS
CLEAR , , 26000
INPUT " n = "; n
PRINT "Summa = "; f(n)
END
 
FUNCTION f& (n AS LONG)
DIM n2 AS LONG
  
   IF n < 10 THEN
      f = n * n
   ELSE
      n2 = (n MOD 10) ^ 2
      f = n2 + f(n \ 10)
   END IF
END FUNCTION

==========

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 FUNCTION f& (n AS LONG)
DIM SHARED n   AS LONG
 
CLS
CLEAR , , 26000
RANDOMIZE TIMER
n = 1000000 * RND
 
PRINT "n = "; n
PRINT "PRO ="; f(n)
END
 
FUNCTION f& (n AS LONG)
DIM n2 AS LONG
  
   IF n < 10 THEN
      f = n
   ELSE
      n2 = n MOD 10
      f = n2 * f(n \ 10)
   END IF
END FUNCTION

==========

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  Произведение цифр числа, не равных 0.
 
DECLARE FUNCTION f& (n AS LONG)
DIM SHARED n   AS LONG
 
CLS
CLEAR , , 26000
RANDOMIZE TIMER
n = 1000000 * RND
 
PRINT "n = "; n
PRINT "PRO ="; f(n)
END
 
FUNCTION f& (n AS LONG)
DIM n2 AS LONG
  
   IF n < 10 THEN
      f = n
   ELSE
      n2 = n MOD 10
      IF n2 THEN f = n2 * f(n \ 10) ELSE f = f(n \ 10)
   END IF
END FUNCTION

==========

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   f(n, 1) = 1*n + 2*(n - 1) + ... + n*1
REM   (n слагаемых).       Вычислить его.
REM   Примечание:  Эта сумма представляет собой
REM   частный случай сумм вида:
REM   f(n, m) = m*n + (m + 1)*(n - 1) + ... + n*m
 
DECLARE FUNCTION f& (n&, m&)
DIM SHARED n AS LONG
 
CLS
CLEAR , , 29000
INPUT "n = "; n
PRINT "Summa = "; f(n, 1)
END
 
FUNCTION f& (n&, m&)
DEFLNG M-N
   IF (n - m - 1) MOD 2 = 0 THEN
      IF n - 1 = m THEN
         f = 2 * n * m
      ELSE
         f = 2 * n * m + f(n - 1, m + 1)
      END IF
   ELSE
      IF n = m THEN
         f = n * m
      ELSE
         f = 2 * n * m + f(n - 1, m + 1)
      END IF
   END IF
END FUNCTION

==========

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  Вычислить функцию f(n)
REM  Рекуррентное определение:
REM                f(1)=1
REM   f(n) = f(n \ 2) + f(n \ 3) + ... + f(n \ n)
 
DECLARE FUNCTION SSTR$ (n&)
DECLARE FUNCTION f& (n&)
DIM n AS LONG
 
CLS
CLEAR , , 29000
INPUT "n = "; n
PRINT " F(" + SSTR(n) + ") ="; f(n)
END
 
FUNCTION f& (n&)
DEFLNG I, S
   IF n& = 1 THEN
      s = 1
   ELSE
      s = 0
      FOR i = 2 TO n&
         s = s + f(n& \ i)
      NEXT i
   END IF
   f = s
END FUNCTION
 
DEFSNG I, S
FUNCTION SSTR$ (n AS LONG)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

=========

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   Написать программу, вычисляющую функцию.
REM      Функция задана рекуррентной формулой
REM          f(0) = 0,      f(1) = 1
REM          f(2n) = f(n)
REM          f(2n + 1) = f(n) + f(n + 1)
 
DECLARE FUNCTION SSTR$ (n&)
DECLARE FUNCTION f& (n&)
DIM n AS LONG
 
CLS
CLEAR , , 29000
INPUT "n = "; n
PRINT "f(" + SSTR(n) + ")= "; f(n)
END
 
FUNCTION f& (n AS LONG)
   SELECT CASE n
      CASE 0
         f = 0
      CASE 1
         f = 1
      CASE ELSE
         IF n MOD 2 = 0 THEN
            f = f(n \ 2)
         ELSE
            f = f(n \ 2) + f(n \ 2 + 1)
         END IF
   END SELECT
END FUNCTION
 
FUNCTION SSTR$ (n AS LONG)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

echs · 04.08.2015, 07: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
REM  Даны числа в виде строки (разделитель пробел).
REM  Программа определяет максимальное число.
 
DECLARE FUNCTION Rex% (str AS STRING)
 
CLS
CLEAR , , 20000
DIM str AS STRING
str = "7 17 117 711 333 1024 555"
 
PRINT "MAX = "; Rex(str)
 
'PRINT FRE(-2)
END
 
FUNCTION Rex% (str AS STRING)
   DIM s AS STRING
   DIM n AS INTEGER, vs AS INTEGER
   DIM ms AS INTEGER
 
   IF INSTR(str, " ") THEN
      n = INSTR(str, " ")
      s = LEFT$(str, n)
      vs = VAL(s)
      str = RIGHT$(str, LEN(str) - n)
      ms = Rex(str)
      IF vs > ms THEN Rex = vs ELSE Rex = ms
   ELSE
      Rex = VAL(str)
   END IF
END FUNCTION

==========

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
REM  Даны числа в виде переменных.
REM  Переменные представлены одной строкой
REM  Программа определяет максимальное число.
 
DECLARE FUNCTION Rex% (STR AS STRING)
 
DEFINT A-E
DIM SHARED a, b, c, d, e
CLS
CLEAR , , 20000
 
DIM STR AS STRING
STR = "ABCDE"
READ a, b, c, d, e
 
PRINT "MAX = "; Rex(STR)
 
'PRINT FRE(-2)
DATA 7,17,117,1024,33
END
 
FUNCTION Rex% (STR AS STRING)
   DIM s AS STRING
   DIM n AS INTEGER, vs AS INTEGER
   DIM ms AS INTEGER
                            
   IF LEN(STR) > 1 THEN
      
      s = LEFT$(STR, 1)
      SELECT CASE s
         CASE "A": vs = a
         CASE "B": vs = b
         CASE "C": vs = c
         CASE "D": vs = d
         CASE "E": vs = e
      END SELECT
 
      STR = RIGHT$(STR, LEN(STR) - 1)
      ms = Rex(STR)
      IF vs > ms THEN Rex = vs ELSE Rex = ms
   ELSE
      SELECT CASE STR
         CASE "A": Rex = a
         CASE "B": Rex = b
         CASE "C": Rex = c
         CASE "D": Rex = d
         CASE "E": Rex = e
      END SELECT
   END IF
END FUNCTION

==========

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
REM  Дано 9 чисел и число равное сумме пяти из них
REM  Распечатать эти числа на экране.
REM  В программе используется рекурсивная процедура.
REM                                Алгоритм:
REM  Первый цикл FOR-NEXT заполняет массив N()
REM  заданными числами. И (!!) заполняет массив J()
REM  пятью числами 1 (остальные 0). Число 1 означает,
REM  что число из массива N() входит в искомую сумму,
REM  а 0 — нет. Например: если
REM  N(1) = 305, J(1) = 1, N(2) = 7720, J(2) = 0, ... , то
REM  это будет означать, что 305 входит в искомую сумму,
REM  а 7720 — нет. 
REM  И далее обращение к процедуре SCH()
REM  Процедура произвольно перестанавливает числа
REM  массива J() и находит сумму пяти (только пяти)
REM  чисел массива N(). Если эта сумма не равна наперед
REM  заданной сумме (Sum = 24012), то процедура вновь
REM  вызывает сама себя до тех пор, пока не найдется
REM  решение
REM  Последний цикл FOR-NEXT выводит результат
REM  Удивительной красоты код, звездная логика и
REM  обаяние программы будут радовать вас до второго
REM  всемирного потопа.
 
DECLARE SUB SCH ()
 
DEFLNG A-Z
CONST Sum=24012
CLS
 
DIM SHARED N(1 TO 9) AS LONG
DIM SHARED J(1 TO 9) AS LONG
CLEAR , , 25000
 
DATA 305,7720,3385,2932,5321,3774,1082,2369,9281
 
FOR k = 1 TO 9
   READ N(k)
   IF k <= 5 THEN J(k) = 1
NEXT k
 
CALL SCH
 
FOR k = 1 TO 9
   IF J(k) THEN PRINT N(k)
NEXT k
END
 
SUB SCH
  
   FOR k = 1 TO 9
      p = INT(9 * RND) + 1
      SWAP J(k), J(p)
   NEXT k
 
   s = 0
   FOR k = 1 TO 9
      s = s + N(k) * J(k)
   NEXT k
 
   IF s <> Sum THEN CALL SCH
END SUB

==========

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
REM   Этот красивый пример смешанной рекурсии
REM   внесет смысл в вашу "бессмысленную" жизнь.
REM   Вычисляются одновременно SIN(n) и COS(n)
REM   n - натуральное число, задается в градусах
REM              Формулы для справки:
REM   1)  SIN(n) = SIN(n-1)COS(1) + COS(n-1)SIN(1)
REM   2)  COS(n) = COS(n-1)COS(1) - SIN(n-1)SIN(1)
REM   3)  SIN(2n) = 2sin(n)COS(n)
REM   4)  COS(2n) = COS(n)^2 - SIN(n)^2    
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE FUNCTION S (n%)
DECLARE FUNCTION C (n%)
DIM n AS INTEGER
DIM SHARED s1, c1
 
CLS
CLEAR , , 26000
INPUT "n = "; n
s1 = .017452406#
c1 = .999847695#
 
PRINT "sin(" + SSTR(n) + ")= "; S(n)
PRINT "cos(" + SSTR(n) + ")= "; C(n)
END
 
FUNCTION C (n AS INTEGER)
DIM sn, cn
   IF n = 0 THEN
      C = 1
   ELSE
      IF n MOD 2 = 0 THEN
         sn = S(n \ 2)
         cn = C(n \ 2)
         C = cn * cn - sn * sn
      ELSE
         sn = S(n - 1)
         cn = C(n - 1)
         C = cn * c1 - sn * s1
      END IF
   END IF
END FUNCTION
 
FUNCTION S (n AS INTEGER)
DIM sn, cn
   IF n = 0 THEN
      S = 0
   ELSE
      IF n MOD 2 = 0 THEN
         sn = S(n \ 2)
         cn = C(n \ 2)
         S = 2 * sn * cn
      ELSE
         sn = S(n - 1)
         cn = C(n - 1)
         S = sn * c1 + cn * s1
      END IF
   END IF
END FUNCTION
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION

==========

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        Вычисляется функция
REM  Y = SQR(2 + SQR(2 + SQR(2 + ... )...) ...
REM  Ее рекуррентный вид очевиден:
REM        Y(1) = SQR(2)
REM        Y(n) = SQR(2 + Y(n- 1))
 
DECLARE FUNCTION f (n%)
DIM n AS INTEGER
 
CLS
CLEAR , , 7000
FOR n = 1 TO 15
   PRINT USING "n= ##   #.######"; n; f(n)
NEXT n
END
 
FUNCTION f (n AS INTEGER)
   IF n = 1 THEN
      f = SQR(2)
   ELSE
      f = SQR(2 + f(n - 1))
   END IF
END FUNCTION

==========

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
REM  Дано число в виде строковой переменной
REM  Определить местоположение цифры 7 в данном
REM  числе. То есть распечатать еще раз эту
REM  переменную, выделив цифру 7 цветом.
REM  Вывести на экран количество цифр 7.
 
DECLARE SUB iniM ()
DECLARE FUNCTION f% (s AS STRING, ci AS STRING, n%)
DEFSTR A
DIM SHARED s, a
 
RANDOMIZE TIMER
CLS
CLEAR , , 20000
CONST ci = "7", m = 30
COLOR 11
CALL iniM
PRINT
 
COLOR 15
FOR i = 1 TO m
   IF ci = MID$(a, i, 1) THEN
      COLOR 12
      PRINT MID$(a, i, 1);
      COLOR 15
   ELSE
      PRINT MID$(a, i, 1);
   END IF
NEXT i
PRINT : PRINT
PRINT "col 7 ="; f(a, ci, m)
END
 
FUNCTION f% (s AS STRING, ci AS STRING, n AS INTEGER)
   DEFINT N
   DEFSTR S
 
   IF n = 1 THEN
      IF s = ci THEN f = 1 ELSE f = 0
   ELSE
      n1 = n \ 2
      n2 = n - n1
      s1 = LEFT$(s, n1)
      s2 = RIGHT$(s, n2)
      f = f(s1, ci, n1) + f(s2, ci, n2)
   END IF
END FUNCTION
 
SUB iniM
   DIM i AS INTEGER
 
   FOR i = 1 TO m
      a1 = LTRIM$(STR$(INT(8 * RND)))
      a = a + a1
   NEXT i
   PRINT a
END SUB

==========

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
REM  Дана строка, состоящая из цифр 0, 1, 2, 3 
REM  Программа ищет в заданной строке самую
REM  длинную подстроку, состоящую из одинаковых
REM  цифр и выделяет ее красным цветом.
 
DECLARE SUB iniS ()
DECLARE SUB scaN (i%, j%)
 
DIM SHARED n AS INTEGER
DIM SHARED i, j, k, ii, jj
DIM SHARED s AS STRING
DIM SHARED ci AS INTEGER
 
CLS
CLEAR , , 20000
RANDOMIZE TIMER
n = 24
 
CALL iniS
s = s + " "
CALL scaN(1, 1)
 
COLOR 15
FOR k = 1 TO n
   IF ii <= k AND k < ii + jj THEN
      COLOR 12
      PRINT MID$(s, k, 1);
      COLOR 15
   ELSE
      PRINT MID$(s, k, 1);
   END IF
NEXT k
END
 
SUB iniS
   FOR k = 1 TO n
      ci = 3 * RND
      s = s + LTRIM$(STR$((ci)))
   NEXT k
END SUB
 
SUB scaN (i AS INTEGER, j AS INTEGER)
 
   IF i > n THEN
      EXIT SUB
   ELSE
      IF MID$(s, i, 1) = MID$(s, i + 1, 1) THEN
         DO WHILE MID$(s, i, 1) = MID$(s, i + j, 1)
            j = j + 1
         LOOP
         IF jj < j THEN
            ii = i
            jj = j
         END IF
         i = i + j
         CALL scaN(i, 1)
      ELSE
         CALL scaN(i + 1, 1)
      END IF
   END IF
END SUB

=========

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
REM  Даны две строки, состоящие из латинских букв.
REM  Определить: есть ли у этих строк общие буквы.
 
DECLARE FUNCTION f$ (t1 AS STRING, t2 AS STRING)
 
CLS
DEFSTR S
DIM n AS INTEGER
CLEAR , , 10000
CONST m = 12
RANDOMIZE TIMER
 
FOR i = 1 TO m
   n = 26 * RND + 64.5
   s1 = s1 + CHR$(n)
   n = 26 * RND + 64.5
   s2 = s2 + CHR$(n)
NEXT i
 
s = f(s1, (s2))
COLOR 15
 
IF LEN(s) THEN
   
   FOR i = 1 TO m
      ss = MID$(s1, i, 1)
      IF ss = s THEN
         COLOR 12
         PRINT ss;
         COLOR 15
      ELSE
         PRINT ss;
      END IF
   NEXT i
   PRINT : PRINT
   
   FOR i = 1 TO m
      ss = MID$(s2, i, 1)
      IF ss = s THEN
         COLOR 12
         PRINT ss;
         COLOR 15
      ELSE
         PRINT ss;
      END IF
   NEXT i
ELSE
   PRINT s1
   PRINT
   PRINT s2
END IF
END
 
FUNCTION f$ (t1 AS STRING, t2 AS STRING)
   DIM t AS STRING
  
   IF LEN(t2) = 1 THEN
      t = t2
      IF INSTR(1, t1, t) THEN
         f = t
         EXIT FUNCTION
      ELSE
         f = ""
      END IF
   ELSE
      t = LEFT$(t2, 1)
      IF INSTR(1, t1, t) THEN
         f = t
         EXIT FUNCTION
      ELSE
         t2 = RIGHT$(t2, LEN(t2) - 1)
         f = f(t1, t2)
      END IF
   END IF
END FUNCTION

=========

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   Программа вычисляет функцию tg(n)
REM    при условии  0 <= n < 90
REM   n - натуральное число, задается в градусах
REM              Формулы для справки:
REM       tg(2n) = 2tg(n)/(1 - tg(n)^2)
REM       tg(n+1) = (tg(n) + tg1)/(1 - tg(n)tg1)
 
DECLARE FUNCTION SSTR$ (n%)
DECLARE FUNCTION tg! (n%)
 
DIM SHARED n AS INTEGER
DIM SHARED t1
 
CLS
CLEAR , , 27000
t1 = .017455065#
 
DO
   INPUT "(|n|<90) n = "; n
LOOP UNTIL ABS(n) < 90
 
PRINT
PRINT "tg(" + SSTR(n) + ")= "; SGN(n) * tg(ABS(n))
END
 
FUNCTION SSTR$ (n AS INTEGER)
   SSTR = LTRIM$(STR$(n))
END FUNCTION
 
FUNCTION tg (n AS INTEGER)
   IF n = 0 THEN
      tg = 0
   ELSE
      IF n MOD 2 = 0 THEN
         n = n \ 2
         tn = tg(n)
         tg = 2 * tn / (1 - tn * tn)
      ELSE
         tn = tg(n - 1)
         tg = (tn + t1) / (1 - tn * t1)
      END IF
   END IF
END FUNCTION

==========

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            Дана треугольная матрица A(i, j).
REM     1   1   1   1   1   ...       
REM     1   2   3   4     ...             Найти сумму всех элементов
REM     1   3   6     ...                  матрицы при i + j <= 21
REM     1   4    ...                 
REM     1     ...                   
REM   . . . . . . . . . . . . . . . . .
REM   Элементы матрицы определяются рекуррентной формулой:
REM             A(i, 1) = A(1, j) = 1
REM             A(i, j) = A(i - 1, j) + A(i, j - 1)
REM 
 
DECLARE FUNCTION f& (m%, n%)
 
DIM m AS INTEGER
DIM n AS INTEGER
DIM k AS INTEGER
DIM s AS LONG
 
CLS
CLEAR , , 20000
k = 2
 
FOR k = 2 TO 21
FOR n = 1 TO 21
FOR m = 1 TO 21
   IF m + n = k THEN
      s = s + f(m, n)
   END IF
NEXT m, n, k
 
PRINT "Summa ="; s; 2 ^ 20 - 1   ' Сравните S и 2^20-1
PRINT
'PRINT FRE(-2)
END
 
FUNCTION f& (m AS INTEGER, n AS INTEGER)
   IF m = 1 OR n = 1 THEN
      f = 1
   ELSE
      f = f(m - 1, n) + f(m, n - 1)
   END IF
END FUNCTION

=========

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  Программа определяет простоту числа  (1806)
REM  Число N простое, если  (N-2)! = 1 (MOD N)
 
DECLARE SUB f (m%, p&)
DIM SHARED n AS LONG
DIM SHARED o AS LONG
 
CLS
CLEAR , , 28900
INPUT "n = "; n
 
CALL f(n - 2, o)
IF o = 1 THEN PRINT "Yes" ELSE PRINT "No"
'PRINT FRE(-2)
END
 
SUB f (m AS INTEGER, p AS LONG)
 
   IF m THEN
      CALL f(m - 1, p)
      p = p * m MOD n
   ELSE
      p = 1
   END IF
END SUB

=========

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
REM  Вариант 2.
REM  Программа определяет число N на простоту
REM  N <= 8 390 021 (это число простое)
REM  Определение:
REM  Число N простое, если  (N-2)! = 1 (MOD N)
 
DECLARE FUNCTION f% (p&, q%)
 
CLS
CLEAR , , 29000
DIM n AS LONG
DIM m AS INTEGER
INPUT "n = "; n
m = SQR(n)
IF m MOD 2 = 0 THEN m = m + 1
 
IF n = 1 THEN
   PRINT "No"
ELSEIF n = 2 OR n = 3 THEN
   PRINT "Yes"
ELSEIF n MOD 2 THEN
   IF f(n, m) THEN PRINT "Yes" ELSE PRINT "No"
ELSE
   PRINT "No"
END IF
 
'PRINT FRE(-2)
END
 
FUNCTION f% (p AS LONG, q AS INTEGER)
 
   IF q = 1 THEN
      f = -1
   ELSE
      IF p MOD q THEN
         f = f(p, q - 2)
      ELSE
         f = 0
         EXIT FUNCTION
      END IF
   END IF
END FUNCTION

P.S.
Мне хотелось бы добавить, что если у вас
есть программа, содержащая рекурсию или
хотя бы интересная для всех (или вас)
рекуррентная формула, то Добро Пожаловать
в эту тему.
P.P.S.
Автор лишь поделился с вами некоторыми
наработками, чтобы они не канули в Лету.

@Sasha_Smirnov · 05.08.2015, 05:47

Вот тут: Используя рекуррентную формулу составить программу для вычисления Y

(На qBasic не отважусь — нет ни среды, ни стимула!)

echs · 05.08.2015, 08:16 **[ТС]**

Sasha_Smirnov, спасибо!
В той задаче, которую никто не решил, вероятно
плохо знают, что такое цепная дробь и как выглядит
рекуррентная формула для её вычисления, которую
вывел ещё великий Эйлер.
Определение:
Цепная дробь - это выражение вида:
а0 + 1 / (а1 + 1 /(а2 + 1 /( .....аN)...)

Рекуррентная Формула Эйлера:
p(-1) = 1
q(-1) = 0

p(0) = a0
q(0) = 1

p(n) = aN*p(n - 1) + p(n -2)
q(n) = aN*q(n - 1) + q(n - 2)

Ну а сама дробь это: p(n) / q(n)

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

@Sasha_Smirnov · 05.08.2015, 08:40

Сообщение от geh

которую никто не решил

А я считаю, что решил: www.cyberforum.ru/vba/thread742658.html#3 — ведь цикл та же рекурсия, хоть и без функции!

echs · 05.08.2015, 09:02 **[ТС]**

Sasha_Smirnov
Рекурсия отличается от цикла, как небо от земли.
Для цикла не нужен стек и он выполняется быстрее.
Но с помощью рекурсии можно решать такие задачи,
которые другими методами либо крайне сложно, либо
вообще не возможно. Например есть такая вещь, как
Быстрая сортировка. Тут никакой цикл ничего не
сделает. Только рекурсия.
P.S.
Быстрая сортировка довольно
сложная программа и я не стал
ей заниматься.

@Sasha_Smirnov · 05.08.2015, 12:28

Сообщение от geh

как небо от земли

А мне видится, что это одного поля ягоды: только вместо стека — переменная.

Сообщение от geh

Быстрая сортировка. Тут никакой цикл ничего не сделает.

Некто Skif-F привёл (не свой) контрпример: Определить, какой символ встречается в строке чаще всего!

echs · 05.08.2015, 13:05 **[ТС]**

Sasha_Smirnov, хорошо
Я готов встать на вашу позицию. Да у цикла
есть переменная, которая им управляет, но
эта переменная хранит только одно значение.
И если вы хотите сохранить много значений,
то вам придётся задать массив и сделать из
него стек. Можно и так. Но зачем париться?
Когда есть встроенный стек?!!
2. Я ваш союзник. Но в программировании
принято рекурсию выделять и отделять от
Цикла. И я это тоже принимаю.

@CoderHuligan · 05.08.2015, 19:15

Выбирая рекурсию в качестве возможного способа решения задачи, надо всегда помнить, что рекурсия сама по себе большие тормоза, хотя и может сильно упростить код, а всё что можно сделать с помощью рекурсии, можно сделать и без неё.

echs · 05.08.2015, 19:28 **[ТС]**

CoderHuligan
Вы правы на 99%. Но в этой теме я привёл много
примеров для того, чтобы пользователь или гость
смог познакомиться с понятием рекурсии именно
на простых примерах. А напиши я реальную, но
сложную программу, то этого никто не поймёт.
Согласитесь, на QBasic программируют в основном
Школьники. Да я ...

@CoderHuligan · 05.08.2015, 19:49

Сообщение от geh

Согласитесь, на QBasic программируют в основном
Школьники. Да я ...

Ну и ещё я...

@Quiet Snow · 07.08.2015, 01:09

А напиши я реальную, но сложную программу

Что-то мешает? Уже 100 лет в разделе не видел "реальных". Видимо и не будет.

Новые блоги и статьи Все статьи Все блоги /
Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .	Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .
SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .	Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .

echs Регистрация: 23.10.2013 Сообщений: 5,076 Записей в блоге: 8
	01.08.2015, 18:19 [ТС]
	Вы неправы. Очищает все переменные и массивы оператор CLEAR. Все нормально. Мне это известно. Однако спасибо! 0

@CoderHuligan 1753 / 1018 / 257 Регистрация: 30.06.2015 Сообщений: 5,130 Записей в блоге: 56
	01.08.2015, 18:23
	Да вы правы. Спутал с clear 0

@Sasha_Smirnov 5562 / 1370 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	05.08.2015, 05:47
	Вот тут: Используя рекуррентную формулу составить программу для вычисления Y (На qBasic не отважусь — нет ни среды, ни стимула!) 0

echs Регистрация: 23.10.2013 Сообщений: 5,076 Записей в блоге: 8
	05.08.2015, 08:16 [ТС]
	Sasha_Smirnov, спасибо! В той задаче, которую никто не решил, вероятно плохо знают, что такое цепная дробь и как выглядит рекуррентная формула для её вычисления, которую вывел ещё великий Эйлер. Определение: Цепная дробь - это выражение вида: а0 + 1 / (а1 + 1 /(а2 + 1 /( .....аN)...) Рекуррентная Формула Эйлера: p(-1) = 1 q(-1) = 0 p(0) = a0 q(0) = 1 p(n) = aNp(n - 1) + p(n -2) q(n) = aNq(n - 1) + q(n - 2) Ну а сама дробь это: p(n) / q(n) Легко видеть, что числитель и знаменатель это одна и та же рекуррентная формула, но при разных начальных условиях. Полагаю, что теперь вычисление цепной дроби не составит большого труда. Успеха вам! 0

echs Регистрация: 23.10.2013 Сообщений: 5,076 Записей в блоге: 8
	05.08.2015, 09:02 [ТС]
	Sasha_Smirnov Рекурсия отличается от цикла, как небо от земли. Для цикла не нужен стек и он выполняется быстрее. Но с помощью рекурсии можно решать такие задачи, которые другими методами либо крайне сложно, либо вообще не возможно. Например есть такая вещь, как Быстрая сортировка. Тут никакой цикл ничего не сделает. Только рекурсия. P.S. Быстрая сортировка довольно сложная программа и я не стал ей заниматься. 0

echs Регистрация: 23.10.2013 Сообщений: 5,076 Записей в блоге: 8
	05.08.2015, 13:05 [ТС]
	Sasha_Smirnov, хорошо Я готов встать на вашу позицию. Да у цикла есть переменная, которая им управляет, но эта переменная хранит только одно значение. И если вы хотите сохранить много значений, то вам придётся задать массив и сделать из него стек. Можно и так. Но зачем париться? Когда есть встроенный стек?!! 2. Я ваш союзник. Но в программировании принято рекурсию выделять и отделять от Цикла. И я это тоже принимаю. 0

@CoderHuligan 1753 / 1018 / 257 Регистрация: 30.06.2015 Сообщений: 5,130 Записей в блоге: 56
	05.08.2015, 19:15
	Выбирая рекурсию в качестве возможного способа решения задачи, надо всегда помнить, что рекурсия сама по себе большие тормоза, хотя и может сильно упростить код, а всё что можно сделать с помощью рекурсии, можно сделать и без неё. 0

echs Регистрация: 23.10.2013 Сообщений: 5,076 Записей в блоге: 8
	05.08.2015, 19:28 [ТС]
	CoderHuligan Вы правы на 99%. Но в этой теме я привёл много примеров для того, чтобы пользователь или гость смог познакомиться с понятием рекурсии именно на простых примерах. А напиши я реальную, но сложную программу, то этого никто не поймёт. Согласитесь, на QBasic программируют в основном Школьники. Да я ... 0