 All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars  perplexus dot info  Leaving the least (the most) (Posted on 2017-10-27) a. Erase 100 digits from the sequence:
in 1234567891011121314….585960
in a way, that the remaining digits, read as a continuous base-10 number,
produce a minimal result.

b. Same task, striving to get the largest number.

Do not change the digits' order, allow leading zeroes.

 No Solution Yet Submitted by Ady TZIDON No Rating Comments: ( Back to comment list | You must be logged in to post comments.) computer solutions Comment 2 of 2 | Part a:

If you require there be no leading zeros:

(the kept digits have a caret under them)

`123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960^         ^                   ^                   ^                   ^                   ^ ^ ^ ^ ^           ^10000012340`
`If leading zeros are allowed:123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960          ^                   ^                   ^                   ^                   ^ ^ ^ ^ ^^          ^00000123450`
`Part b:123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960        ^                   ^                   ^                   ^                   ^               ^ ^^^^^99999785960`

See the similar Leaving a Maximal Result pid=10939, for a discussion.

The biggest change was in assuring a non-zero first digit. Other than that it was just changing the direction of an inequality.

DefDbl A-Z
Dim crlf\$

Form1.Visible = True

Text1.Text = ""
crlf = Chr\$(13) + Chr\$(10)

Open "leaving the least-most.txt" For Output As #2

s\$ = ""
For i = 1 To 60
s = s + LTrim(Str(i))
Next

ReDim kept(11)
ptr = 1: need = 11: keep\$ = ""
Do
If Len(keep) = 0 Then
While Mid(s, ptr, 1) = "0"
ptr = ptr + 1
Wend
End If
cmp\$ = Mid(s, ptr, 1)
found = 0
For i = ptr + 1 To Len(s) + 1 - need
If Mid(s, i, 1) < cmp And (Mid(s, i, 1) > "0" Or keep > "") Then
ptr = i
found = 1
Exit For
End If
Next
If found = 0 Then
keep = keep + cmp\$
need = need - 1
kept(Len(keep)) = ptr
ptr = ptr + 1
End If
Loop Until need = 0

Text1.Text = Text1.Text & s & crlf
Print #2, s
prev = 0
For i = 1 To 11
Text1.Text = Text1.Text & Space(kept(i) - prev - 1) & "^"
Print #2, Space(kept(i) - prev - 1) + "^";
prev = kept(i)
Next
Text1.Text = Text1.Text & crlf & keep & crlf
Print #2,
Print #2, keep
Print #2,

s\$ = ""
For i = 1 To 60
s = s + LTrim(Str(i))
Next

ReDim kept(11)
ptr = 1: need = 11: keep\$ = ""
Do
cmp\$ = Mid(s, ptr, 1)
found = 0
For i = ptr + 1 To Len(s) + 1 - need
If Mid(s, i, 1) < cmp Then
ptr = i
found = 1
Exit For
End If
Next
If found = 0 Then
keep = keep + cmp\$
need = need - 1
kept(Len(keep)) = ptr
ptr = ptr + 1
End If
Loop Until need = 0

Text1.Text = Text1.Text & s & crlf
Print #2, s
prev = 0
For i = 1 To 11
Text1.Text = Text1.Text & Space(kept(i) - prev - 1) & "^"
Print #2, Space(kept(i) - prev - 1) + "^";
prev = kept(i)
Next
Text1.Text = Text1.Text & crlf & keep & crlf
Print #2,
Print #2, keep
Print #2,

s\$ = ""
For i = 1 To 60
s = s + LTrim(Str(i))
Next

ReDim kept(11)
ptr = 1: need = 11: keep\$ = ""
Do
cmp\$ = Mid(s, ptr, 1)
found = 0
For i = ptr + 1 To Len(s) + 1 - need
If Mid(s, i, 1) > cmp Then
ptr = i
found = 1
Exit For
End If
Next
If found = 0 Then
keep = keep + cmp\$
need = need - 1
kept(Len(keep)) = ptr
ptr = ptr + 1
End If
Loop Until need = 0

Text1.Text = Text1.Text & s & crlf
Print #2, s
prev = 0
For i = 1 To 11
Text1.Text = Text1.Text & Space(kept(i) - prev - 1) & "^"
Print #2, Space(kept(i) - prev - 1) + "^";
prev = kept(i)
Next
Text1.Text = Text1.Text & crlf & keep & crlf
Print #2,
Print #2, keep
Print #2,

Text1.Text = Text1.Text & crlf & " done"

Close 2

End Sub

 Posted by Charlie on 2017-10-27 10:40:23 Please log in:

 Search: Search body:
Forums (0)