Add new function TRANSPOSE()

Author: Joe7M

samples/distro-examples/tests/matrices.bas

@@ -64,3 +64,17 @@ m3rotate m, 2
 m3Apply m, strip
 if (strip != [[-18.23450585285103,14.19218649794793],[-10.96012643824558,17.52136119032507]]) then throw "m3Apply failed"
 
+A = [1;2;3;4]
+B = transpose(A)
+if (B[0] != 1) then throw "Error TRANSPOSE()"
+if (B[1] != 2) then throw "Error TRANSPOSE()"
+if (B[2] != 3) then throw "Error TRANSPOSE()"
+if (B[3] != 4) then throw "Error TRANSPOSE()"
+A = [1,2; 3,4; 5,6]
+B = transpose(A)
+if (B[0,0] != 1) then throw "Error TRANSPOSE()"
+if (B[0,1] != 3) then throw "Error TRANSPOSE()"
+if (B[0,2] != 5) then throw "Error TRANSPOSE()"
+if (B[1,0] != 2) then throw "Error TRANSPOSE()"
+if (B[1,1] != 4) then throw "Error TRANSPOSE()"
+if (B[1,2] != 6) then throw "Error TRANSPOSE()"

src/common/blib_func.c

@@ -2781,6 +2781,51 @@ void cmd_genfunc(long funcCode, var_t *r) {
       mat_tov(r, m1, n, n, 1);
       free(m1);
     }
+  }
+    break;
+    //
+    // array <- TRANSPOSE(a)
+    //
+  case kwTRANSPOSE: {
+    int32_t rows, cols, pos1, pos2;
+    var_t *e;
+
+    v_init(r);
+    var_t *a = par_getvarray();  
+    IF_ERR_RETURN;    
+    
+    if (v_maxdim(a) > 2) {
+      err_matdim();
+      IF_ERR_RETURN;
+    }
+    
+    rows = ABS(v_lbound(a, 0) - v_ubound(a, 0)) + 1;
+
+    if (v_maxdim(a) == 2) {
+      cols = ABS(v_lbound(a, 1) - v_ubound(a, 1)) + 1;
+    } else {
+      cols = rows;
+      rows = 1;
+    }
+    
+    var_num_t *m = (var_num_t *)malloc(((rows) * (cols)) * sizeof(var_num_t));
+    
+    for(int32_t x = 0; x < cols; x++) {
+      for(int32_t y = 0; y < rows; y++) {
+        pos1 = y * cols + x;
+        pos2 = x * rows + y;        
+        e = v_elem(a, pos1);
+        m[pos2] = v_getval(e);
+      }
+    }
+
+    if(cols > 1) {
+      mat_tov(r, m, cols, rows, 1);
+    } else {
+      mat_tov(r, m, rows, 1, 0);
+    }
+    
+    free(m);    
   }
     break;
     //

src/common/eval.c

@@ -1205,6 +1205,7 @@ static inline void eval_callf(var_t *r) {
   case kwGAUSSJORDAN:
   case kwFILES:
   case kwINVERSE:
+  case kwTRANSPOSE:
   case kwDETERM:
   case kwJULIAN:
   case kwDATEFMT:

src/common/kw.h

@@ -366,6 +366,7 @@ enum func_keywords {
   kwGAUSSJORDAN,
   kwFILES,
   kwINVERSE,
+  kwTRANSPOSE,
   kwDETERM,
   kwJULIAN,
   kwDATEFMT,

src/languages/keywords.en.c

@@ -308,6 +308,7 @@ struct func_keyword_s func_table[] = {
 { "LINEQN",                     kwGAUSSJORDAN },
 { "FILES",                      kwFILES },
 { "INVERSE",                    kwINVERSE },
+{ "TRANSPOSE",                  kwTRANSPOSE },
 { "DETERM",                     kwDETERM },
 { "JULIAN",                     kwJULIAN },
 { "DATEFMT",                    kwDATEFMT },