Sub massiv()
'объявление массивов
Dim a(), b(), c() As Single
Dim n, i, j As Integer
'ввод количества строк и столбцов
n = Val(InputBox("Введите число строк и столбцов в матрице", "Ввод"))
'переобъявление массивов
ReDim a(n, n), b(n, n), c(n, n)
'начало цикла
For i = 1 To n
For j = 1 To n
'ввод элементов матрицы с порядковым номером
a(i, j) = Val(InputBox("Введите элемент матрицы с порядковым номером A (" & i & "," & j & ")", "Ввод"))
'проверка условия задачи
If a(i, j) < 0 Or a(i, j) > 1 Then GoTo error
s = s + a(i, j)
Next j
Next i
'проверка условия задачи
If s <> 1 Then GoTo error
continue2:
'подсчет матрицы c=AxA
For i = 1 To n 'спускаемся вниз по строкам
For j = 1 To n 'идем по элементам строк вправо
c(i, j) = 0 'обнуляем сумму произведений
For k = 1 To n 'идем под горизонтали A и по вертикали
c(i, j) = c(i, j) + a(k, j) * a(i, k) 'b; умножаем и добавляем в c(i,j)
Next k
Next j
Next i
'проверка условия
flag = 0
For i = 1 To n
For j = 1 To n
If (Abs(c(i, j) - a(i, j)) > 0.001) Then flag = 1
If (flag = 0) Then
GoTo Stopz
Else
GoTo continue
End If
Next j
Next i
continue:
For i = 1 To n
For j = 1 To n
a(i, j) = c(i, j)
Next j
Next i
GoTo continue2
Stopz:
For i = 1 To n
For j = 1 To n
Txt = Txt & CStr(c(i, j)) & " "
Next j
Txt = Txt & Chr(13)
Next i
MsgBox Txt
GoTo finish
error: MsgBox "Не правильно введены данные в матрицу"
finish: End Sub
умножение матрицы самой на себя
Дана матрица А(n, n), где сумма всех элементов матрицы равна 1 и
0<=a[i,j]<=1. Составить программу последовательного умножения матрицы самой на себя. Процесс закончить, когда все элементы двух последовательных матриц будут отличаться друг от друга меньше, чем на 10^-3 .
Как сделать условие, чтобы элементы отличались друг от друга на
10 ^-3 степени тобишь на 0.001.?
0<=a[i,j]<=1. Составить программу последовательного умножения матрицы самой на себя. Процесс закончить, когда все элементы двух последовательных матриц будут отличаться друг от друга меньше, чем на 10^-3 .
Как сделать условие, чтобы элементы отличались друг от друга на
10 ^-3 степени тобишь на 0.001.?
Как-как... Находишь минимум и максимум и берещь расность.
Цитата:
Originally posted by wanja
Как-как... Находишь минимум и максимум и берещь расность.
Как-как... Находишь минимум и максимум и берещь расность.
if (abs([max]-[min]))<0.001 then
конец?так что ли
Цитата:
Originally posted by koder
if (abs([max]-[min]))<0.001 then
конец?так что ли
if (abs([max]-[min]))<0.001 then
конец?так что ли
Если B это A в квадрате, тогда для всех i,j от 0 до n-1
abs(b[i,j]-a[i,j]) < 0.001
Цитата:
Originally posted by Mоngооsе
Если B это A в квадрате, тогда для всех i,j от 0 до n-1
abs(b[i,j]-a[i,j]) < 0.001
Если B это A в квадрате, тогда для всех i,j от 0 до n-1
abs(b[i,j]-a[i,j]) < 0.001
Вот вообщем задание, может условие задания неправильное?
Цитата:
Originally posted by koder
Вот вообщем задание, может условие задания неправильное?
Вот вообщем задание, может условие задания неправильное?
Ты задание хочешь решить или же хочешь с преподом перессориться? :)
Вообще-то условие правильное.
Цитата:
Originally posted by Mоngооsе
Ты задание хочешь решить или же хочешь с преподом перессориться? :)
Вообще-то условие правильное.
Ты задание хочешь решить или же хочешь с преподом перессориться? :)
Вообще-то условие правильное.
хм.. так понятно!
вообщем я знаю как перемножить эти матрицы в 2 цикла.. а вот как сделать условие чтобы цикл остановились, когда станут все элементы < .001?
кто-нибудь знает алгоритм последовательного перемножения матрицы самой на себя?
написал вот, а результаты странные какие-то выводит, может кто знает где ошибка?
Код:
Цитата:
Originally posted by koder
написал вот, а результаты странные какие-то выводит, может кто знает где ошибка?
написал вот, а результаты странные какие-то выводит, может кто знает где ошибка?
Код:
...
Мне кажется, в принципе ваша программа правильна. Единственная деталь, которую вы, по-моему, делаете не совсем верно, следующая.
Вы вводите А, вычисляете С = А*А и проверяете условие. Против условия я ничего не имею. Оно верно. Но затем, когда условие даёт flag=1, вы помещаете С в А. Вот это не совсем верно, потому что на следующем шаге программа посчитает уже не С = А*А*А, а С = А*А*А*А.
Таким образом, вычисляется не последовательность
Код:
А
A*A
A*A*A
...
A*A
A*A*A
...
Код:
A
A*A
A*A*A*A
A*A*A*A*A*A*A*A
...
A*A
A*A*A*A
A*A*A*A*A*A*A*A
...
Цитата:
Originally posted by sq_deep
Мне кажется, в принципе ваша программа правильна. Единственная деталь, которую вы, по-моему, делаете не совсем верно, следующая.
Мне кажется, в принципе ваша программа правильна. Единственная деталь, которую вы, по-моему, делаете не совсем верно, следующая.
Мне кажется, что команда
If s <> 1 Then GoTo error
то же неправильна. Нужно бы, что то типа
If Abs(s-1.0)>0.01 Then GoTo error
Цитата:
Originally posted by Mоngооsе
Мне кажется, что команда
If s <> 1 Then GoTo error
то же неправильна. Нужно бы, что то типа
If Abs(s-1.0)>0.01 Then GoTo error
Мне кажется, что команда
If s <> 1 Then GoTo error
то же неправильна. Нужно бы, что то типа
If Abs(s-1.0)>0.01 Then GoTo error
А мне кажется, что для курсовика она вполне допустима. В реальной задаче, конечно, надо учитывать округления и многое другое.
Более того, если принять во внимание общий стиль написания этой программы, то становится ясно, что человек только что начал учиться и делает это самостоятельно и с интересом. Такое можно только приветствовать.
Я в своё время (давно) принял некоторое количество экзаменов по разным дисциплинам и за это решение поставил бы пятёрку без колебаний, даже если бы и нашёл там пару ошибок. Напротив, если задание было сделано слишком профессионально, я обычно задавал вопросы и в результате, как правило (не всегда, конечно), студент ничего объяснить не мог и получал свой заслуженный трояк. Претензий к моему судейству не было никогда. Данный случай совершенно не тот.
Ну, а пока дело дойдёт до реальной задачи, у koderа будет время улучшить стиль и освоить тонкости. Вот тогда он Ваш if и напишет, причём без такого количества меток и переходов.
А этот вариант лучше?
Код:
Dim result(), b(), m(), m1(), m2() As Double
Dim n, z As Integer
Dim txt As String
Sub massiv()
'объявление массивов
Dim a(), b(), c() As Double
Dim n, i, j As Integer
'ввод количества строк и столбцов
n = Val(InputBox("Введите число строк и столбцов в матрице", "Ввод"))
'переобъявление массивов
ReDim a(n, n), b(n, n), c(n, n)
'начало цикла
For i = 1 To n
For j = 1 To n
'ввод элементов матрицы с порядковым номером
a(i, j) = Val(InputBox("Введите элемент матрицы с порядковым номером A (" & i & "," & j & ")", "Ввод"))
'проверка условия задачи
If a(i, j) < 0 Or a(i, j) > 1 Then GoTo error
s = s + a(i, j)
Next j
Next i
'проверка условия задачи
If s <> 1 Then GoTo error
continue2:
'подсчет матрицы c=AxA
For i = 1 To n 'спускаемся вниз по строкам
For j = 1 To n 'идем по элементам строк вправо
c(i, j) = 0 'обнуляем сумму произведений
For k = 1 To n 'идем под горизонтали A и по вертикали
c(i, j) = c(i, j) + a(k, j) * a(i, k) 'b; умножаем и добавляем в c(i,j)
Next k
Next j
Next i
'проверка условия
flag = 0
For i = 1 To n
For j = 1 To n
If (Abs(c(i, j) - a(i, j)) > 0.001) Then flag = 1
If (flag = 0) Then
GoTo Stopz
Else
GoTo continue
End If
Next j
Next i
continue:
For i = 1 To n
For j = 1 To n
a(i, j) = c(i, j)
Next j
Next i
GoTo continue2
Stopz:
For i = 1 To n
For j = 1 To n
txt = txt & CStr(c(i, j)) & " "
Next j
txt = txt & Chr(13)
Next i
MsgBox txt
GoTo finish
error: MsgBox "Не правильно введены данные в матрицу"
finish: End Sub
'возведение матрицы в квадрат
Sub msqr(result() As Double, m() As Variant)
For i = 1 To n
For j = 1 To n
result(i, j) = 0#
For k = 1 To n
result(i, j) = result(i, j) + m(i, k) * m(k, j)
Next k
Next j
Next i
End Sub
'условие завершения работы алгоритма
Private Function mstop(m1(), m2() As Double) As Integer
For i = 1 To n
For j = 1 To n
If (Abs(m1(i, j) - m2(i, j)) >= 0.001) Then
mstop = 0
Else
mstop = 1
End If
Next j
Next i
End Function
'Обмен матрицами
Private Sub mswap(m1(), m2() As Double)
For i = 1 To n
For j = 1 To n
b(i, j) = m2(i, j)
m2(i, j) = m1(i, j)
m1(i, j) = b(i, j)
Next j
Next i
End Sub
'вывод матрицы
Private Sub mprint(m() As Double)
txt = ""
For i = 1 To n
For j = 1 To n
txt = txt & CStr(m(i, j)) & " "
Next j
txt = txt & Chr(13)
Next i
MsgBox txt
End Sub
Sub massiv_1()
n = Val(InputBox("Введите размерность массива"))
If n <= 0 Then GoTo error
ReDim result(n, n), b(n, n), m(n, n), m1(n, n), m2(n, n)
For i = 1 To n
For j = 1 To n
'ввод элементов матрицы с порядковым номером
m2(i, j) = Val(InputBox("Введите элемент матрицы с порядковым номером A (" & i & "," & j & ")", "Ввод"))
m1(i, j) = 0
'проверка условия задачи
If m2(i, j) < 0 Or m2(i, j) > 1 Then GoTo error
s = s + m2(i, j)
Next j
Next i
If s <> 1 Then GoTo error
'собственно итерация
Do Until mstop(m1, m2)
mswap m1, m2
msqr m2, m1
mprint m2
Loop
txt = txt & Chr(13) & "Это конечный был!"
MsgBox txt
GoTo fin
error: MsgBox "Не правильно введены данные, читаем условие"
fin: End Sub
Dim n, z As Integer
Dim txt As String
Sub massiv()
'объявление массивов
Dim a(), b(), c() As Double
Dim n, i, j As Integer
'ввод количества строк и столбцов
n = Val(InputBox("Введите число строк и столбцов в матрице", "Ввод"))
'переобъявление массивов
ReDim a(n, n), b(n, n), c(n, n)
'начало цикла
For i = 1 To n
For j = 1 To n
'ввод элементов матрицы с порядковым номером
a(i, j) = Val(InputBox("Введите элемент матрицы с порядковым номером A (" & i & "," & j & ")", "Ввод"))
'проверка условия задачи
If a(i, j) < 0 Or a(i, j) > 1 Then GoTo error
s = s + a(i, j)
Next j
Next i
'проверка условия задачи
If s <> 1 Then GoTo error
continue2:
'подсчет матрицы c=AxA
For i = 1 To n 'спускаемся вниз по строкам
For j = 1 To n 'идем по элементам строк вправо
c(i, j) = 0 'обнуляем сумму произведений
For k = 1 To n 'идем под горизонтали A и по вертикали
c(i, j) = c(i, j) + a(k, j) * a(i, k) 'b; умножаем и добавляем в c(i,j)
Next k
Next j
Next i
'проверка условия
flag = 0
For i = 1 To n
For j = 1 To n
If (Abs(c(i, j) - a(i, j)) > 0.001) Then flag = 1
If (flag = 0) Then
GoTo Stopz
Else
GoTo continue
End If
Next j
Next i
continue:
For i = 1 To n
For j = 1 To n
a(i, j) = c(i, j)
Next j
Next i
GoTo continue2
Stopz:
For i = 1 To n
For j = 1 To n
txt = txt & CStr(c(i, j)) & " "
Next j
txt = txt & Chr(13)
Next i
MsgBox txt
GoTo finish
error: MsgBox "Не правильно введены данные в матрицу"
finish: End Sub
'возведение матрицы в квадрат
Sub msqr(result() As Double, m() As Variant)
For i = 1 To n
For j = 1 To n
result(i, j) = 0#
For k = 1 To n
result(i, j) = result(i, j) + m(i, k) * m(k, j)
Next k
Next j
Next i
End Sub
'условие завершения работы алгоритма
Private Function mstop(m1(), m2() As Double) As Integer
For i = 1 To n
For j = 1 To n
If (Abs(m1(i, j) - m2(i, j)) >= 0.001) Then
mstop = 0
Else
mstop = 1
End If
Next j
Next i
End Function
'Обмен матрицами
Private Sub mswap(m1(), m2() As Double)
For i = 1 To n
For j = 1 To n
b(i, j) = m2(i, j)
m2(i, j) = m1(i, j)
m1(i, j) = b(i, j)
Next j
Next i
End Sub
'вывод матрицы
Private Sub mprint(m() As Double)
txt = ""
For i = 1 To n
For j = 1 To n
txt = txt & CStr(m(i, j)) & " "
Next j
txt = txt & Chr(13)
Next i
MsgBox txt
End Sub
Sub massiv_1()
n = Val(InputBox("Введите размерность массива"))
If n <= 0 Then GoTo error
ReDim result(n, n), b(n, n), m(n, n), m1(n, n), m2(n, n)
For i = 1 To n
For j = 1 To n
'ввод элементов матрицы с порядковым номером
m2(i, j) = Val(InputBox("Введите элемент матрицы с порядковым номером A (" & i & "," & j & ")", "Ввод"))
m1(i, j) = 0
'проверка условия задачи
If m2(i, j) < 0 Or m2(i, j) > 1 Then GoTo error
s = s + m2(i, j)
Next j
Next i
If s <> 1 Then GoTo error
'собственно итерация
Do Until mstop(m1, m2)
mswap m1, m2
msqr m2, m1
mprint m2
Loop
txt = txt & Chr(13) & "Это конечный был!"
MsgBox txt
GoTo fin
error: MsgBox "Не правильно введены данные, читаем условие"
fin: End Sub