Программа
DECLARE SUB GetPntArray (Array#())
DECLARE SUB GetPolinMatrix (PntMatrix#(), PolinMatrix#())
DECLARE SUB OutputArrayXY (Head$, B#())
DECLARE SUB OutputMatrix (Head$, B#())
DECLARE SUB S ()
DECLARE SUB GetVector (PntArray#(), Vector#())
DECLARE SUB GetInvMatrix (Matrix#(), InvMatrix#())
DECLARE SUB MultMatrixVector (M#(), V1#(), V2#())
DECLARE SUB OutPolin (Head$, V#())
DECLARE SUB GetArrayPolinPnt (XBegin#, XEnd#, ArrayPnt#(), Polin#())
DECLARE SUB GetProtoPolin (F#(), FProto#())
DECLARE SUB GetAngleArray (XBegin#, XEnd#, ProtoPolin#(), AngleArray#())
DECLARE SUB GetDeltaR (AngleArray#(), ArrayDeltaR#())
DECLARE SUB OutGraph1 (Pnt#())
DECLARE SUB OutGraph2 (Pnt#(), DeltaR#())
DECLARE FUNCTION F! (X!)
DECLARE FUNCTION FPolin# (X#, Polin#())
DECLARE FUNCTION GetAlgebraicAdd# (Matrix#(), Lne!, Col!)
DECLARE FUNCTION GetDet# (B#())
DECLARE SUB SwapLn (A#(), Ln1!, Ln2!)
DECLARE FUNCTION GetMax# (Coord!, Array#())
DECLARE FUNCTION GetMin# (Coord!, Array#())
DECLARE FUNCTION GetMinor# (Matrix#(), Lne!, Col!)
DECLARE SUB OutBlank (Xlo#, Xhi#, Ylo#, Yhi#, Head$)
'Video system:
CONST VideoType = 9
CONST MaxX = 640
CONST MaxY = 350
CONST Zoom = 2 'Отношение количества заданных точек функции к количеству
'точек выборки для построения полинома
CONST Zoom2 = 2 'Отношение количества точек рассчитанных по полиному
'к количеству заданных точек
CONST Power = 9 'Степень полинома
CONST Pnt = Zoom * Power 'Размерность массива точек
CONST X = 0, Y = 1 'Константы - указатели координат
CONST A = 1 'Толщина слоя
DIM PntArray#(1, Pnt) 'Массив точек (исходный)
DIM ArrayPolinPnt#(1, Pnt * Zoom2) 'Массив точек расчитаных по полиному
DIM PolinMatrix#(Power, Power) 'Полиномиальная матрица
DIM VectorFx#(Power) 'Вектор - значения функции в точках выборки
DIM Polin#(Power) 'Полином
DIM ProtoPolin#(Power - 1) 'Производная полинома
DIM InvPolinMatrix#(Power, Power) 'Матрица обратная полиномиальной
DIM AngleArray#(1, Pnt * Zoom2) 'Массив значений угла наклона касательной
DIM ArrayDeltaR#(1, Pnt * Zoom2) 'Массив DeltaR
CLS 'Очистка экрана
CALL GetPntArray(PntArray#()) 'Получение массива точек
CALL GetPolinMatrix(PntArray#(), PolinMatrix#()) 'Получение полиномиальной матрицы
CALL OutputArrayXY("Массив точек", PntArray#()) 'Вывод массива точек
CALL OutputMatrix("Полиномиальная матрица", PolinMatrix#())'Вывод полиномиальной матрицы
CALL S 'Остановка программы
CALL GetVector(PntArray#(), VectorFx#()) 'Набор вектора
CALL GetInvMatrix(PolinMatrix#(), InvPolinMatrix#()) 'Вычисление обратной матрицы
CALL MultMatrixVector(InvPolinMatrix#(), VectorFx#(), Polin#())
'Вычисление полиномиальных коэффициентов
CALL OutPolin("Полином", Polin#())'Вывод полинома
CALL GetArrayPolinPnt(PntArray#(X, 0), PntArray#(X, Pnt), ArrayPolinPnt#(), Polin#())
'Набор массива точек по полиному на интервале от X0 до Xкон
CALL GetProtoPolin(Polin#(), ProtoPolin#())'Вычисление производной
CALL OutPolin("Производная полинома", ProtoPolin#())'Вывод полинома
CALL S 'Остановка программы
CALL GetAngleArray(PntArray#(X, 0), PntArray#(X, Pnt), ProtoPolin#(), AngleArray#())
'Получение массива углов наклона касательной
CALL GetDeltaR(AngleArray#(), ArrayDeltaR#()) 'Определение массива толщины слоя вдоль Y
CALL OutputArrayXY("Массив толщин слоя вдоль Y", ArrayDeltaR#()) 'Вывод массива точек
CALL S 'Остановка программы
CALL OutGraph1(ArrayDeltaR#()) 'Вывод массива DeltaR
CALL OutGraph2(ArrayPolinPnt#(), ArrayDeltaR#())'Вывод "слоя"
FUNCTION F! (X)
'F! = ((X - 2) * X + 1) * X + 6
F! = SIN(X)
END FUNCTION
FUNCTION FPolin# (X#, Polin#()) 'Вычисление полинома в X
Sum# = 0 'Сброс суммы
FOR i = UBOUND(Polin#) TO LBOUND(Polin#) STEP -1 'Цикл набора полинома
Sum# = Sum# * X# + Polin#(i) 'Набор суммы
NEXT i
FPolin# = Sum# 'Определение значения функции
END FUNCTION
FUNCTION GetAlgebraicAdd# (Matrix#(), Lne, Col)
'Функция получения алгебраического дополнения
GetAlgebraicAdd# = (-1) ^ (Lne + Col) * GetMinor#(Matrix#(), Lne - 1 + LBOUND(Matrix#, 1), Col - 1 + LBOUND(Matrix#, 2))
END FUNCTION
SUB GetAngleArray (XBegin#, XEnd#, ProtoPolin#(), AngleArray#())
'Набор массива углов наклона касательной
Stp# = (XEnd# - XBegin#) / (UBOUND(AngleArray#, 2) - LBOUND(AngleArray#, 2))
'Определение шага точек
FOR i = LBOUND(AngleArray#, 2) TO UBOUND(AngleArray#, 2)
AngleArray#(X, i) = XBegin# + Stp# * (i - LBOUND(AngleArray#, 2)) 'Вычисление X
AngleArray#(Y, i) = ATN(FPolin#(AngleArray#(X, i), ProtoPolin#())) 'Вычисление угла наклона
NEXT i
END SUB
SUB GetArrayPolinPnt (XBegin#, XEnd#, ArrayPnt#(), Polin#())
'Процедура набора массива точек по полиному
Stp# = (XEnd# - XBegin#) / (UBOUND(ArrayPnt#, 2) - LBOUND(ArrayPnt#, 2))
'Определение шага точек
FOR i = LBOUND(ArrayPnt#, 2) TO UBOUND(ArrayPnt#, 2) 'Цикл набора значений массива
ArrayPnt#(X, i) = XBegin# + Stp# * (i - LBOUND(ArrayPnt#, 2)) 'Вычисление X
ArrayPnt#(Y, i) = FPolin#(ArrayPnt#(X, i), Polin#()) 'Вычисление Y
NEXT i
END SUB
SUB GetDeltaR (AngleArray#(), ArrayDeltaR#()) 'Процедура набора толщин слоя вдоль Y
'Цикл набора значений:
FOR i = LBOUND(AngleArray#, 2) TO UBOUND(AngleArray#, 2)
ArrayDeltaR#(X, i - LBOUND(AngleArray#, 2) + LBOUND(ArrayDeltaR#, 2)) = AngleArray#(X, i)
'Копирование аргумента
ArrayDeltaR#(Y, i - LBOUND(AngleArray#, 2) + LBOUND(ArrayDeltaR#, 2)) = A / COS(AngleArray#(Y, i))
'Вычисление толщины слоя вдоль Y
NEXT i
END SUB
FUNCTION GetDet# (B#()) 'Функция вычисления определителя
'Определение рабочего массива:
DIM D#(LBOUND(B#, 1) TO UBOUND(B#, 1), LBOUND(B#, 2) TO UBOUND(B#, 2))
'Копиование в рабочий массив заданного:
FOR i = LBOUND(B#, 1) TO UBOUND(B#, 1) 'Цикл копирования строк
FOR j = LBOUND(B#, 2) TO UBOUND(B#, 2) 'Цикл копирования строки
D#(i, j) = B#(i, j) 'Копирование элемента
NEXT j
NEXT i
Det# = 1 'Начальное определение произведения диагональных элементов
FOR i = LBOUND(D#, 2) TO UBOUND(D#, 2) - 1 'Цикл прохода по столбцам
' с приведением матрицы к верхнетреугольному виду
j = i - LBOUND(D#, 2) + LBOUND(D#, 1)
'Вычисление идекса строки диагонального элемента
'Поиск строки с ненулевым поддиагональным элементом
'(если диагональный элемент нулевой):
WHILE (D#(j, i) = 0) AND (j < UBOUND(D#, 1))
j = j + 1
WEND
IF i - LBOUND(D#, 2) + LBOUND(D#, 1) <> j THEN Det# = -Det#
'Учет влияния перестановки строк матрицы на определитель
CALL SwapLn(D#(), i - LBOUND(D#, 2) + LBOUND(D#, 1), j) 'Перестановка строк матрицы
IF D#(i - LBOUND(D#, 2) + LBOUND(D#, 1), i) = 0 THEN
'Определение значения функции и выход при отсутствии ненулевых элементов
'под диагональным элементом (если диагональный элемент нулевой)
GetDet# = 0
GOTO EndFunction
END IF
FOR j = i - LBOUND(D#, 2) + LBOUND(D#, 1) + 1 TO UBOUND(D#, 1) 'Цикл пересчета строк
Koef# = D#(j, i) / D#(i - LBOUND(D#, 2) + LBOUND(D#, 1), i) 'Расчет множителя
FOR k = i TO UBOUND(D#, 2) 'Цикл пересчета элементов строки
D#(j, k) = D#(j, k) - D#(i - LBOUND(D#, 2) + LBOUND(D#, 1), k) * Koef#
'Пеpесчет элемента стpоки
NEXT k
NEXT j
NEXT i
FOR i = LBOUND(D#, 1) TO UBOUND(D#, 1) 'Цикл прохода по диагонали
Det# = Det# * D#(i, i - LBOUND(D#, 1) + LBOUND(D#, 2))'Набор произведения диагональных элементов
NEXT i
GetDet# = Det# 'Определение значения функции
EndFunction:
END FUNCTION
SUB GetInvMatrix (Matrix#(), InvMatrix#()) 'Процедура вычисления обратной матрицы
DetMatrix# = GetDet#(Matrix#()) 'Вычисление определителя
'Цикл расчета элементов обратной матрицы:
FOR i = LBOUND(Matrix#, 1) TO UBOUND(Matrix#, 1)
FOR j = LBOUND(Matrix#, 2) TO UBOUND(Matrix#, 2)
InvMatrix#(j, i) = GetAlgebraicAdd#(Matrix#(), i + 1 - LBOUND(Matrix#, 1), j + 1 - LBOUND(Matrix#, 2)) / DetMatrix#
NEXT j
NEXT i
END SUB
FUNCTION GetMax# (Coord, Array#()) 'Поиск максимального значения в массиве по заданной координате
Max# = Array#(Coord, LBOUND(Array#, 2)) 'Начальное определение максимального элемента
FOR i = 1 + LBOUND(Array#, 2) TO UBOUND(Array#, 2) 'Цикл просмотра массива
IF Array#(Coord, i) > Max# THEN Max# = Array#(Coord, i) 'Переопределение максимального
NEXT i
GetMax# = Max# 'Определение значения функции
END FUNCTION
FUNCTION GetMin# (Coord, Array#()) 'Поиск минимального значения в массиве по заданной координате
Min# = Array#(Coord, LBOUND(Array#, 2)) 'Начальное определение минимального элемента
FOR i = 1 + LBOUND(Array#, 2) TO UBOUND(Array#, 2) 'Цикл просмотра массива
IF Array#(Coord, i) < Min# THEN Min# = Array#(Coord, i) 'Переопределение минимального
NEXT i
GetMin# = Min# 'Определение значения функции
END FUNCTION
FUNCTION GetMinor# (Matrix#(), Lne, Col) 'Функция вычисления минора матрицы
IF UBOUND(Matrix#, 1) - LBOUND(Matrix#, 1) = 0 THEN
GetMinor# = 1 'Условное "определение" минора для матриц 1x1
ELSE
'Определение массива под "минор"
DIM Minor#(LBOUND(Matrix#, 1) TO UBOUND(Matrix#, 1) - 1, LBOUND(Matrix#, 2) TO UBOUND(Matrix#, 2) - 1)
i2 = LBOUND(Minor#, 1) 'Начальное определение счетчика строк для минора
'Цикл копирования исходной матрицы в матрицу для расчета минора:
FOR i = LBOUND(Matrix#, 1) TO UBOUND(Matrix#, 1) 'Цикл копирования строк
j2 = LBOUND(Minor#, 2) 'Начальное определение счетчика столбцов для минора
IF i = Lne THEN i = i + 1 'Пропуск "вычеркиваемой" строки
FOR j = LBOUND(Matrix#, 2) TO UBOUND(Matrix#, 2) 'Цикл копирования строки
IF j = Col THEN j = j + 1 'Пропуск "вычеркиваемго" столбца
IF (i <= UBOUND(Matrix#, 1)) AND (j <= UBOUND(Matrix#, 2)) THEN
'Блокирование выхода за границы массива
Minor#(i2, j2) = Matrix#(i, j) 'Копирование элемента
j2 = j2 + 1 'Переопределение счетчика столбцов "минора"
END IF
NEXT j
i2 = i2 + 1 'Переопределение счетчика строк "минора"
NEXT i
GetMinor# = GetDet#(Minor#()) 'Определение значения функции
END IF
END FUNCTION
SUB GetPntArray (Array#()) 'Процедура определения массива точек
OPEN "91'.DAT" FOR INPUT AS #1 'Открытие файла
FOR i = LBOUND(Array#, 2) TO UBOUND(Array#, 2) 'Цикл набора массива
INPUT #1, Array#(X, i), Array#(Y, i)'Чтение координат точки
NEXT i
CLOSE #1 'Закрытие файла
END SUB
SUB GetPolinMatrix (PntMatrix#(), PolinMatrix#())
'Процедура получения полиномиальной матрицы
FOR i = 0 TO UBOUND(PolinMatrix#, 1) 'Цикл набора строк
FOR j = 0 TO UBOUND(PolinMatrix#, 2) 'Цикл набора элементов в строке
PolinMatrix#(i, j) = PntMatrix#(X, i * Zoom) ^ j 'Расчет элемента
NEXT j
NEXT i
END SUB
SUB GetProtoPolin (F#(), FProto#()) 'Вычисление пpоизводной полинома
FOR i = LBOUND(F#) TO UBOUND(F#) - 1 'Цикл вычисления пpоизводной
FProto#(i - LBOUND(F#) + LBOUND(FProto#)) = F#(i + 1) * (i - LBOUND(F#) + 1)
NEXT i
END SUB
SUB GetVector (PntArray#(), Vector#()) 'Получение вектора по X (Выборка X)
FOR i = 0 TO UBOUND(Vector#) 'Цикл формирования вектора
Vector#(i) = PntArray#(Y, i * Zoom) 'Определение значения элемента вектора
NEXT i
END SUB
SUB MultMatrixVector (M#(), V1#(), V2#()) 'Произведение матрицы на вектор
FOR i = LBOUND(M#, 1) TO UBOUND(M#, 1) 'Цикл набора вектора
Sum# = 0 'Сброс суммы
FOR j = LBOUND(M#, 2) TO UBOUND(M#, 2) 'Цикл набора суммы элемента
Sum# = Sum# + M#(i, j) * V1#(j - LBOUND(M#, 2) + LBOUND(V1#))
NEXT j
V2#(i - LBOUND(M#, 1) + LBOUND(V2#)) = Sum# 'Определение значения элемента
NEXT i
END SUB
SUB OutBlank (Xlo#, Xhi#, Ylo#, Yhi#, Head$) 'Процедура вывода координатной сетки
COLOR 4, 3 'Определение цветов экрана
CLS 'Очистка экрана
LOCATE 2, (80 - LEN(Head$)) / 2'Установка курсора
PRINT Head$; 'Вывод заголовка
COLOR 8 'Определение цветов экрана
StepX = .8 * 80 / 8 'Определение шага разметки для вывода значений X
FOR i = 0 TO 8 'Цикл вывода значений X
LOCATE 24, i * StepX + 5 'Установка курсора
PRINT USING "###.###"; Xlo# + i * (Xhi# - Xlo#) / 8; 'Расчет и вывод значения X
NEXT i
StepY = .8 * 25 / 10 'Определение шага разметки для вывода значений Y
FOR i = 0 TO 10 'Цикл вывода значений Y
LOCATE i * StepY + 3, 1 'Установка курсора
PRINT USING "####.##"; Yhi# - i * (Yhi# - Ylo#) / 10; 'Расчет и вывод значения Y
NEXT i
'Циклы прорисовки сетки:
FOR i = .1 * MaxY TO .9 * MaxY STEP .8 * (MaxY - MinY) / 10
LINE (.1 * MaxX, i)-(.9 * MaxX, i) 'Прорисовка горизонтальной линии
NEXT i
FOR i = .1 * MaxX TO .9 * MaxX STEP .8 * (MaxX - MinX) / 8
LINE (i, .1 * MaxY)-(i, .9 * MaxY) 'Прорисовка вертикальной линии
NEXT i
END SUB
SUB OutGraph1 (Pnt#()) 'Процедура вывода графика DeltaR
SCREEN VideoType 'Переключение в графический режим
'Определение минимальных и максимальных значений функции:
MinFX# = GetMin#(X, Pnt#())
MaxFX# = GetMax#(X, Pnt#())
MinFY# = GetMin#(Y, Pnt#())
MaxFY# = GetMax#(Y, Pnt#())
'Вычисление масштабов:
ScaleX = (.8 * MaxX) / (MaxFX# - MinFX#)
ScaleY = (.8 * MaxY) / (MaxFY# - MinFY#)
CALL OutBlank(MinFX#, MaxFX#, MinFY#, MaxFY#, "Толщина слоя")'Вывод масштабной сетки
COLOR 4 'Установка цвета
PSET (.1 * MaxX, .9 * MaxY - (Pnt#(Y, LBOUND(Pnt#, 2)) - MinFY#) * ScaleY)'Прорисовка первой точки графика
FOR i = LBOUND(Pnt#, 2) + 1 TO UBOUND(Pnt#, 2) 'Цикл прорисовки графика
LINE -(.1 * MaxX + (Pnt#(X, i) - MinFX#) * ScaleX, .9 * MaxY - (Pnt#(Y, i) - MinFY#) * ScaleY)
'Прорисовка элемента графика
NEXT i
S 'Остановка программы
SCREEN 0 'Возврат в текстовый режим
END SUB
SUB OutGraph2 (Pnt#(), DeltaR#()) 'Процедура вывода графика DeltaR
SCREEN VideoType 'Переключение в графический режим
'Определение минимальных и максимальных значений функции:
MinFX# = GetMin#(X, Pnt#())
MaxFX# = GetMax#(X, Pnt#())
MinFY# = GetMin#(Y, Pnt#()) - GetMax#(Y, DeltaR#())
MaxFY# = GetMax#(Y, Pnt#())
'Вычисление масштабов:
ScaleX = (.8 * MaxX) / (MaxFX# - MinFX#)
ScaleY = (.8 * MaxY) / (MaxFY# - MinFY#)
CALL OutBlank(MinFX#, MaxFX#, MinFY#, MaxFY#, "СЛОЙ")'Вывод масштабной сетки
COLOR 4 'Установка цвета
'Прорисовка полинома:
PSET (.1 * MaxX, .9 * MaxY - (Pnt#(Y, LBOUND(Pnt#, 2)) - MinFY#) * ScaleY)'Прорисовка первой точки графика
FOR i = LBOUND(Pnt#, 2) + 1 TO UBOUND(Pnt#, 2) 'Цикл прорисовки графика
LINE -(.1 * MaxX + (Pnt#(X, i) - MinFX#) * ScaleX, .9 * MaxY - (Pnt#(Y, i) - MinFY#) * ScaleY)
'Прорисовка элемента графика
NEXT i
'Прорисовка слоя:
COLOR 1 'Установка цвета
PSET (.1 * MaxX, .9 * MaxY - (Pnt#(Y, LBOUND(Pnt#, 2)) - DeltaR#(Y, LBOUND(DeltaR#, 2)) - MinFY#) * ScaleY)'Прорисовка первой точки графика
FOR i = LBOUND(Pnt#, 2) + 1 TO UBOUND(Pnt#, 2) 'Цикл прорисовки графика
LINE -(.1 * MaxX + (Pnt#(X, i) - MinFX#) * ScaleX, .9 * MaxY - (Pnt#(Y, i) - MinFY# - DeltaR#(Y, i - LBOUND(Pnt#, 2) + LBOUND(DeltaR#, 2))) * ScaleY)
'Прорисовка элемента графика
NEXT i
S 'Остановка программы
SCREEN 0 'Возврат в текстовый режим
END SUB
SUB OutPolin (Head$, V#())
PRINT Head$ 'Вывод заголовка полинома
PRINT "f(x)=";
FOR i% = UBOUND(V#) TO LBOUND(V#) STEP -1' Цикл вывода
'IF (i < UBOUND(V#)) AND (V#(i%) > 0) THEN PRINT "+"; 'Вывод знака "+"
'IF V#(i%) <> 0 THEN PRINT V#(i%); "x^"; i% + LBOUND(V#); ' Вывод слагаемого
IF V#(i%) <> 0 THEN PRINT USING "+##.########^^^^x^#"; V#(i%); i% + LBOUND(V#); ' Вывод слагаемого
NEXT i%
PRINT ' Вывод конца строки
END SUB
SUB OutputArrayXY (Head$, B#()) ' Процедура вывода массива точек
PRINT Head$ 'Вывод заголовка массива
FOR j% = LBOUND(B#, 2) TO UBOUND(B#, 2) ' Цикл вывода элементов матрицы
PRINT USING "(##.##, ##.##) "; B#(X, j%); B#(Y, j%); ' Вывод элемента массива
NEXT j%
PRINT 'Вывод конца строки
END SUB
SUB OutputMatrix (Head$, B#()) ' Процедура вывода матрицы
PRINT Head$ 'Вывод заголовка массива
FOR i% = LBOUND(B#, 1) TO UBOUND(B#, 1) ' Цикл вывода строк матрицы
FOR j% = LBOUND(B#, 2) TO UBOUND(B#, 2) ' Цикл вывода элементов матрицы
PRINT USING "#.#^^^^ "; B#(i%, j%); ' Вывод элемента матрицы
NEXT j%
PRINT ' Вывод конца строки
NEXT i%
END SUB
SUB OutputVector (Head$, V#())
PRINT Head$ 'Вывод заголовка массива
FOR i% = LBOUND(V#) TO UBOUND(V#) ' Цикл вывода
PRINT USING " ##.####"; V#(i%); ' Вывод элемента вектора
NEXT i%
PRINT ' Вывод конца строки
END SUB
SUB S 'Процедура остановки программы
'Сохранение координат курсора:
BufX = POS(0)
BufY = CSRLIN
LOCATE 25, 32 'Установка курсора
PRINT "Нажмите <Enter>"; 'Вывод приглашения и ожидание нажатия <Enter>
INPUT "", Buf$ 'Ожидание нажатия <Enter>
LOCATE 25, 32 'Установка курсора
PRINT " "; 'Забой приглашения
LOCATE BufY, BufX 'Установка курсора
END SUB
SUB SwapLn (A#(), Ln1, Ln2) 'Функция перемены строк матрицы
IF Ln1 <> Ln2 THEN
FOR i = LBOUND(A#, 2) TO UBOUND(A#, 2) 'Цикл прохода по строке
'Перемена элементов:
Buf# = A#(Ln1, i)
A#(Ln1, i) = A#(Ln2, i)
A#(Ln2, i) = Buf#
NEXT i
END IF
END SUB
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию