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

# check all permutations of mixed mode sparse addition:
# rr     ->   Real    + Real    = Real
# cc     ->   Complex + Complex = Complex
# rc     ->   Real    + Complex = Complex
# cr     ->   Complex + Real    = Complex
# cx     ->   Real    + i Real  = Complex

CATMSG push no catmsg
"ranint" missing
IF
    "math.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_spadd_rr ( n --- ) # {{{1
    # Word tested:  spadd_rr      Real + Real
    # Creates two random sparse matrices of i x j, where i & j are random
    # values less than <= n.  They are added with the sparse code, then
    # converted to dense and added that way.  The sparse sum is compared
    # to the dense sum.
    1.0e-18 is TOLERANCE

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

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

    C sperror dup "%.0f " format . 0 > 
    IF 
        " index ERROR "  . nl
        "A.sp" A sp_write
        "B.sp" B sp_write
        " spadd_rr ERROR; Wrote A and B to A.sp, B.sp " . nl
        halt
    ELSE    
        " idx OK " . 
    THEN
    nl
    xx

    ; # 1}}}
define: chk_spadd_cc ( n --- ) # {{{1
    # Word tested:  spadd_cc      Complex + Complex
    1.0e-18 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR      \ rows
    rand * integer 1 + into nC      \ columns 
    rand               into rhoAr   \ density [Ar]
    rand               into rhoAi   \ density [Ai]
    rand               into rhoBr   \ density [Br]
    rand               into rhoBi   \ density [Bi]

    nR " %3.0f x " format .  nC " %3.0f " format .  rhoAr " rA=(%5.3f," format .  rhoAi "%5.3f)" format .  rhoBr "rB=(%5.3f," format .  rhoBi "%5.3f)" format . 

    nR nC rhoAr sprand into Ar
    nR nC rhoAi sprand into Ai
    nR nC rhoBr sprand into Br
    nR nC rhoBi sprand into Bi
    Ar dense Ai dense complex sparse into A
    Br dense Bi dense complex sparse into B
    A B spadd into C            # C  = A + B    all sparse

    A dense B dense + into Cd   # Cd = dense(A) + dense(B)

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

    C sperror dup "%.0f " format . 0 > 
    IF 
        " index ERROR "  . nl
        "A.sp" A sp_write
        "B.sp" B sp_write
        " spadd_cc ERROR; Wrote A and B to A.sp, B.sp " . nl
        halt
    ELSE    
        " idx OK" . 
    THEN
    nl
    xx

    ; # 1}}}
define: chk_spadd_rc ( n --- ) # {{{1
    # Word tested:  spadd_rc      Real    + Complex
    1.0e-18 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR      \ rows
    rand * integer 1 + into nC      \ columns 
    rand               into rhoA    \ density [A]
    rand               into rhoBr   \ density [Br]
    rand               into rhoBi   \ density [Bi]

    nR " %3.0f x " format .  nC " %3.0f " format .  rhoA " rA=%5.3f " format . rhoBr "rB=(%5.3f," format .  rhoBi "%5.3f)" format . 

    nR nC rhoA  sprand into A 
    nR nC rhoBr sprand into Br
    nR nC rhoBi sprand into Bi
    Br dense Bi dense complex sparse into B
    A B spadd into C            # C  = A + B    all sparse

    A dense nR nC null complex B dense + into Cd   # Cd = dense(A) + dense(B)

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

    C sperror dup "%.0f " format . 0 > 
    IF 
        " index ERROR "  . nl
        "A.sp" A sp_write
        "B.sp" B sp_write
        " spadd_rc ERROR; Wrote A and B to A.sp, B.sp " . nl
        halt
    ELSE    
        " idx OK" . 
    THEN
    nl
    xx

    ; # 1}}}
define: chk_spadd_cr ( n --- ) # {{{1
    # Word tested:  spadd_cr      Complex + Real   
    1.0e-18 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR      \ rows
    rand * integer 1 + into nC      \ columns 
    rand               into rhoAr   \ density [Ar]
    rand               into rhoAi   \ density [Ai]
    rand               into rhoB    \ density [B]

    nR " %3.0f x " format .  nC " %3.0f " format .  rhoAr "rA=(%5.3f," format .  rhoAi "%5.3f)" format .  rhoB " rB=%5.3f " format . 

    nR nC rhoAr sprand into Ar
    nR nC rhoAi sprand into Ai
    nR nC rhoB  sprand into B 
    Ar dense Ai dense complex sparse into A
    A B spadd into C            # C  = A + B    all sparse

    A dense B dense nR nC null complex + into Cd   # Cd = dense(A) + dense(B)

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

    C sperror dup "%.0f " format . 0 > 
    IF 
        " index ERROR "  . nl
        "A.sp" A sp_write
        "B.sp" B sp_write
        " spadd_cr ERROR; Wrote A and B to A.sp, B.sp " . nl
        halt
    ELSE    
        " idx OK" . 
    THEN
    nl
    xx

    ; # 1}}}
define: chk_spadd_cx ( n --- ) # {{{1
    # Word tested:  spadd_cx      Real + i Real -> Complex
    # When word 'complex' has two sparse arguments it invokes word 'spadd_cx'.
    1.0e-18 is TOLERANCE

    dup
    dup
rand drop # for some reason the first random number is always the same???
    rand * integer 1 + into nR      \ rows
    rand * integer 1 + into nC      \ columns 
    rand               into rhoA    \ density [A]
    rand               into rhoB    \ density [B]

    nR " %3.0f x " format .  nC " %3.0f " format .  rhoA " rA=%5.3f," format .  rhoB "rB=%5.3f " format . 

    nR nC rhoA sprand into A
    nR nC rhoB sprand into B
    A dense B dense complex       is C_true
    A       B       complex dense is C_test

    C_true C_test -
    abs maxfetch drop drop 
    dup .
    TOLERANCE > 
    IF  
        " spadd_cx ERROR " . 
        "A.sp" A sp_write
        "B.sp" B sp_write
        " spadd_cx ERROR; Wrote A and B to A.sp, B.sp " . nl
        halt
    ELSE  
        " spadd_cx  OK " . 
    THEN

    nl
    xx

    ; # 1}}}
define: n_spadd_rr_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spadd_rr nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%4.0f. " format .
        chk_spadd_rr
        xx
    LOOP
    ; # 1}}}
define: n_spadd_cc_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spadd_cc nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%4.0f. " format .
        chk_spadd_cc
        xx
    LOOP
    ; # 1}}}
define: n_spadd_rc_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spadd_rc nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%4.0f. " format .
        chk_spadd_rc
        xx
    LOOP
    ; # 1}}}
define: n_spadd_cr_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spadd_cr nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%4.0f. " format .
        chk_spadd_cr
        xx
    LOOP
    ; # 1}}}
define: n_spadd_cx_tests ( nIter nSize  --- ) # {{{1
    # Invokes chk_spadd_cx nIter times for a random sized systems (up to nSize)
    into nSize
    1 DO I nSize 
        I "%4.0f. " format .
        chk_spadd_cx
        xx
    LOOP
    ; # 1}}}

time seedset
# Iter Size
  100  50  n_spadd_rr_tests  nl
  100  50  n_spadd_cc_tests  nl
  100  50  n_spadd_cr_tests  nl
  100  50  n_spadd_rc_tests  nl
  100  50  n_spadd_cx_tests  nl
