#!../src/tops  -s ../sys  -u ../usr

# check all permutations of mixed mode sparse x dense and sparse x sparse
# multiplication:
#   spmult_sd = sparse x dense
#     rr     ->   Real    * Real    = Real
#     cc     ->   Complex * Complex = Complex
#     rc     ->   Real    * Complex = Complex
#     cr     ->   Complex * Real    = Complex
#   spmult_ss = sparse x sparse
#     rr     ->   Real    * Real    = Real
#     cc     ->   Complex * Complex = Complex
#     rc     ->   Real    * Complex = Complex
#     cr     ->   Complex * Real    = Complex

CATMSG push no catmsg
"ranint" missing
IF
    "math.v" source
THEN
"*c" missing
IF
    "mmath.v" source
THEN

define: sp_write ( qFile hSp --- ) # {{{1
    # Writes the sparse matrix on tos to the specified file
    swap forn binary "SP" file SP fwrite drop drop SP fclose
    ; # 1}}}
define: sp_read ( qFile --- hSp ) # {{{1
    # Loads the sparse matrix from the specified file to tos.
    old binary "SP" file SP SP file.size pry fget SP fclose
    ; # 1}}}
define: chk_spmult_sd_rr ( n --- ) # {{{1
    # Word tested:  spmult_sd_rr      Real sparse * Real dense
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoA    \ density  [A]
    nR_A " %3.0f x " format . nC_A " %3.0f " format . rhoA " rA=%5.3f," format . nR_B " %3.0f x " format . nC_B "%3.0f " format .
    nR_A nC_A rhoA sprand into A
    nR_B nC_B random      into B
    A B spmult  into C    # C  = A * B    sparse x dense multiply
    A dense B * into Cd   # Cd = dense(A) x dense(B)

    C Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_sd_rr ERROR " . 
        "A.sp" A sp_write
        " spmult_sd_rr ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_sd_rr  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_sd_rc ( n --- ) # {{{1
    # Word tested:  spmult_sd_rc      Real sparse * complex dense
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoA    \ density  [A]
    nR_A " %3.0f x " format . nC_A " %3.0f " format . rhoA " rA=%5.3f," format . nR_B " %3.0f x " format . nC_B "%3.0f " format .
    nR_A nC_A rhoA sprand into Ar
    nR_A nC_A      spnull into Ai
    nR_B nC_B random      into Br
    nR_B nC_B random      into Bi
    Ar Ai complex is A
    Br Bi complex is B
    Ar B spmult  into C            # C  = A * B    sparse x dense multiply
    Ar dense Ai dense Br Bi *c complex into Cd # Cd = dense(A) x dense(B)
    C Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_sd_rc ERROR " . 
        "A.sp" A sp_write
        " spmult_sd_rc ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_sd_rc  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_sd_cr ( n --- ) # {{{1
    # Word tested:  spmult_sd_cr      Real sparse * complex dense
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoAr   \ density  [A]
    rand               into rhoAi   \ density  [A]
    nR_A " %3.0f x " format . nC_A " %3.0f " format . rhoAr " rA=%5.3f," format . rhoAi "%5.3f " format . nR_B " %3.0f x " format . nC_B " %3.0f " format .
    nR_A nC_A rhoAr sprand into Ar
    nR_A nC_A rhoAi sprand into Ai
    nR_B nC_B random       into Br
    nR_B nC_B null         into Bi
    Ar Ai complex is A
    Br Bi complex is B
    A  Br spmult  into C            # C  = A * B    sparse x dense multiply
    Ar dense Ai dense Br Bi *c complex into Cd # Cd = dense(A) x dense(B)
    C Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_sd_cr ERROR " . 
        "A.sp" A sp_write
        " spmult_sd_cr ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_sd_cr  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_sd_cc ( n --- ) # {{{1
    # Word tested:  spmult_sd_cc      Real sparse * complex dense
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoAr   \ density  [A]
    rand               into rhoAi   \ density  [A]
    nR_A " %3.0f x " format . nC_A " %3.0f " format . rhoAr " rA=%5.3f," format . rhoAi "%5.3f " format . nR_B " %3.0f x " format . nC_B " %3.0f " format .
    nR_A nC_A rhoAr sprand into Ar
    nR_A nC_A rhoAi sprand into Ai
    nR_B nC_B random       into Br
    nR_B nC_B random       into Bi
    Ar Ai complex is A
    Br Bi complex is B
    A  B  spmult  into C            # C  = A * B    sparse x dense multiply
    Ar dense Ai dense Br Bi *c complex into Cd # Cd = dense(A) x dense(B)
    C Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_sd_cc ERROR " . 
        "A.sp" A sp_write
        " spmult_sd_cc ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_sd_cc  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_ss_rr ( n --- ) # {{{1
    # Word tested:  spmult_ss_rr      Real sparse * Real sparse
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoA    \ density  [A]
    rand               into rhoB    \ density  [B]
    nR_A " %3.0f x " format . nC_A " %3.0f " format . rhoA " rA=%5.3f," format . nR_B " %3.0f x " format . nC_B "%3.0f " format . rhoB " rB=%5.3f"
    nR_A nC_A rhoA sprand into A
    nR_B nC_B rhoB sprand into B
    A B spmult_ss_rr  into C    # C  = A * B    sparse x sparse multiply
    A dense B dense * into Cd   # Cd = dense(A) x dense(B)

    C dense Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_ss_rr ERROR " . 
        "A.sp" A sp_write
        " spmult_ss_rr ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_ss_rr  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_ss_rc ( n --- ) # {{{1
    # Word tested:  spmult_ss_rc      Real sparse * Complex sparse
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoA    \ density  [A]
    rand               into rhoBr   \ density  [Br]
    rand               into rhoBi   \ density  [Bi]
    nR_A " %3.0f x " format .  nC_A " %3.0f " format .  rhoA " rA=%5.3f" format . nR_B " %3.0f x " format .  nC_B "%3.0f " format .  rhoBr " rB=(%5.3f," format .  rhoBi "%5.3f)" format . 
    nR_A nC_A rhoA  sprand into A
    nR_B nC_B rhoBr sprand into Br
    nR_B nC_B rhoBi sprand into Bi
    Br Bi complex is B
    A B spmult_ss_rc  into C    # C  = A * B    sparse x sparse multiply
    A dense B dense * into Cd   # Cd = dense(A) x dense(B)

    C dense Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_ss_rc ERROR " . 
        "A.sp" A sp_write
        " spmult_ss_rc ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_ss_rc  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_ss_cr ( n --- ) # {{{1
    # Word tested:  spmult_ss_cr      Complex sparse * Real sparse
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoAr   \ density  [Ar]
    rand               into rhoAi   \ density  [Ai]
    rand               into rhoB    \ density  [B]
    nR_A " %3.0f x " format . nC_A " %3.0f " format . rhoAr " rA=(%5.3f," format . rhoAi "%5.3f)" format . nR_B " %3.0f x " format . nC_B "%3.0f " format . rhoB " rB=%5.3f"
    nR_A nC_A rhoAr sprand into Ar
    nR_A nC_A rhoAi sprand into Ai
    nR_B nC_B rhoB  sprand into B
    Ar Ai complex is A
    A B spmult_ss_cr  into C    # C  = A * B    sparse x sparse multiply
    A dense B dense * into Cd   # Cd = dense(A) x dense(B)

    C dense Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_ss_cr ERROR " . 
        "A.sp" A sp_write
        " spmult_ss_cr ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_ss_cr  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_ss_cc ( n --- ) # {{{1
    # Word tested:  spmult_ss_cc      Complex sparse * Complex sparse
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR_A    \ rows     [A]
    rand * integer 1 + into nC_A    \ columns  [A]
    nC_A               into nR_B    \ rows     [B]
    rand * integer 1 + into nC_B    \ columns  [B]
    rand               into rhoAr   \ density  [Ar]
    rand               into rhoAi   \ density  [Ai]
    rand               into rhoBr   \ density  [Br]
    rand               into rhoBi   \ density  [Bi]
    nR_A " %3.0f x " format . nC_A " %3.0f " format . rhoAr " rA=(%5.3f," format . rhoAi "%5.3f)" format . nR_B " %3.0f x " format . nC_B "%3.0f " format . rhoBr " rB=(%5.3f" format . rhoBi ",%5.3f)" format .
    nR_A nC_A rhoAr sprand into Ar
    nR_A nC_A rhoAi sprand into Ai
    nR_B nC_B rhoBr sprand into Br
    nR_B nC_B rhoBi sprand into Bi
    Ar Ai complex is A
    Br Bi complex is B
    A B spmult_ss_cc  into C    # C  = A * B    sparse x sparse multiply
    A dense B dense * into Cd   # Cd = dense(A) x dense(B)

    C dense Cd -                # dense(C) - Cd
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_ss_cc ERROR " . 
        "A.sp" A sp_write
        " spmult_ss_cc ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " ss_cc OK" .   # shorten name so output fits within 80 columns
    THEN

    nl
    xx

    ; # 1}}}
define: chk_spmult_sym_low_sd_rr ( n --- ) # {{{1
    # Word tested:  spmult_sym_low_sd_rr
    # Sparse symmetric multiplication with lower triangular matrix input.
    1.0e-13 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 2 + into nRC_A   \ rows,cols [A], also rows of [B]
    rand * integer 2 + into nC_B    \ columns  [B]
    rand               into rhoA    \ density  [A]
    nRC_A " %3.0f x " format . nRC_A " %3.0f " format . rhoA " (%5.3f) * " format . nRC_A " %3.0f x " format . nC_B " %3.0f " format . 
    nRC_A nRC_A rhoA sprand 
    dense 0 tril dup 1 tril bend + is A_full_dense  # [A] is symmetric
    A_full_dense  0 tril sparse is A

    nRC_A nC_B random is B
    A_full_dense B *  into Cd         # Cd = dense(A)        x B
    A B spmult_sym_low_sd_rr into C   # C  = sparse lower(A) x B

    C Cd -
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spmult_sym_low_sd_rr ERROR " . 
        "A.sp" A sp_write
        " spmult_sym_low_sd_rr ERROR; Wrote A to A.sp " . nl
        halt
    ELSE  
        " spmult_sym_low_sd_rr  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: n_spmult_sd_rr_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_sd_rr nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_sd_rr
        xx
    LOOP
    ; # 1}}}
define: n_spmult_sd_rc_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_sd_rc nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_sd_rc
        xx
    LOOP
    ; # 1}}}
define: n_spmult_sd_cr_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_sd_cr nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_sd_cr
        xx
    LOOP
    ; # 1}}}
define: n_spmult_sd_cc_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_sd_cc nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_sd_cc
        xx
    LOOP
    ; # 1}}}
define: n_spmult_ss_rr_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_ss_rr nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_ss_rr
        xx
    LOOP
    ; # 1}}}
define: n_spmult_ss_rc_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_ss_rc nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_ss_rc
        xx
    LOOP
    ; # 1}}}
define: n_spmult_ss_cr_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_ss_cr nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_ss_cr
        xx
    LOOP
    ; # 1}}}
define: n_spmult_ss_cc_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spmult_ss_cc nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_ss_cc
        xx
    LOOP
    ; # 1}}}
define: n_spmult_sym_low_sd_rr_tests ( nIter nSize  --- ) # {{{1
    into nSize
    1 DO I nSize 
        I "%5.0f.  " format .
        chk_spmult_sym_low_sd_rr
        xx
    LOOP
    ; # 1}}}

time seedset
# Iter Size
  100  50  n_spmult_sd_rr_tests  nl
  100  50  n_spmult_sd_rc_tests  nl
  100  50  n_spmult_sd_cr_tests  nl
  100  50  n_spmult_sd_cc_tests  nl
  100  50  n_spmult_ss_rr_tests  nl
  100  50  n_spmult_ss_rc_tests  nl
  100  50  n_spmult_ss_cr_tests  nl
  100  50  n_spmult_ss_cc_tests  nl
  100  50  n_spmult_sym_low_sd_rr_tests  nl
