The first 100 satisfying the criterion are listed below with their respective SODs:
DefDbl A-Z
Dim crlf$
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
p = 11
Do
p = nxtprm(p)
ps$ = LTrim(Str(p))
good = 1: mx = 0: tot = 0: mxs = 0
For i = 1 To Len(ps)
If InStr(ps, Mid(ps, i, 1)) < i Then good = 0: Exit For
dv = Val(Mid(ps, i, 1))
tot = tot + dv
If dv > mx Then mx = dv
Next
If good Then
ss$ = LTrim(Str(tot))
For i = 1 To Len(ss)
If Val(Mid(ss, i, 1)) > mxs Then mxs = Val(Mid(ss, i, 1))
Next
If mxs = mx Then
Text1.Text = Text1.Text & p & " " & ss & crlf
ct = ct + 1
If ct = 100 Then Exit Do
End If
End If
DoEvents
Loop
Text1.Text = Text1.Text & " done"
End Sub
Function prmdiv(num)
Dim n, dv, q
If num = 1 Then prmdiv = 1: Exit Function
n = Abs(num): If n > 0 Then limit = Sqr(n) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
dv = 2: GoSub DivideIt
dv = 3: GoSub DivideIt
dv = 5: GoSub DivideIt
dv = 7
Do Until dv > limit
GoSub DivideIt: dv = dv + 4 '11
GoSub DivideIt: dv = dv + 2 '13
GoSub DivideIt: dv = dv + 4 '17
GoSub DivideIt: dv = dv + 2 '19
GoSub DivideIt: dv = dv + 4 '23
GoSub DivideIt: dv = dv + 6 '29
GoSub DivideIt: dv = dv + 2 '31
GoSub DivideIt: dv = dv + 6 '37
Loop
If n > 1 Then prmdiv = n
Exit Function
DivideIt:
Do
q = Int(n / dv)
If q * dv = n And n > 0 Then
prmdiv = dv: Exit Function
Else
Exit Do
End If
Loop
Return
End Function
Function nxtprm(x)
Dim n
n = x + 1
While prmdiv(n) < n Or n < 2
n = n + 1
Wend
nxtprm = n
End Function
computer solution
