Re: FLTMA: A little group theory (long source)

I get an error, "expected array" for redim zt(100,100) As Long but not
for redim xt or yt. Hm.

I am gone until 4 PM.

FYI.

======================== FLTMA 3 in VB 4.0 =======================

Option Base 1
Public target, exponent As Long
Public x, y, z, xt, yt, zt As Long
Public ixz, iyz, ixy, iyx As Long
Public oxyz, oyxz, ozxy, ozyx, zxyz, zyxz As Long
Public qxiyz, qyixz, qzixy, qziyx As Long
Public vscroll_old As Long

Private Sub look_for_target(exponent)

Text1.Text = "Started" & vbCrLf & vbCrLf

For z = 5 To 5
For y = 4 To z
For x = 3 To y
If _
gcd(x, y) = 1 And _
gcd(y, z) = 1 And _
gcd(x, z) = 1 And _
(x Mod 2) + (y Mod 2) + (z Mod 2) = 2 And _
(x < y) And (y < z) And (z < (x + y)) And _
(Phi(x) * Phi(y) * Phi(z)) Mod 3 = 0 Then

Find (exponent)
Update

If _
(zxyz + zyxz) > 1 And _
zxyz = exponent And _
xyzx = exponent And _
ozxy = exponent And _
ozyx = exponent Then _
Text1.Text = Text1.Text & exponent & x & y & z & vbCrLf


End If

Next x
Next y
Next z


Text1.Text = Text1.Text & "Stopped" & vbCrLf


End Sub


Public Function Phi(n)
b = 0
For a = 1 To n - 1
If (gcd(n, a) = 1) Then b = b + 1

Next a
Phi = b

End Function

Public Function gcd(a, b)

For c = min(a, b) To 1 Step -1
If a Mod c = 0 And b Mod c = 0 Then d = c: Exit For

Next c
gcd = d
End Function

Public Function max(a, b)
If a < b Then max = b Else max = a
End Function

Public Function min(a, b)
If a < b Then min = a Else min = b

End Function











Private Sub dx_Change()
x = dx.Value
xd.Text = x
Update
End Sub

Private Sub dy_Change()
y = dy.Value
yd.Text = y
Update
End Sub

Private Sub dz_Change()
z = dz.Value
zd.Text = z
Update
End Sub





Private Sub Find(exponent As Long)

ReDim xt(100, 100) As Long
For rx = 1 To x - 1
For sx = 1 To x - 1
If gcd(rx, x) = 1 And gcd(sx, x) = 1 Then
xt(rx, sx) = (rx * sx) Mod x
Else
xt(rx, sx) = 0
End If
Next sx, rx

ReDim yt(100, 100) As Long
For ry = 1 To y - 1
For sy = 1 To y - 1
If gcd(ry, y) = 1 And gcd(sy, y) = 1 Then
yt(ry, sy) = (ry * sy) Mod y
Else
yt(ry, sy) = 0
End If
Next sy, ry

ReDim zt(100, 100) As Long
For rz = 1 To z - 1
For sz = 1 To z - 1
If gcd(rz, z) = 1 And gcd(sz, z) = 1 Then
zt(rz, sz) = (rz * sz) Mod z
Else
zt(rz, sz) = 0
End If
Next sz, rz


yx = y Mod x: iyx = 1
For i = 1 To x - 1
If (xt(yx, i)) = 1 Then iyx = i: Exit For
Next i

xy = x Mod y: ixy = 1
For i = 1 To y - 1
If (yt(xy, i)) = 1 Then ixy = i: Exit For
Next i

yz = y Mod z: iyz = 1
For i = 1 To z - 1
If (zt(yz, i)) = 1 Then iyz = i: Exit For
Next i

xz = x Mod z: ixz = 1
For i = 1 To z - 1
If (zt(xz, i)) = 1 Then ixz = i: Exit For
Next i

qxiyz = zt(x Mod z, iyz)
qyixz = zt(y Mod z, ixz)
qzixy = yt(z Mod y, ixy)
qziyx = xt(z Mod x, iyx)

p = 1
For n = 1 To exponent
p = zt(p, qxiyz)
If p = z - 1 Then zxyz = n: Exit For
Next n
If n = exponent Then zxyz = 0

p = 1
For n = 1 To exponent
p = zt(p, qyixz)
If p = z - 1 Then zyxz = n: Exit For
Next n
If n = exponent Then zyxz = 0

p = 1
For n = 1 To exponent + exponent
p = zt(p, qxiyz)
If p = 1 Then oxyz = n: Exit For
Next n

p = 1
For n = 1 To exponent + exponent
p = zt(p, qyixz)
If p = 1 Then oyxz = n: Exit For
Next n

p = 1
For n = 1 To exponent
p = yt(p, qzixy)
If p = 1 Then ozxy = n: Exit For
Next n

p = 1
For n = 1 To exponent
p = xt(p, qziyx)
If p = 1 Then ozyx = n: Exit For
Next n



End Sub


Private Sub Exp_2_Click()
target = 2
look_for_target (target)


End Sub


Private Sub Exp_3_Click()
target = 3
look_for_target (target)

End Sub

Private Sub Form_Load()
vscroll_old = 0
Dim xt(100, 100) As Long
Dim yt(100, 100) As Long
Dim zt(100, 100) As Long
End Sub

Private Sub Update()


xb(1).Text = "Phi(" & x & ") = " & Phi(x)

yb(1).Text = "Phi(" & y & ") = " & Phi(y)
zb(1).Text = "Phi(" & z & ") = " & Phi(z)


Proceed.Visible = False

If _
gcd(x, y) = 1 And _
gcd(y, z) = 1 And _
gcd(x, z) = 1 And _
(x Mod 2) + (y Mod 2) + (z Mod 2) = 2 And _
(x < y) And (y < z) And (z < (x + y)) Then

Proceed.Visible = True

invxz.Text = x & " * " & ixz & " == 1 mod " & z
invyz.Text = y & " * " & iyz & " == 1 mod " & z
invxy.Text = x & " * " & ixy & " == 1 mod " & y
invyx.Text = y & " * " & iyx & " == 1 mod " & x

xiy.Text = y & " * " & qxiyz & " == " & x & " mod " & z
yix.Text = x & " * " & qyixz & " == " & y & " mod " & z
zix.Text = x & " * " & qzixy & " == " & z & " mod " & y
ziy.Text = y & " * " & qziyx & " == " & z & " mod " & x

xyz.Text = ""
If zxyz > 0 Then
xyz.Text = qxiyz & "^" & zxyz & " == -1 mod " & z
End If

yxz.Text = ""
If zyxz > 0 Then
yxz.Text = qyixz & "^" & zyxz & " == -1 mod " & z
End If

zxy.Text = qzixy & "^" & ozxy & " == 1 mod " & y
zyx.Text = qziyx & "^" & ozyx & " == 1 mod " & x

End If

FLTMA.Refresh

End Sub




















Private Sub Start_Click()
x = 3
y = 4
z = 5
Find (z)
Update



End Sub



Private Sub VScroll1_Change()
diff = VScroll1.Value - vscroll_old
x = x - diff
y = y - diff
z = z - diff
vscroll_old = VScroll1.Value
Update
End Sub


============================================

Doug

.

Relevant Pages

  • Re: FLTMA: A little group theory
    ... I have a phi function and a search routine in FLTMA 3 in VB 4.0. ... Private Sub look_for_target ... Find (exponent) ...
    (sci.math)
  • Re: Giving mouse movement lag
    ... Your REDIM is wiping out the values in the tables before they get processed. ... Dim iXAs Integer ... Private Sub Form1_Click(ByVal sender As Object, ... The idea is, Form1_MouseMove adds the current mouse coords to an array, and also the current time to a secondary array. ...
    (microsoft.public.dotnet.languages.vb)
  • Re: Giving mouse movement lag
    ... use ReDim Preserve instead. ... Dim iXAs Integer ... Private Sub Form1_Click(ByVal sender As Object, ... Form1_MouseMove adds the current mouse coords to an array ...
    (microsoft.public.dotnet.languages.vb)
  • Re: Checking an Array
    ... > Schmidt wrote: ... >> Private Sub Command1_Click ... >> ReDim Arr ... Dim Arr() As Long ...
    (microsoft.public.vb.general.discussion)
  • Re: tasks being renamed when moving to archive folder
    ... Private Sub oTasks_ItemRemove ... Dim olOldFolder As String ... Set oTask = oExplorer.Selection ... ReDim garrTask ...
    (microsoft.public.outlook.program_vba)