Thema Datum  Von Nutzer Rating
Antwort
09.06.2016 11:18:09 Goldstein
NotSolved
09.06.2016 13:44:34 Gast23816
NotSolved
Rot Kronecker-Produkt zweier Matrizen errechnen
11.06.2016 01:19:15 Gast63149
NotSolved

Ansicht des Beitrags:
Von:
Gast63149
Datum:
11.06.2016 01:19:15
Views:
729
Rating: Antwort:
  Ja
Thema:
Kronecker-Produkt zweier Matrizen errechnen

Keine "geeignete" Lösung gefunden ... soso - zu höhe Ansprüche? ;)

Naja, dann probier mal:

Option Explicit
'////////////////////////////////////////////////////////////////

Const E_KRONECKERPROD_INVALID_ARG As Long = XlCVError.xlErrRef
'////////////////////////////////////////////////////////////////


'////////////////////////////////////////////////////////////////
'//
Public Sub TestRun()
  
  Dim result As Variant
  Dim retVal As Variant
  
  With Worksheets("Tabelle1")
    
    retVal = KroneckerProd(.Range("B2:L12"), .Range("O2:Y12"), result)
    
    If Not IsError(retVal) Then
      'output
      .Range("B15").Resize(UBound(result), UBound(result, 2)).Value = result
    Else
      Select Case CLng(retVal)
        Case E_KRONECKERPROD_INVALID_ARG
          Call MsgBox("invalid argument(s)", vbCritical)
        Case Else
          Call MsgBox(CStr(retVal), vbCritical)
      End Select
    End If
    
  End With
  
End Sub

'////////////////////////////////////////////////////////////////
'//
Public Function KroneckerProd(ArgA As Variant, ArgB As Variant, ByRef RetArg As Variant) As Variant
  Dim vA, vB
  On Error Resume Next
  vA = ArgA: vB = ArgB
  On Error GoTo 0
  If IsArray(vA) And IsArray(vB) Then
    ReDim RetArg(1 To (UBound(vA) - LBound(vA) + 1) * (UBound(vB) - LBound(vB) + 1), _
                 1 To (UBound(vA, 2) - LBound(vA, 2) + 1) * (UBound(vB, 2) - LBound(vB, 2) + 1))
    KroneckerProd = KroneckerProd__(vA, vB, RetArg)
    If IsEmpty(KroneckerProd) Then KroneckerProd = 0
  Else
    KroneckerProd = CVErr(E_KRONECKERPROD_INVALID_ARG)
  End If
End Function

'////////////////////////////////////////////////////////////////
'//
Private Function KroneckerProd__(ArgA As Variant, ArgB As Variant, ByRef ArgC As Variant, Optional Idx1, Optional Idx2) As Variant
  Dim i&, j&, m&, n&
  If IsArray(ArgA) And IsArray(ArgB) Then
    If Not (IsMissing(Idx1) Or IsMissing(Idx2)) Then
      m = (UBound(ArgB) - LBound(ArgB) + 1)
      n = (UBound(ArgB, 2) - LBound(ArgB, 2) + 1)
      For i = 1 To m
        For j = 1 To n
          ArgC(i + (Idx1 - 1) * m, j + (Idx2 - 1) * n) = ArgA(Idx1, Idx2) * ArgB(i, j)
      Next j, i
    Else
      For i = 1 To UBound(ArgA) - LBound(ArgA) + 1
        For j = 1 To UBound(ArgA, 2) - LBound(ArgA, 2) + 1
           Call KroneckerProd__(ArgA, ArgB, ArgC, i, j)
      Next j, i
    End If
  Else
    KroneckerProd__ = CVErr(E_KRONECKERPROD_INVALID_ARG)
  End If
End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
09.06.2016 11:18:09 Goldstein
NotSolved
09.06.2016 13:44:34 Gast23816
NotSolved
Rot Kronecker-Produkt zweier Matrizen errechnen
11.06.2016 01:19:15 Gast63149
NotSolved