Программа
DECLARE SUB OutGraph2 (Pnt!(), DeltaR!())
DECLARE SUB S ()
DECLARE SUB OutGraph1 (ArrayXY!())
DECLARE FUNCTION GetMin! (Coord!, Array!())
DECLARE FUNCTION GetMax! (Coord!, Array!())
DECLARE SUB OutBlank (Xlo!, Xhi!, Ylo!, Yhi!, Head$)
DECLARE SUB GetDeltaR (AngleArray!(), ArrayDeltaR!())
DECLARE SUB OutputArrayXY (Head$, B!())
DECLARE SUB OutPolin (Head$, V!())
DECLARE SUB GetAngleArray (XBegin!, XEnd!, ProtoPolin!(), AngleArray!())
DECLARE SUB GetArrayPolinPnt (XBegin!, XEnd!, ArrayPnt!(), Polin!())
DECLARE FUNCTION FPolin! (X!, Polin!())
DECLARE SUB GetProtoPolin (F!(), FProto!())
DECLARE SUB MultMatrixVector (M!(), V1!(), V2!())
DECLARE SUB OutputVector (Head$, V!())
DECLARE SUB GetPntArray (Array!())
DECLARE SUB GetPolinMatrix (PntMatrix!(), PolinMatrix!())
DECLARE SUB OutputMatrix (Head$, B!())
DECLARE FUNCTION F! (X!)
DECLARE FUNCTION GetAlgebraicAdd# (Matrix!(), Lne!, Col!)
DECLARE FUNCTION GetDet# (B!())
DECLARE SUB SwapLn (A#(), Ln1!, Ln2!)
DECLARE SUB GetInvMatrix (Matrix!(), InvMatrix!())
DECLARE FUNCTION GetMinor# (Matrix!(), Lne!, Col!)
DECLARE SUB GetVector (PntArray!(), Vector!())
'Video system:
CONST VideoType = 9 ' 2 12
CONST MaxX = 640
CONST MaxY = 350 ' 200 480
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 PolinArray(Power) 'Массив точек определяющих полином (выборка)
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()) 'Процедура определения массива точек
RANDOMIZE TIMER 'Инициализация генератора случайных чисел
Var = -3 - RND ' Определение координаты первой точки
FOR i = 0 TO UBOUND(Array, 2) 'Цикл набора массива
Array(X, i) = Var 'Определение X-координаты
Array(Y, i) = F(Var) 'Определение Y-координаты
Var = Var + RND 'Пересчет переменной
'INPUT "Введите точку [X,Y] ", Array(X, i), Array(Y, i)
NEXT i
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); ' Вывод слагаемого
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
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию