XProfan

' Traditionelle Matrixmultiplikation V1.3beta (Demo by P.Specht. Nur zu Timingzwecken gedacht!)
' HIER GEWÜNSCHTE TESTDIMENSIONEN EINGEBEN:
' Zeilen,Spalten von A / Gestürzte Spalten s&, gestürzte Zeilen t& von B
var z&= 1000 : var s&= 100 : var t&= 100
' Vorbereitung
WindowTitle "Traditionelle Matrixmultiplikation (Nur für Timingzwecke)"
Font 2:@Set("RandSeed",10):Cls rnd(8^8)
set("Decimals",18)
Declare A![z&,s&],B![s&,t&],C![z&,t&],i&,j&,k&,w!,tm&,a$
' Matrix A traditionell mit Zufallswerten <> 0 belegen
Print " Erforderlicher Speicherplatz: ";int(((z&*s&+s&*t&+z&*t&)*8));" Byte"
Print " Matrix-Zufallsbelegung..."
tm&=&GetTickCount
i&=1:While i&<=z&
j&=1:While j&<=s&
w!=(50000000-rnd(100000000))/rnd(50000000)+1
A![i&,j&]=w!
inc j&:Endwhile
inc i&:Endwhile
tm&=&GetTickCount-tm&
Print " Matrix A ("+str$(int(s&*z&))+" Elemente) traditionell belegt in "+str$(tm&)+" ms."
' &Index hier genullt, da er nur als schnelle Schleife benötigt wird:
tm&=&GetTickCount
b![]=rnd(99999+0*&Index)+1
tm&=&GetTickCount-tm&
Print " Matrix B ("+str$(int(s&*t&))+" Elemente) Highspeed-zufallsbelegt in "+str$(tm&)+" ms."
' Möglichkeit zur Überprüfung der Matrixfunktion an Hand einfacher Matrizen:

If 0' Funktionstest 0 = Off , 1 = ON

    z&=2 : s&=2 : t&=2
    ' Matrix A =
    A![1,1]=2 : A![1,2]=0
    A![2,1]=0 : A![2,2]=1
    ' Matrix B =
    B![1,1]=2 : B![1,2]=0
    B![2,1]=0 : B![2,2]=1

Endif

Print " Die Matrizen sind verlinkt in Breite "+str$(s&)+" A-Spalten=B-Zeilen."
Beep
Print " ";int(z&*s&*t&);" Multiplikationen und Additionen erforderlich."
print "\n Zum Start der Matrixmultiplikation Taste drücken!"
SetTimer 12000 : WaitInput : killtimer
Print "\n Berechnung der "+str$(int(z&*t&))+" Elemente von C läuft."
Print " Ein Punkt steht jeweils für "+str$(int(t&))+" fertige Elemente."
print " Das wird ca. "+str$(int(z&/61+1))+" Zeilen benötigen."
' Traditionelle Matrixmultiplikation
tm&=&GetTickCount
W!=0
i&=1:While i&<=z&
k&=1:While k&<=t&
w!=0
j&=1:While j&<=s&
w!=w!+A![i&,j&]*B![j&,k&]
inc j&:Endwhile
C![i&,k&]=w!
inc k&:Endwhile
print ".";
case %pos>61:print
case %csrlin>22:cls
inc i&:Endwhile:print
tm&=&GetTickCount-tm&
Beep
Print " 2 Matrizen multipliziert in "+ if( tm& > 9000 , str$(tm&\1000)+" sec." ,str$(tm&)+" ms." )
Print "\n Ergebnis C ausgeben?"
WaitInput
case IsKey(27):end
case IsKey(78):end
' Ausgabe der Ergebnis-Matrix C
CLS
tm&=&GetTickCount
i&=1:While i&<=z&
print "********* Zeile "+trim$(str$(i&))+" von "+trim$(str$(z&))+":  *********"
k&=1:While k&<=t&

if %csrlin>22:SetTimer 700: WaitInput :Killtimer:cls:endif

    Print "S"+trim$(str$(k&))+":"+format$("%e",C![i&,k&]),
    case %pos > 50:print
    inc k&:Endwhile :print
    inc i&:Endwhile
    tm&=&GetTickCount-tm&
    Print "\n Matrix C ausgegeben in " + if( tm& > 9000 , str$(tm&\1000)+" sec." , str$(tm&)+" ms." )
    WaitInput
    End

WindowTitle "Beschleunigte Matrixmultiplikation"
' (CL) Copyleft 2012-09 P.Specht(at)gmx.at

if 0

     $DEFINE XPSE
     $IFDEF xpse
     {$cleq}
     $ENDIF

endif

Windowstyle 1048
window 0,0-%maxx,%maxy
randomize
font 2
cls rnd(8^8)
set("decimals",15)
set("numwidth",27)
declare z&,s&,t&,i&,j&,k&,status&
z&=100
s&=100
t&=100
dec z&:dec s&:dec t&
declare a![z&,s&],b![s&,t&],c![z&,t&]

whileLoop 0,s&

    a![&Loop,&Loop]=-1

endwhile

status&=show(z&,s&,a![]):print
b![]=rnd(1000)*10^(rnd(5)*(1-2*rnd(2)))
status&=show(s&,t&,b![]):print
var tm&=&GetTickCount
status&=Multipli(z&,s&,t&,addr(a![0,0]),addr(b![0,0]),addr(c![0,0]))
tm&=&GetTickCount-tm&
status&=show(s&,t&,c![]):print
print tm&/1000,"sec.\nREADY."
Waitinput
End

proc show

    parameters u&,v&,m![]

    if u&>5

        print u&+1;" Werte pro Zeile"

    else

        declare mm!

        whileloop 0,u&:i&=&Loop

            whileloop 0,v&:j&=&Loop

                mm!=m![i&,j&]
                'if (mm!<10^10) and (mm!>10^-11) and (mm!<>0)
                print m![i&,j&],
                'else : print format$("%e",m![i&,j&]), : endif

            endwhile

            print

            if %csrlin>30:waitinput:cls rnd(8^8):endif

            endwhile

            print

        endif

        return 1

    endproc

     $IFDEF xpse

    NProc Multipli

        parameters z&,s&,t&,a_&,b_&,c_&
        declare sum!,prod!,aa!,bb!,cc!,i&,j&,k&

        WhileLoop 0,z&:i&=&Loop

            WhileLoop 0,t&:k&=&Loop

                sum!=0.0

                WhileLoop 0,s&:j&=&Loop

                    aa!=getfloat(a_&,8*(i&+(z&+1)*j&))
                    bb!=getfloat(b_&,8*(j&+(s&+1)*k&))
                    prod!=aa!*bb!
                    sum!=sum!+prod!

                endwhile

                setfloat(c_&,8*(i&+(s&+1)*k&),sum!)

            endwhile

        endwhile

        return 0

    endproc

     $ENDIF
    'Proc Multipli
    'parameters z&,s&,t&,a_&,b_&,c_&
    'declare sum!,prod!,aa!,bb!,cc!,i&,j&,k&
    'WhileLoop 0,z&
    'i&=&Loop
    'WhileLoop 0,t&
    'k&=&Loop
    'sum!=0
    'WhileLoop 0,s&
    'j&=&Loop
    'sum!=sum!+a![i&,j&]*b![j&,k&]
    'endwhile
    'c![i&,k&]=sum!
    'endwhile
    'locate 2,2:print trim$(str$(i&));
    'endwhile
    'return 0
    'endproc