XProfan

' Traditionelle Matrixmultiplikation V1.3beta (Demo by P.Pájaro carpintero. Nur a Timingzwecken pensamiento!)
' HIER GEWÜNSCHTE TESTDIMENSIONEN EINGEBEN:
' Zeilen,Spalten de A / Gestürzte Spalten s&, gestürzte Zeilen t& de B
var z&= 1000 : var s&= 100 : var t&= 100
' Vorbereitung
Título de la ventana "Traditionelle Matrixmultiplikation (Nur para Timingzwecke)"
Font 2:@Conjunto("RandSeed",10):Cls rnd(8^8)
set("Decimals",18)
Declarar A![z&,s&],B![s&,t&],C![z&,t&],i&,j&,k&,w!,tm&,a$
' Matrix A traditionell con Zufallswerten <> 0 ocupar
Imprimir " Erforderlicher Speicherplatz: ";int(((z&*s&+s&*t&+z&*t&)*8));" Byte"
Imprimir " Matrix-Zufallsbelegung..."
tm&=&GetTickCount
i&=1:Mientras que i&<=z&
j&=1:Mientras que j&<=s&
w!=(50000000-rnd(100000000))/rnd(50000000)+1
A![i&,j&]=w!
inc j&:Endwhile
inc i&:Endwhile
tm&=&GetTickCount-tm&
Imprimir " Matrix A ("+str$(int(s&*z&))+" Elemente) traditionell belegt en "+str$(tm&)+" ms."
' &Index hier genullt, como él sólo como schnelle Bucle benötigt se:
tm&=&GetTickCount
b![]=rnd(99999+0*&Index)+1
tm&=&GetTickCount-tm&
Imprimir " Matrix B ("+str$(int(s&*t&))+" Elemente) Highspeed-zufallsbelegt en "+str$(tm&)+" ms."
' Möglichkeit a Überprüfung el Matrixfunktion a 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

Imprimir " El Matrizen son verlinkt en Breite "+str$(s&)+" A-Spalten=B-Zeilen."
Beep
Imprimir " ";int(z&*s&*t&);" Multiplikationen y Additionen erforderlich."
imprimir "\n Zum Start el Matrixmultiplikation Taste drücken!"
SetTimer 12000 : WaitInput : killtimer
Imprimir "\n Berechnung el "+str$(int(z&*t&))+" Elemente de C se ejecuta."
Imprimir " Ein Punkt es jeweils para "+str$(int(t&))+" fertige Elemente."
imprimir " Das se ca. "+str$(int(z&/61+1))+" Zeilen benötigen."
' Traditionelle Matrixmultiplikation
tm&=&GetTickCount
W!=0
i&=1:Mientras que i&<=z&
k&=1:Mientras que k&<=t&
w!=0
j&=1:Mientras que j&<=s&
w!=w!+A![i&,j&]*B![j&,k&]
inc j&:Endwhile
C![i&,k&]=w!
inc k&:Endwhile
imprimir ".";
caso %pos>61:imprimir
caso %csrlin>22:cls
inc i&:Endwhile:imprimir
tm&=&GetTickCount-tm&
Beep
Imprimir " 2 Matrizen multipliziert en "+ if( tm& > 9000 , str$(tm&\1000)+" sec." ,str$(tm&)+" ms." )
Imprimir "\n Ergebnis C ausgeben?"
WaitInput
caso IsKey(27):end
caso IsKey(78):end
' Edición el Ergebnis-Matrix C
CLS
tm&=&GetTickCount
i&=1:Mientras que i&<=z&
imprimir "********* Línea "+trim$(str$(i&))+" de "+trim$(str$(z&))+":  *********"
k&=1:Mientras que k&<=t&

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

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

Título de la ventana "Beschleunigte Matrixmultiplikation"
' (CL) Copyleft 2012-09 P.Pájaro carpintero(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)
declarar z&,s&,t&,i&,j&,k&,status&
z&=100
s&=100
t&=100
dec z&:dec s&:dec t&
declarar a![z&,s&],b![s&,t&],c![z&,t&]

whileLoop 0,s&

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

endwhile

status&=show(z&,s&,a![]):imprimir
b![]=rnd(1000)*10^(rnd(5)*(1-2*rnd(2)))
status&=show(s&,t&,b![]):imprimir
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![]):imprimir
imprimir tm&/1000,"sec.\nREADY."
Waitinput
End

proc show

    parámetros u&,v&,m![]

    if u&>5

        imprimir u&+1;" Werte pro Zeile"

    más

        declarar 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)
                imprimir m![i&,j&],
                'más : imprimir format$("%e",m![i&,j&]), : endif

            endwhile

            imprimir

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

            endwhile

            imprimir

        endif

        volver 1

    ENDPROC

     $IFDEF xpse

    NProc Multipli

        parámetros z&,s&,t&,a_&,b_&,c_&
        declarar 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

        volver 0

    ENDPROC

     $ENDIF
    'Proc Multipli
    'parámetros z&,s&,t&,a_&,b_&,c_&
    'declarar 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:imprimir trim$(str$(i&));
    'endwhile
    'volver 0
    'ENDPROC