генерирование эффективных матриц субблоков, чтобы избежать дублирования кода - PullRequest
Новая
       4

генерирование эффективных матриц субблоков, чтобы избежать дублирования кода

0 голосов
/ 29 февраля 2020

Следующий код работает правильно. Я генерирую матрицу 9x9, которая состоит из 9 отдельных матриц подблоков 3x3. Тем не менее, большая часть кода кажется дублированной, и я использую чрезмерное количество циклов DO.

Можно ли как-нибудь сгенерировать такую ​​же матрицу 9x9, но без дублирования большого количества кода и минимизации количества циклов do?

Моя настоящая проблема связана с квадратной матрицей, намного большей, чем матрица 9x9, поэтому этот TestCode не настолько общий или полезный, хотя и работает.

В данном случае матрица имеет размер 9x9: просто для минимального, полного, проверяемого примера. В общем, мне нужно сделать это для матрицы n на n, где каждый подблок имеет размер sqrt (n) по sqrt (n). 

PROGRAM TestCode

IMPLICIT NONE
INTEGER :: i, j, m!matrix indices (i,j)
INTEGER,PARAMETER :: n = 9 ! matrix is 9x9
DOUBLE PRECISION :: KE(n,n)
REAL :: nn 

nn = n
m = SQRT(nn)

DO i = 1, m
    DO j = 1, m
        IF( i .EQ. j) THEN 
            KE(i,j) = -4
        ELSEIF ( ABS(i-j) .EQ. 1) THEN
            KE(i,j) = 1
        ELSE 
            KE(i,j) = 0
        END IF
    END DO
END DO

DO i = 4,6
    DO j = 4,6
        IF( i .EQ. j) THEN 
            KE(i,j) = -4
        ELSEIF ( ABS(i-j) .EQ. 1) THEN
            KE(i,j) = 1
        ELSE 
            KE(i,j) = 0
        END IF
    END DO
END DO

DO i = 7,9
    DO j = 7,9
        IF( i .EQ. j) THEN 
            KE(i,j) = -4
        ELSEIF ( ABS(i-j) .EQ. 1) THEN
            KE(i,j) = 1
        ELSE 
            KE(i,j) = 0
        END IF
    END DO
END DO

DO i = 4,6
    DO j = 1,m
        IF( ABS(i-j) .EQ. m) THEN 
            KE(i,j) = 1
        ELSE 
            KE(i,j) = 0
        END IF
    END DO
END DO

DO i = 7,9
    DO j = 1,m
        KE(i,j) = 0
    END DO
END DO

DO i = 1,m
    DO j = 4,6
        IF ( ABS(i-j) .EQ. m) THEN
            KE(i,j) = 1
        ELSE
            KE(i,j) = 0
        END IF
    END DO
END DO

DO i = 7,9
    DO j = 4,6
        IF ( ABS(i-j) .EQ. m) THEN
            KE(i,j) = 1
        ELSE
            KE(i,j) = 0
        END IF
    END DO
END DO

DO i = 1,m
    DO j = 7,9
        KE(i,j) = 0
    END DO
END DO

DO i = 4,6
    DO j = 7,9
        IF( ABS(i-j) .EQ. m) THEN
            KE(i,j) = 1
        ELSE
            KE(i,j) = 0
        END IF
    END DO
END DO

END PROGRAM

Ответы [ 2 ]

2 голосов
/ 02 марта 2020

Учитывая периодичность данных c, подматрицы и вся блочная матрица могут быть заполнены с помощью аргумента PAD= для RESHAPE intrinsi c. 

program blox
   implicit none
   integer m
   integer n
   integer, allocatable :: zero(:), sp3(:,:,:)
   integer, allocatable :: b1(:,:), b2(:,:), b3(:,:)
   integer, allocatable :: iKE(:,:)
   character(80) fmt
   m = 4
   n = m**2
   zero = reshape([integer::],[m+1],pad=[0])
   b1 = reshape([integer::],[m,m],pad=[-4,1,zero(1:m-2),1])
   b2 = reshape([integer::],[m,m],pad=[1,zero(1:m)])
   b3 = reshape([integer::],[m,m],pad=zero(1:m+1))
   sp3 = reshape([integer::],[m,m,m-2],pad=b3)
   iKE = reshape(reshape([integer::],[m,m,m,m],pad=[b1,b2,sp3,b2],order=[1,3,2,4]),[n,n])
   write(fmt,'(*(g0))') '(',m,'(',m,'(',m,'i3:1x)/))'
   write(*,fmt) transpose(iKE)
end program blox

Обратите внимание, как строки нулей создаются путем заполнения пустого массива нулями (zero), а затем массивы с периодами c данных заполняются заполнением пустого массива массивом с одним периодом данных (bl, b2 и b3). Затем создается матрица, состоящая из копий блочной матрицы, путем заполнения пустого массива блоком (sp3). Наконец, матрица block-periodi c создается путем заполнения пустого массива последовательностью блоков. Полученная матрица должна быть прочитана в перекрестном порядке, а затем преобразована в правильные размеры (iKE).

Вывод: 

 -4  1  0  0   1  0  0  0   0  0  0  0   0  0  0  0
  1 -4  1  0   0  1  0  0   0  0  0  0   0  0  0  0
  0  1 -4  1   0  0  1  0   0  0  0  0   0  0  0  0
  0  0  1 -4   0  0  0  1   0  0  0  0   0  0  0  0

  1  0  0  0  -4  1  0  0   1  0  0  0   0  0  0  0
  0  1  0  0   1 -4  1  0   0  1  0  0   0  0  0  0
  0  0  1  0   0  1 -4  1   0  0  1  0   0  0  0  0
  0  0  0  1   0  0  1 -4   0  0  0  1   0  0  0  0

  0  0  0  0   1  0  0  0  -4  1  0  0   1  0  0  0
  0  0  0  0   0  1  0  0   1 -4  1  0   0  1  0  0
  0  0  0  0   0  0  1  0   0  1 -4  1   0  0  1  0
  0  0  0  0   0  0  0  1   0  0  1 -4   0  0  0  1

  0  0  0  0   0  0  0  0   1  0  0  0  -4  1  0  0
  0  0  0  0   0  0  0  0   0  1  0  0   1 -4  1  0
  0  0  0  0   0  0  0  0   0  0  1  0   0  1 -4  1
  0  0  0  0   0  0  0  0   0  0  0  1   0  0  1 -4

Удивительно, что вам действительно нужна явная форма этой матрицы. Обычно вы видите, что объект такого типа обрабатывается более косвенно с помощью методов разреженной матрицы.

1 голос
/ 01 марта 2020

Существует множество способов создания блочных матриц в Фортране, ответы, уже отмеченные @francescalus, показывают пару, и у меня наверняка есть некоторые в моем наборе инструментов. Вот другой подход, возможно, более простой, но удовлетворительный для непосредственных требований OP.

Сначала объявите переменную для блоков, в следующем она называется blk, и она объявлена ​​как m*m. Тогда это так же просто, как ... 

 ke = 0.0  ! All elements will be 0.0 unless otherwise assigned

 ! Define the block on the diagonal, and assign it
 blk = RESHAPE([-4.0, 1.0, 0.0, 1.0, -4.0, 1.0, 0.0, 1.0, -4.0], [m,m])
 DO i = 1, n, m
    ke(i:i+m-1,i:i+m-1) = blk
 END DO

 ! Now the off-diagonal blocks
 blk = RESHAPE([1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], [m,m])
 DO i = 4, n, m
    ke(i:i+m-1,i-m:i-1) = blk
    ke(i-m:i-1,i:i+m-1) = blk
 END DO

Если бы я собирался использовать это в рабочем коде, то я бы обернул его в рутину и уделил больше внимания таким вопросам, как использование выделяемых массивов, передача предполагаемой массивы, такие хорошие вещи.

Другие полезные инструменты в арсенале программистов на Фортране: chsift и eoshift. Я мог бы использовать последний следующим образом. Во-первых, давайте иметь массив элементов типа 1011 * с двойными числами, называемый line, затем 

 ke = 0.0

 line = [0.0, 1.0, 0.0, 1.0, -4.0, 1.0, 0.0, 1.0, 0.0]

 ke((n/2)+1,:) = line
 DO i = 1, 4
    ke(i,:) = EOSHIFT(line,m+2-i)
    ke(n-i+1,:) = EOSHIFT(line,-(m+2-i))
 END DO

Что касается эффективности, я сомневаюсь, что между любыми подходами здесь есть много, или в аналогичных подходах. Я полагаю, что минимизация количества сканирований по массивам была бы хорошей идеей, и посещение элементов в удобном для памяти порядке также было бы полезно. Но все они должны посетить каждый элемент хотя бы один раз. Я бы go за самый простой подход, то есть тот, который I нашел самым простым для рассматриваемой проблемы; Ваш выбор для вашей проблемы может быть другим. Заботьтесь об эффективности, только если профилирование показывает, что есть проблема.

...