数学中国

 找回密码
 注册
搜索
热搜: 活动 交友 discuz
楼主: ysr

几个vb小程序

[复制链接]
 楼主| 发表于 2023-1-20 22:38 | 显示全部楼层
第一组仅仅是g线段不对了,这样的情况咋去不掉呢?都是g不对了,咋也不行,不知道如何弄,可能是公式决定了g不是整数。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-20 23:30 | 显示全部楼层
这回改过来程序了,没有解找不到解了,都是g线段不对了。

把科学计数法表示的整数改为字符串和取绝对值的代码如下:
g = Abs(Format(g, "#"))
a = Abs(Format(a, "#"))
B = Abs(Format(B, "#"))
c = Abs(Format(c, "#"))
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-22 12:49 | 显示全部楼层
本帖最后由 ysr 于 2023-1-22 13:17 编辑

Private Sub Command1_Click()
Dim a, b, c, y
a1 = Val(496)

b = 1
Do While b <= 496
c = 1
Do While c <= 496
y = Val(496 ^ 3 - b ^ 3 - c ^ 3)
If InStr(Abs(Val(y)) ^ (1 / 3), ".") = 0 Then
s = s & Abs(Val(y)) ^ (1 / 3) & "^3=" & 496 & "^3-" & b & "^3-" & c & "^3" & vbCrLf
s1 = s1 + 1
Else
s = s
End If

c = c + 1
Loop
b = b + 1
Loop


Text1 = "有" & s1 & "组解:" & s
End Sub

Private Sub Command2_Click()
Text1 = ""

End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-23 15:51 | 显示全部楼层
Private Sub Command1_Click()
Dim x, a
a1 = Val(Text1)
u = 1
Do While Val(u) <= a1
v = 1
Do While Val(v) <= a1
q = u ^ 2 - v ^ 2
p = 2 * u * v
r = 1
Do While r <= a1
a = p ^ 2 + q ^ 2 - r ^ 2
b = 2 * p * r
c = 2 * q * r
g = p ^ 2 + q ^ 2 + r ^ 2
y = a ^ 2 + b ^ 2 + c ^ 2
z = g ^ 2


If Val(y) = z And a * b * c <> 0 And InStr(Sqr(a ^ 2 + b ^ 2), ".") = 0 And InStr(Sqr(c ^ 2 + b ^ 2), ".") = 0 And InStr(Sqr(a ^ 2 + c ^ 2), ".") = 0 Then
s = s & "/g=" & Sqr(z) & "a=" & a & " b=" & b & " c=" & c & vbCrLf
s1 = s1 + 1
Else
s = s
End If
r = r + 1
Loop
v = v + 1
Loop
u = u + 1
Loop

Text2 = "有" & Val(s1) & "组完美长方体解" & s

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""

End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-24 19:39 | 显示全部楼层
Private Sub Command1_Click()
Dim x, a
a1 = Val(Text1)
u = 1
Do While Val(u) <= a1
v = 1
Do While Val(v) <= a1
q = u ^ 2 - v ^ 2
p = 2 * u * v
r = 1
Do While r <= a1
a = Abs(p ^ 2 + q ^ 2 - r ^ 2)
B = 2 * p * r
c = 2 * q * r
g = p ^ 2 + q ^ 2 + r ^ 2
Y = a ^ 2 + B ^ 2 + c ^ 2
z = g ^ 2


If Val(Y) = z And a * B * c <> 0 And InStr(Sqr(a ^ 2 + B ^ 2), ".") = 0 And InStr(Sqr(c ^ 2 + B ^ 2), ".") = 0 And InStr(Sqr(a ^ 2 + c ^ 2), ".") = 0 Then
If MPC(MPC1(MbC(Trim(a), Trim(a)), MbC(Trim(B), Trim(B))), MbC(Sqr(Val(a) ^ 2 + Val(B) ^ 2), Sqr(Val(a) ^ 2 + Val(B) ^ 2))) = 0 Then
s = s & "/g=" & Sqr(z) & "a=" & a & " b=" & B & " c=" & c & vbCrLf
s1 = s1 + 1
Else
s = s
End If
Else
s = s
End If
r = r + 1
Loop
v = v + 1
Loop
u = u + 1
Loop

Text2 = "有" & Val(s1) & "组完美长方体解" & s

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""

End Sub

Public Function MbC(D1 As String, D2 As String) As String '乘法
Dim x, Y '两数长度
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim i, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
C2 = Mid$(D2, J, 1) '每位数
For i = x To 1 Step -1 'D1
  C1 = Mid$(D1, i, 1) '每位数
  CJ = C1 * C2 + JW '计算乘积
  c = i + J: r = Y + 1 - J
  a(c, r) = CJ Mod 10 '本位
  JW = CJ \ 10 '进位
Next
a(c - 1, r) = JW
Next
Dim B() As Integer
ReDim B(1 To x + Y)
JW = 0
For i = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
  Bit = Bit + a(i, J)
Next
B(i) = Bit Mod 10
JW = Bit \ 10
Next
If B(1) > 0 Then
MbC = MbC & B(1)
Else
MbC = MbC
End If
For i = 2 To x + Y
MbC = MbC & B(i)
Next
End Function

Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim i, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J, 1) ';每位数
For i = x To 1 Step -1  ';D1
   a(i) = Mid(d3, i, 1) ';每位数
   C1(i) = 10 + a(i) - B1(i) - 1 + JW ';计算jia
   JW = C1(i) \ 10
   E1(i) = C1(i) Mod 10
  Next
  Next
  For r = 1 To x
  MPC = MPC & E1(r)
  For i = 1 To Len(MPC)
    If Not Mid(MPC, i, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MPC, i)
  If Len(strtmp) = 0 Then
  MPC = "0"
  Else
MPC = strtmp
End If
  Next
  
  
End Function

Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim i, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For i = x To 1 Step -1  'D1
   a(i) = Mid$(d3, i, 1) '每位数
   C1(i) = a(i) + B1(i) + JW '计算jia
   JW = C1(i) \ 10
   E1(i) = C1(i) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-26 16:56 | 显示全部楼层
本帖最后由 ysr 于 2023-1-26 09:38 编辑

平方数924924^2的拆分解有:1组/924924^2=355740^2+853776^2

平方数524400^2的拆分解有:2组/524400^2=146832^2+503424^2
/524400^2=314640^2+419520^2
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-31 14:35 | 显示全部楼层
python的程序是这样的: (判断素数的程序)

while True:
    try:
        a = 1
        b = 0
        c = input('请输入一个数字:')
        c = eval(c)
        d=c**0.5
        e=int(d)
        for i in range(e):
            if c % a == 0:
                b += 1
            if a < c:
                a += 1
        if b >= 2:
            print('这是一个合数')
        else:
            print('这是一个质数')
    except:
        print("错误")
        exit()
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-31 14:52 | 显示全部楼层
本帖最后由 ysr 于 2023-1-31 06:53 编辑

请输入一个数字:12345678977777777
这是一个合数
请输入一个数字:1
这是一个质数
请输入一个数字:1234567891111111
这是一个质数
请输入一个数字:2857
这是一个质数
请输入一个数字:142857
这是一个合数
请输入一个数字:1234567897777777
这是一个合数
请输入一个数字:12345678977777
这是一个合数
请输入一个数字:123456789777777
这是一个合数
请输入一个数字:1234567897777
这是一个质数
请输入一个数字:12345678977
这是一个合数
请输入一个数字:1234567897
这是一个合数
请输入一个数字:12345679
这是一个合数
请输入一个数字:12345679111
这是一个合数
请输入一个数字:123456791111
这是一个合数
请输入一个数字:1234567911
这是一个合数
请输入一个数字:123456791
这是一个质数
请输入一个数字:100000001
这是一个合数
请输入一个数字:1000001
这是一个合数
请输入一个数字:100001
这是一个合数
请输入一个数字:10001
这是一个合数
请输入一个数字:1001
这是一个合数
请输入一个数字:101
这是一个质数
请输入一个数字:100000000001
这是一个合数
请输入一个数字:1000000000001
这是一个合数
请输入一个数字:11111111111
这是一个合数
请输入一个数字:1111111
这是一个合数
请输入一个数字:11111
这是一个合数
请输入一个数字:999999999997
这是一个合数
请输入一个数字:9999999999997
这是一个合数
请输入一个数字:99999999991
这是一个合数
请输入一个数字:9999999999991
这是一个合数
请输入一个数字:

程序运行结果,输入数字必须是大于1的整数,否则就不工作了或者输出结果错误了(比如1既不是素数也不是合数),需要加入个检验输入的语句。
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-1-31 18:11 | 显示全部楼层
python中求x开y次方的代码:

import math
math.pow(x,1/y)
回复 支持 反对

使用道具 举报

 楼主| 发表于 2023-2-1 00:52 | 显示全部楼层
python中的模块(相当于可调用程序): (如下就是个判断素数的模块)

#D:\编程\Python\maths.py
def mydef():
    while True:
        try:
            a = 1
            b = 0
            c = input('请输入一个数字:')
            c = eval(c)
            d=c**0.5
            e=int(d)
            for i in range(e):
                if c % a == 0:
                    b += 1
                if a < c:
                    a += 1
            if b >= 2:
                print('这是一个合数')
            else:
                print('这是一个质数')
        except:
            print("错误")
            exit()
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|数学中国 ( 京ICP备05040119号 )

GMT+8, 2024-5-11 05:57 , Processed in 0.066406 second(s), 15 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表