This is a follow-up question from here: Define a 4d matrix without for loop

I have a 400x400 2d matrix reshaped from a 4d matrix H(i,j,k,l),

H(0,0,0,0)  H (0,0,0,1) ... H(0,0,0,N)... H(0,0,1,0) ... H(0,0,N,N)
H(0,1,0,0)  H (0,1,0,1) ... H(0,1,0,N)... H(0,1,1,0) ... H(0,1,N,N)
H(1,0,0,0)  H (1,0,0,1) ... H(1,0,0,N)... H(1,0,1,0) ... H(1,0,N,N)
H(N,N,0,0)  H (N,N,0,1) ... H(N,N,0,N)... H(N,N,1,0) ... H(N,N,N,N)

now I would like to modify/delete some rows and columns like this:

  1. If i==j, then half this element
  2. If i>j OR k>l, then delete this element

I have checked the manual for DeleteCase and some other resources but have no luck yet. Does anyone has a idea how to implement it? Thanks.

UPDATED: Kglr has given the pre and post matrix forms in the answer. Thanks.

f1 = Partition[# @@@ Tuples[Range[0, #2], #2 + 1], (#2 + 1)^2] &;
m1 = f1[H, 3];

Use ReplaceAll

m2 = m1 /.  H[i_, j_, k_, l_] /; (i > j || k > l) :> Sequence[] /. 
            H[i_, i_, k_, l_] :> H[i, i, k, l]/2 /. {} -> Style[0, Red];

Or DeleteCases

m2b = DeleteCases[m1, H[i_, j_, k_, l_] /; (i > j || k > l), 2] /. 
         a : H[i_, i_, _, _] :> a/2 /. {} -> Style[0, Red]

m2b == m2


Or, construct the original matrix using your conditions

m2c = ArrayReshape[ Array[Which[# > #2 || #3 > #4, foo, # == #2, H[##]/2, True, H[##]] &,
       {4, 4, 4, 4}, {0, 0, 0, 0}], {16, 16}] /. foo -> Sequence[] /. {} -> Style[0, Red]

 m2c == m2


Style[0,Red] is for the purpose of checking if the right rows and columns are deleted. Replace Style[0,Red] with Sequence[] after verifying that f1 works as intended.

(In the following, H[a, b, c, d] is replaced with H[abcd] to see the entire matrix in the notebook window).

MatrixForm@(m1 /. H[a___] :> H[StringJoin[ToString /@ {a}]])

Mathematica graphics

MatrixForm@(m2 /. H[a___] :> H[StringJoin[ToString /@ {a}]])

Mathematica graphics

  • $\begingroup$ No, the code does not work out. Actually I got m1, m2 the same $\endgroup$
    – James LT
    May 2 '16 at 17:25
  • $\begingroup$ @James, another ` /. {}->Sequence[]` is needed at the end.I updated with this correction and screenshots of m1 and m2 (MMA Version 9 Windows 10) $\endgroup$
    – kglr
    May 2 '16 at 17:48
  • $\begingroup$ Thanks. The rows look fine, but in the column it seems entries like 0010 and 0020 (with 1/2) still exist in the matrix. $\endgroup$
    – James LT
    May 2 '16 at 17:57
  • $\begingroup$ @James, I see; looks like i misread the requirements. I updated with a fix. $\endgroup$
    – kglr
    May 2 '16 at 18:02
  • $\begingroup$ Sorry, actually those 1/2 entries should be zeros because for them k >l, so according to the second rule, they should be deleted, but really thank you for the help. $\endgroup$
    – James LT
    May 2 '16 at 18:10

When you can't quite figure out why DeleteCases isn't working

matrix = Table[H[i, j, k, l], {i, 1, 6}, {j, 1, 6}, {k, 1, 6}, {l, 1, 6}];
(matrix //. {
  H[i_, i_, k_, l_] -> h[i, i, k, l]/2, 
  H[i_, j_, k_, l_] /; (i > j || k > l) -> {}}) //. {
{} -> Sequence[],
h[i_, i_, k_, l_] -> H[i, i, k, l]}

Step 1: Always include a line of code that generates test data so others can easily verify the result. This needs to be something much less than 400^4 elements, but just enough that you and others can actually verify the output is correct. Showing what you want the output to be is even better and makes it more likely that others will check to see they have produced the right answer on the first try.

Step 2: Use //. (which is ReplaceRepeated) to again and again make substitutions. Give //. a list of substitutions to do.

Step 3: Do the first of your conditions, replace H[i,i,j,k] with H[i,i,j,k]/2 AND notice I've repeated the i to make it match your pattern i==j BUT you don't want this to happen repeatedly, so turn H into h to make it only work once on each H. When you understand this method of programming you can, like everything else in Mathematica, rewrite this in a dozen different ways.

Step 4: Do the second of your conditions i>j OR k>l and replace that with something you cannot fail to recognize later, the empty list {} is one choice that works.

Step 5: now when multitudes of replacements have been finished THEN turn those h back into H and those {} into nothing. The ( and ) means this step will not happen until after step 4 is done.

Now check all this very carefully, find any mistakes and misunderstandings, explain those and I'll try to fix what I just did.

  • $\begingroup$ Thanks, but could you briefly explain the function of each line? $\endgroup$
    – James LT
    May 2 '16 at 1:39
  • $\begingroup$ It seems the code does not do the magic. Also, btw, the last k in the first line of your code should be l, I guess? $\endgroup$
    – James LT
    May 2 '16 at 17:18
  • $\begingroup$ @James Thank you for catching my "k should be l" typo. I apologize for that. That is fixed. Next "the code does not do the magic", can you edit your original post to include a line of code that generates an example matrix of perhaps size 6x6x6x6 AND include EXACTLY what the output should be for that matrix? "does not do the magic" doesn't give me any clue where the error is. Thank you. $\endgroup$
    – Bill
    May 2 '16 at 18:23
  • $\begingroup$ Hi, kglr has given the whole solution. You can refer to the screenshots in kglr's post. Thanks for your solution. $\endgroup$
    – James LT
    May 2 '16 at 22:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.