Дана матрица A(n,m). Среди столбцов заданной матрицы, содержащих только такие элементы, которые по модулю не больше 10, найти столбец с минимальным произведением- QBasic(Бейсик)

   '  Матрица
DATA   0,  5, -8, 10,  1,  0
DATA -20, 15,  6,  9, -3, 19
DATA   0,  5,  9, -8,  6, -8
DATA   0, -9, -4,  3,  2, -1
DATA   0,  5, -7, -5, -3,  9
CLS : RANDOMIZE TIMER
   '  Менюшка
 LOCATE 2, 10: PRINT "[1] - Random matrix"
 PRINT TAB(10); "[2] - Matrix from DATA": PRINT
 DO: k$ = INKEY$
   IF k$ = "1" THEN Vib = 1: EXIT DO
   IF k$ = "2" THEN Vib = 2: EXIT DO
   IF k$ = CHR$(27) THEN CLS : END
 LOOP
   '  Параметры матрицы
IF Vib = 1 THEN
 INPUT "    Vvedite kol-vo strok: ", m
 INPUT "    Vvedite kol-vo stolbcov: ", n: PRINT
ELSEIF Vib = 2 THEN
 n = 6: m = 5
END IF
   ' Массив под матрицу
  DIM A(n, m) AS LONG
  DIM Przv&, MinPrzv&
 
   '  Заполняем RND матрицу + на экран её
'CLS
IF Vib = 1 THEN
   FOR iy = 1 TO m: PRINT TAB(15); : FOR ix = 1 TO n
      A(ix, iy) = INT(RND * 23) - 11
      PRINT A(ix, iy);
   NEXT: PRINT : NEXT
ELSEIF Vib = 2 THEN
   FOR iy = 1 TO m: PRINT TAB(15); : FOR ix = 1 TO n
      READ A(ix, iy)
      PRINT A(ix, iy);
   NEXT: PRINT : NEXT
END IF
PRINT
 
   '  Ищем
PrNet = 1   ' Флаг отсутствия произведения
PRINT "Vse proizvedenya: "; CHR$(13)
   FOR ix = 1 TO n    ' Цикл по столбцам
      Przv& = A(ix, 1)
      F = 1
        FOR iy = 1 TO m
      IF iy > 1 THEN Przv& = Przv& * A(ix, iy)
      IF ABS(A(ix, iy)) > 10 THEN F = 0
        NEXT iy
     COLOR 12
     IF F = 1 THEN
       COLOR 10
       IF PrNet = 1 THEN  ' Если нет произведения
        MinPrzv& = Przv&: NumST% = ix
        PrNet = 0
       ELSE               ' Если было произведение
         IF Przv& < MinPrzv& THEN MinPrzv& = Przv&: NumST% = ix
       END IF
     END IF
     PRINT Przv&;
   NEXT
  '  Вывод результата
COLOR 7: PRINT CHR$(13)
IF PrNet = 0 THEN
  PRINT "Min proizvedenie :"; MinPrzv&
  PRINT "Index            :"; NumST%
ELSE
  COLOR 12: PRINT "Stolbca s elementami po modulu <= 10 netu!!!": COLOR 7
END IF

Тестирование выполнено в программе QB64 ( Скачать )

Leave a Comment