Задача для 1-го класса

[Роман-вб]

Задача:
Найтм количество строк и столбцов, не имеющих отрицательных значений элементов в матрицах A(5, 10) и В(15, 12). Реализовать при пом. подпрограмм.

[VVitafresh]

О, Роман-вб, а когда это тебя успели к мутантам причислить?
И наградить столькими звездами

[Роман-вб]

VVitafresh
Задачку как решить?

[keks-n]

VVitafresh
В результате этого топика: http://bbs.vbstreets.ru/viewtopic.php?t=24814

[Роман-вб]

keks-n
Задачу, задачу реши!

[keks-n]

Роман-вб
Гм... примерно так:

Код: Выделить всё

Sub main
dim n as long,counter as long

for n=0 to 10
counter=counter+GetRowA(n)
next
for n=0 to 12
counter=counter+GetRowB(n)
next
MsgBox "Строк: " & counter
counter=0
for n=0 to 10
counter=counter+GetColumnA(n)
next
for n=0 to 12
counter=counter+GetColumnB(n)
next
MsgBox "Столбцов: " & counter


End sub

function GetRowA(RNumber) as long
dim x as long, retval as long
retval=1
for x=0 to 5
if A(x,RNumber)<0 then retval=0
next
GetRowA=retval
end function

function GetRowB(RNumber) as long
dim x as long, retval as long
retval=1
for x=0 to 15
if A(x,RNumber)<0 then retval=0
next
GetRowB=retval
end function


function GetColumnA(CNumber) as long
dim y as long, retval as long
retval=1
for y=0 to 10
if A(CNumber,y)<0 then retval=0
next
GetColumnA=retval
end function


function GetColumnB(CNumber) as long
dim y as long, retval as long
retval=1
for y=0 to 12
if A(CNumber,y)<0 then retval=0
next
GetColumnB=retval
end function

Код не проверялся

[Роман-вб]

keks-n
Не, не, не, это слишком. Максимум 2 процедуры.

[keks-n]

Теперь проверенный код(матрицу тока заполни):

Код: Выделить всё

Option Explicit
Dim A(5, 10) As Long, B(15, 12) As Long

Sub main()
Dim n As Long, counter As Long
For n = 0 To 10
counter = counter + GetRowA(n)
Next
For n = 0 To 12
counter = counter + GetRowB(n)
Next
MsgBox "Строк: " & counter
counter = 0
For n = 0 To 5
counter = counter + GetColumnA(n)
Next
For n = 0 To 15
counter = counter + GetColumnB(n)
Next
MsgBox "Столбцов: " & counter


End Sub

Function GetRowA(RNumber) As Long
Dim x As Long, retval As Long
retval = 1
For x = 0 To 5
If A(x, RNumber) < 0 Then retval = 0
Next
GetRowA = retval
End Function

Function GetRowB(RNumber) As Long
Dim x As Long, retval As Long
retval = 1
For x = 0 To 15
If B(x, RNumber) < 0 Then retval = 0
Next
GetRowB = retval
End Function


Function GetColumnA(CNumber) As Long
Dim y As Long, retval As Long
retval = 1
For y = 0 To 10
If A(CNumber, y) < 0 Then retval = 0
Next
GetColumnA = retval
End Function


Function GetColumnB(CNumber) As Long
Dim y As Long, retval As Long
retval = 1
For y = 0 To 12
If B(CNumber, y) < 0 Then retval = 0
Next
GetColumnB = retval
End Function

[Роман-вб]

Чё то вроде этого должно быть, толко здесь ошибки есть. (и написано на PDS, но суть то та же).

Код: Выделить всё

DECLARE SUB NeOtr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER, SStlb AS INTEGER)
DECLARE SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
DIM A(5, 10) AS INTEGER, B(15, 12) AS INTEGER
DIM SStr AS INTEGER, SStlb AS INTEGER
  CLS
  CALL Formirovanie(A(), 5, 10)
  PRINT
  CALL Formirovanie(B(), 15, 12)
  PRINT
  CALL NeOtr(A(), 5, 10, SStr, SStlb)
  PRINT "A: Stroki = ", SStr, "Stolbtsy = ", SStlb
  CALL NeOtr(B(), 15, 12, SStr, SStlb)
  PRINT "B: Stroki = ", SStr, "Stolbtsy = ", SStlb
END

SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
  FOR i = 1 TO UB
       FOR j = 1 TO LB
          arr(i, j) = INT(1 + 10 * RND)
          PRINT arr(i, j);
       NEXT j
       PRINT
  NEXT i
END SUB

SUB NeOtr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER, SStlb AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  SStr = 0: SStlb = 0
  FOR i = 1 TO LB
     FOR j = 1 TO UB
        IF arr(i, j) > 0 THEN SStr = SStr + 1
     NEXT j
     IF arr(i, j) > 0 THEN SStlb = SStlb + 1
  NEXT i
END SUB

[Роман-вб]

keks-n
По-моему решение нерациональное.

[keks-n]

Вот и 2 процедуры. Модешь передавать массив с верхней границей вместо 2-го параметра и переписать чуть-чуть процедуры

Option Explicit
Dim A(5, 10) As Long, B(15, 12) As Long

Sub main()
Dim n As Long, counter As Long
For n = 0 To 10
counter = counter + GetRow(n, False)
Next
For n = 0 To 12
counter = counter + GetRow(n, True)
Next
MsgBox "Строк: " & counter
counter = 0
For n = 0 To 5
counter = counter + GetColumn(n, False)
Next
For n = 0 To 15
counter = counter + GetColumn(n, True)
Next
MsgBox "Столбцов: " & counter
End Sub

Function GetRow(RNumber, Br As Boolean) As Long
Dim x As Long, retval As Long
retval = 1
If Not Br Then
For x = 0 To 5
If A(x, RNumber) < 0 Then retval = 0
Next
Else
For x = 0 To 15
If B(x, RNumber) < 0 Then retval = 0
Next
End If
GetRow = retval
End Function

Function GetColumn(CNumber, Bc As Boolean) As Long
Dim y As Long, retval As Long
retval = 1
If Not Bc Then
For y = 0 To 10
If A(CNumber, y) < 0 Then retval = 0
Next
Else
For y = 0 To 12
If B(CNumber, y) < 0 Then retval = 0
Next
End If
GetColumn = retval
End Function

[keks-n]

Хотя... Массивы в VB передаются исключительно ByRef, а ByRef можно передать только динамический.

[Роман-вб]

keks-n
Т.е. вот так писать нельзя?:
SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)

[keks-n]

Написать то можно... Но передавать надо динамический массив, а там проблемы с многомерностью. Это тебе не QBasic ... Там можно было даже писать Dim Mas(n).

[keks-n]

Хотя чего это я? Пишем:

Код: Выделить всё

Option Explicit
Dim A() As Long, B() As Long

Sub main()
ReDim A(5, 10)
ReDim B(15, 12)

Только верхние границы передавать придётся...

[Роман-вб]

keks-n
Есть идеи по исправлению PDS'овского кода?

[GSerg]

Хм... А ведь они нашли друг друга...

[Роман-вб]

GSerg
Твоя умная голова может предложить что-нибудь путёвое?

[keks-n]

Роман-вб
А отлаживать мне его как? В уме?

[GSerg]

К сожалению, нет - впечатление от топика слишком свежо и велико...

[Роман-вб]

keks-n
Ну чё, у тя нет какого-нибудь там QBASIC'a или получше?

[Роман-вб]

keks-n
Тем более на VB переложить не трудно

[keks-n]

Есть, но не на этом компе, а в километрах эдак 200 отсюда.

[Роман-вб]

Для строк разобрался:

Код: Выделить всё

SUB NeOtr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER, SStlb AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  DIM f AS Boolean
  SStr = 0: SStlb = 0
  FOR i = 1 TO UB
     FOR j = 1 TO LB
        IF arr(i, j) >= 0 THEN
           SStr = SStr + 1
           EXIT FOR
        END IF
     NEXT j
     'IF arr(i, j) > 0 THEN SStlb = SStlb + 1
  NEXT i
END SUB

А вот со столбцами.....проблема.

[Роман-вб]

Вот вроде работает:

Код: Выделить всё

DECLARE SUB NeOtrStr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER)
DECLARE SUB NeOtrStlb (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStlb AS INTEGER)
OPTION BASE 1
DECLARE SUB NeOtr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER, SStlb AS INTEGER)
DECLARE SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
DIM A(5, 10) AS INTEGER, B(15, 12) AS INTEGER
DIM SStr AS INTEGER, SStlb AS INTEGER
  CLS
  CALL Formirovanie(A(), 5, 10)
  PRINT
  CALL Formirovanie(B(), 15, 12)
  PRINT
  CALL NeOtrStr(A(), 5, 10, SStr)
  CALL NeOtrStlb(A(), 5, 10, SStlb)
  PRINT "A: Stroki = ", SStr, "Stolbtsy = ", SStlb
  CALL NeOtrStr(B(), 15, 12, SStr)
  CALL NeOtrStlb(B(), 15, 12, SStlb)
  PRINT "B: Stroki = ", SStr, "Stolbtsy = ", SStlb
END

SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
  RANDOMIZE TIMER
  FOR i = 1 TO UB
       FOR j = 1 TO LB
          arr(i, j) = INT(-9 + 12 * RND)
          PRINT arr(i, j);
       NEXT j
       PRINT
  NEXT i
END SUB

SUB NeOtrStlb (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStlb AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  SStlb = 0
  FOR i = 1 TO LB
     FOR j = 1 TO UB
        IF arr(j, i) >= 0 THEN
           SStlb = SStlb + 1
           EXIT FOR
        END IF
     NEXT j
  NEXT i
END SUB

SUB NeOtrStr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  SStr = 0
  FOR i = 1 TO UB
     FOR j = 1 TO LB
        IF arr(i, j) >= 0 THEN
           SStr = SStr + 1
           EXIT FOR
        END IF
     NEXT j
  NEXT i
END SUB

Но с 1-ым массивом какието чудеса. Выдаёт на единицу больше. Почему? Может где чего неправильно?

[Роман-вб]

Вот вроде работает:

Код: Выделить всё

DECLARE SUB NeOtrStr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER)
DECLARE SUB NeOtrStlb (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStlb AS INTEGER)
OPTION BASE 1
DECLARE SUB NeOtr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER, SStlb AS INTEGER)
DECLARE SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
DIM A(5, 10) AS INTEGER, B(15, 12) AS INTEGER
DIM SStr AS INTEGER, SStlb AS INTEGER
  CLS
  CALL Formirovanie(A(), 5, 10)
  PRINT
  CALL Formirovanie(B(), 15, 12)
  PRINT
  CALL NeOtrStr(A(), 5, 10, SStr)
  CALL NeOtrStlb(A(), 5, 10, SStlb)
  PRINT "A: Stroki = ", SStr, "Stolbtsy = ", SStlb
  CALL NeOtrStr(B(), 15, 12, SStr)
  CALL NeOtrStlb(B(), 15, 12, SStlb)
  PRINT "B: Stroki = ", SStr, "Stolbtsy = ", SStlb
END

SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
  RANDOMIZE TIMER
  FOR i = 1 TO UB
       FOR j = 1 TO LB
          arr(i, j) = INT(-9 + 12 * RND)
          PRINT arr(i, j);
       NEXT j
       PRINT
  NEXT i
END SUB

SUB NeOtrStlb (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStlb AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  SStlb = 0
  FOR i = 1 TO LB
     FOR j = 1 TO UB
        IF arr(j, i) >= 0 THEN
           SStlb = SStlb + 1
           EXIT FOR
        END IF
     NEXT j
  NEXT i
END SUB

SUB NeOtrStr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  SStr = 0
  FOR i = 1 TO UB
     FOR j = 1 TO LB
        IF arr(i, j) >= 0 THEN
           SStr = SStr + 1
           EXIT FOR
        END IF
     NEXT j
  NEXT i
END SUB

Но с 1-ым массивом какието чудеса. Выдаёт на единицу больше. Почему? Может где чего неправильно?

[Роман-вб]

Вот вроде работает:

Код: Выделить всё

DECLARE SUB NeOtrStr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER)
DECLARE SUB NeOtrStlb (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStlb AS INTEGER)
OPTION BASE 1
DECLARE SUB NeOtr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER, SStlb AS INTEGER)
DECLARE SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
DIM A(5, 10) AS INTEGER, B(15, 12) AS INTEGER
DIM SStr AS INTEGER, SStlb AS INTEGER
  CLS
  CALL Formirovanie(A(), 5, 10)
  PRINT
  CALL Formirovanie(B(), 15, 12)
  PRINT
  CALL NeOtrStr(A(), 5, 10, SStr)
  CALL NeOtrStlb(A(), 5, 10, SStlb)
  PRINT "A: Stroki = ", SStr, "Stolbtsy = ", SStlb
  CALL NeOtrStr(B(), 15, 12, SStr)
  CALL NeOtrStlb(B(), 15, 12, SStlb)
  PRINT "B: Stroki = ", SStr, "Stolbtsy = ", SStlb
END

SUB Formirovanie (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER)
  RANDOMIZE TIMER
  FOR i = 1 TO UB
       FOR j = 1 TO LB
          arr(i, j) = INT(-9 + 12 * RND)
          PRINT arr(i, j);
       NEXT j
       PRINT
  NEXT i
END SUB

SUB NeOtrStlb (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStlb AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  SStlb = 0
  FOR i = 1 TO LB
     FOR j = 1 TO UB
        IF arr(j, i) >= 0 THEN
           SStlb = SStlb + 1
           EXIT FOR
        END IF
     NEXT j
  NEXT i
END SUB

SUB NeOtrStr (arr() AS INTEGER, UB AS INTEGER, LB AS INTEGER, SStr AS INTEGER)
  DIM i AS INTEGER, j AS INTEGER
  SStr = 0
  FOR i = 1 TO UB
     FOR j = 1 TO LB
        IF arr(i, j) >= 0 THEN
           SStr = SStr + 1
           EXIT FOR
        END IF
     NEXT j
  NEXT i
END SUB

Но с 1-ым массивом какието чудеса. Выдаёт на единицу больше. Почему? Может где чего неправильно?

[Роман-вб]

Ббблин, что за тормоза: то ничего, то сразу на тебе ! От крайности к крайности!