Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have a matrix m1 of size $3 \times 19$.

Rows $1$, $2$ and $3$ represent $3$ different groups, and columns represent $4$ different blocks:

  1. block1 - columns $1$, $2$, and $3$,
  2. block2 - columns $4$, $5$, $6$, $7$, and $8$,
  3. block3 - columns $9$, $10$, $11$, and $12$,
  4. block4 - columns $13$--$19$.

I want to construct a SparseArray, of the size $3 \times 19$, such that if any of the matrix m1 elements is less than for example $5000$, then all of the elements of the corresponding group and block should be equal to $1$. If all of the elements of the corresponding group and block are greater than $5000$, then the values of the SparseArray should be equal to $0$.

This is my input matrix m1:

    m1 = {{17000, 14542, 17000, 7000, 7000, 7000, 7000, 5666, 5127, 3810, 
       6027, 7000, 12000, 12000, 12000, 12000, 12000, 17000, 
       12000}, {17000, 12070, 17000, 7000, 7000, 7000, 7000, 5100, 4435, 
       3010, 5575, 7000, 12000, 12000, 12000, 12000, 12000, 17000, 
       12000}, {17000, 9743, 17000, 7000, 7000, 7000, 5530, 4250, 4358, 
       2876, 5002, 7000, 12000, 12000, 12000, 12000, 12000, 17000, 12000}}

I use Map and Boole to generate matrix m2:

    m2 = Boole[Map[# < 5000 &, m1, {2}]]

This is the output for m2:

(* {{0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, 
    {0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}, 
    {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0}} *)

Then I need to specify the conditions for my final solution.

    solution=Normal[SparseArray[{
         {i_, j_} /; i == 1 && 1 <= j <= 3 && Total[m2[[1, 1 ;; 3]]] >= 1 -> 1, 
         {i_, j_} /; i == 1 && 4 <= j <= 8 && Total[m2[[1, 4 ;; 8]]] >= 1 -> 1, 
         {i_, j_} /; i == 1 && 9 <= j <= 12 && Total[m2[[1, 9 ;; 12]]] >= 1 -> 1,
         {i_, j_} /; i == 1 && 13 <= j <= 19 && Total[m2[[1, 13 ;; 19]]] >= 1 -> 1, 
         {i_, j_} /; i == 2 && 1 <= j <= 3 && Total[m2[[2, 1 ;; 3]]] >= 1 -> 1, 
         {i_, j_} /; i == 2 && 4 <= j <= 8 && Total[m2[[2, 4 ;; 8]]] >= 1 -> 1,
         {i_, j_} /; i == 2 && 9 <= j <= 12 && Total[m2[[2, 9 ;; 12]]] >= 1 -> 1,
         {i_, j_} /; i == 2 && 13 <= j <= 19 && Total[m2[[2, 13 ;; 19]]] >= 1 -> 1, 
         {i_, j_} /; i == 3 && 1 <= j <= 3 && Total[m2[[3, 1 ;; 3]]] >= 1 -> 1,
         {i_, j_} /; i == 3 && 4 <= j <= 8 && Total[m2[[3, 4 ;; 8]]] >= 1 -> 1,
         {i_, j_} /; i == 3 && 9 <= j <= 12 && Total[m2[[3, 9 ;; 12]]] >= 1 -> 1,
         {i_, j_} /; i == 3 && 13 <= j <= 19 && Total[m2[[3, 13 ;; 19]]] >= 1 -> 1,
         Dimensions[m2]]]

This is the result I wanted:

(* {{0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, 
    {0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, 
    {0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}} *)

I believe that there is a better way to get the results I need.

share|improve this question

1 Answer 1

up vote 5 down vote accepted

Edit

I enjoy using image functions for solving non-imaging problems. Here is a way:

row = Flatten[Block[{i = 0}, ConstantArray[++i, #] & /@ {3, 5, 4, 7}]];
a = {row, row + Max@row, row + 2 Max@row};     (* It's a "morphological view" of m1*)
f[m_] := Unitize[Floor[a /. ComponentMeasurements[{a, Image[m1/5000]}, "Min", # < 1 &]]] - 1 // Abs
f[m1]
(*
{{0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, 
 {0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, 
 {0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}}
*)

*Old incarnation *

(* Create matrix "a" components according to your Blocks defs *)
row = Flatten[Block[{i = 0}, ConstantArray[++i, #] & /@ {3, 5, 4, 7}]];
a = {row, row + Max@row, row + 2 Max@row};
ArrayPlot[a, ColorFunction -> "Rainbow"]

Mathematica graphics

(* Build a vector "rep" with one binary byte for each block in matrix "a" *)
rep = Boole[# < 5000] & /@ (Extract[m, #] & /@ Position[a, #] & /@ 
      Range@Max@a) /. x : {_Integer ..} :> Min[x];

(* Replace each block value for its corresponding spec *)
b = a /. Thread[Range@Max@a -> rep]
ArrayPlot[b, ColorFunction -> "Rainbow"]

(*
{{0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, 
 {0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}, 
 {0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0}}
*)

Mathematica graphics

share|improve this answer
    
Thank you for your quick answer. I will spend some time to understand what you did. My intention was to get the result in the form of a SparseArray, because i plan to use it later in my model. I read that SparseArrays are good for conserving memory and performance reasons. Can you compare performances between mine and your (elegant) solution? –  bst Oct 28 '13 at 21:03
    
@bst What dimension of your problem is going to be stressed? Do you need to do this for larger matrices? Or many times for different m1s? –  belisarius Oct 28 '13 at 21:12
    
Many times for different 'm1's. Btw, I've tried to edit your solution, i.e. to change the argument of the 'Extract' function to 'b1', in order to be consistent with the question, but I could't, because it says that changes must contain at least 6 characters –  bst Oct 28 '13 at 21:27
    
@bst in my very slow machine 10^4 iterations of my code ate up 4 seconds. Do you need timings much better than that? –  belisarius Oct 28 '13 at 21:43
    
f[m_] := a /. Thread[ Range@Max@ a -> (Boole[# < 5000] & /@ (Extract[m, #] & /@ Position[a, #] & /@ Range@Max@a) /. x : {_Integer ..} :> Min[x])] –  belisarius Oct 28 '13 at 21:44

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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