Card shuffles: Difference between revisions
→{{header|zkl}}
(Added solution for C) |
|||
Line 1,938:
puts [overhand [list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52]]
</lang>
=={{header|Visual Basic .NET}}==
{{trans|C#}}
<lang vbnet>Imports System.Runtime.CompilerServices
Imports System.Text
Module Module1
<Extension()>
Function AsString(Of T)(c As ICollection(Of T)) As String
Dim sb = New StringBuilder("[")
sb.Append(String.Join(", ", c))
Return sb.Append("]").ToString()
End Function
Private rand As New Random()
Function RiffleShuffle(Of T)(list As ICollection(Of T), flips As Integer) As List(Of T)
Dim newList As New List(Of T)(list)
For n = 1 To flips
'cut the deck at the middle +/- 10%, remove the second line of the formula for perfect cutting
Dim cutPoint As Integer = newList.Count / 2 + If(rand.Next(0, 2) = 0, -1, 1) * rand.Next(newList.Count * 0.1)
'split the deck
Dim left As New List(Of T)(newList.Take(cutPoint))
Dim right As New List(Of T)(newList.Skip(cutPoint))
newList.Clear()
While left.Count > 0 AndAlso right.Count > 0
'allow for imperfect riffling so that more than one card can come form the same side in a row
'biased towards the side with more cards
'remove the if And else And brackets for perfect riffling
If rand.NextDouble() >= left.Count / right.Count / 2 Then
newList.Add(right.First())
right.RemoveAt(0)
Else
newList.Add(left.First())
left.RemoveAt(0)
End If
End While
'if either hand is out of cards then flip all of the other hand to the shuffled deck
If left.Count > 0 Then
newList.AddRange(left)
End If
If right.Count > 0 Then
newList.AddRange(right)
End If
Next
Return newList
End Function
Function OverhandShuffle(Of T)(list As ICollection(Of T), passes As Integer) As List(Of T)
Dim mainHand As New List(Of T)(list)
For n = 1 To passes
Dim otherhand = New List(Of T)
While mainHand.Count > 0
'cut at up to 20% of the way through the deck
Dim cutSize = rand.Next(list.Count * 0.2) + 1
Dim temp = New List(Of T)
'grab the next cut up to the end of the cards left in the main hand
Dim i = 0
While i < cutSize AndAlso mainHand.Count > 0
temp.Add(mainHand.First())
mainHand.RemoveAt(0)
i = i + 1
End While
'add them to the cards in the other hand, sometimes to the front sometimes to the back
If rand.NextDouble() >= 0.1 Then
'front most of the time
temp.AddRange(otherhand)
otherhand = temp
Else
'end sometimes
otherhand.AddRange(temp)
End If
End While
'move the cards back to the main hand
mainHand = otherhand
Next
Return mainHand
End Function
Sub Main()
Dim list = New List(Of Integer)(Enumerable.Range(1, 20))
Console.WriteLine(list.AsString())
list = RiffleShuffle(list, 10)
Console.WriteLine(list.AsString())
Console.WriteLine()
list = New List(Of Integer)(Enumerable.Range(1, 20))
Console.WriteLine(list.AsString())
list = RiffleShuffle(list, 1)
Console.WriteLine(list.AsString())
Console.WriteLine()
list = New List(Of Integer)(Enumerable.Range(1, 20))
Console.WriteLine(list.AsString())
list = OverhandShuffle(list, 10)
Console.WriteLine(list.AsString())
Console.WriteLine()
list = New List(Of Integer)(Enumerable.Range(1, 20))
Console.WriteLine(list.AsString())
list = OverhandShuffle(list, 1)
Console.WriteLine(list.AsString())
Console.WriteLine()
End Sub
End Module</lang>
{{out}}
<pre>[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
[1, 5, 15, 8, 3, 7, 17, 12, 14, 6, 19, 18, 13, 16, 2, 20, 11, 10, 4, 9]
[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
[1, 2, 12, 13, 14, 3, 15, 4, 5, 16, 17, 6, 7, 8, 9, 18, 10, 19, 20, 11]
[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
[15, 16, 20, 14, 17, 9, 10, 5, 6, 3, 12, 18, 11, 4, 1, 2, 8, 13, 19, 7]
[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
[19, 20, 15, 16, 17, 18, 13, 14, 10, 11, 12, 7, 8, 9, 4, 5, 6, 1, 2, 3]</pre>
=={{header|zkl}}==
| |||