Как случайным образом изменить обои без дубликатов в серии

Question

У меня есть этот код в Visual Basic, который случайным образом меняет обои при первой загрузке дня:

Dim objRandom As New System.Random (CType (System.DateTime.Now.Ticks Mod System.Int32.MaxValue, Integer)) Sub Main () Dim WallpaperNumNew как целое число Dim WallpaperCurrent как целое число Dim WallpaperLastChgDate как дата Dim LoopNum как целое число при ошибке возобновить Далее ", если ни один из ключей не существует, игнорировать ошибку. Они будут созданы в конце программы.
        WallpaperLastChgDate = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\ Панель управления \ Рабочий стол", "WallpaperLastUpdate", ничего) "получить дату последнего изменения обоев WallpaperCurrent = My.Computer.Registry.GetValue (" HKEY_CURRENT \ Panel_CUR_ENT Desktop ", "WallpaperNumber", Nothing) 'получить текущий номер обоев при ошибке GoTo 0 Если WallpaperLastChgDate = Today (), то затем Exit Sub' предотвратить изменение обоев при каждой перезагрузке в течение дня. Do WallpaperNumNew = GetRandomNumber(1, 7) LoopNum = LoopNum + 1 Если LoopNum> 20, то Exit Do 'предотвратить цикл с бесконечным циклом, хотя WallpaperNumNew = WallpaperCurrent', если текущий и новый значения совпадают, цикл до тех пор, пока они не совпадают. Выберите Case WallpaperNumNew Case 1 My.Computer.FileSystem.CopyFile ("C: \ Windows \ Дело Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper1.jpg "," C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) 2 My.Computer.FileSystem.CopyFile ("C: \ Windows \" Дело Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper2.jpg "," C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) 3 My.Computer.FileSystem.CopyFile ("C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper3.jpg", "C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 4 My.Computer.FileSystem.CopyFile (" C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper4.jpg "," C: \ Users [имя пользователя ] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 5 My.Computer.FileSystem.CopyFile (" C: \ Windows \ Web \ WallPaper \ MyWallPaper " \ JPEGs \ Wallpaper5.jpg "," C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 6 My.Computer. FileSystem.CopyF ile ("C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper6.jpg", "C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 7 My.Computer.FileSystem.CopyFile ("C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper7.jpg", "C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft" \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Case Else Exit Sub 'do nothing End Выберите My.Computer.Registry.SetValue (" HKEY_CURRENT_USER \ Панель управления \ Рабочий стол ", "WallpaperNumber", WallpaperNumNew) 'записать новый номер обоев в реестр My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Today()) ' записать новую дату смены обоев в реестр. Конец Sub Открытая функция GetRandomNumber(Необязательный ByVal Low As Integer = 1, необязательный ByVal High As Integer = 100) As Integer
        'Возвращает случайное число между необязательным Low и High pa. rameters 'from: http://www.developerfusion.com/code/3940/random-numbers-that-work/ Возвращает objRandom.Next(Low, High + 1)
    End Function 

Программа настроена на запуск через диспетчер задач и отлично работает, но так как она случайная, я часто получаю одни и те же обои через два или три дня. Кто-нибудь может придумать способ случайного зацикливания на семи доступных обоях, чтобы в серии не было дубликатов?

Я не ищу реальный код, а просто каким-то образом отслеживаю, какие обои были выбраны ранее, а затем исключаю их из доступного пула, пока не будут выбраны все семь. (Да, последнее не будет случайным.)

Я написал другую программу, которая может выбирать конкретные обои в зависимости от дня недели, но тогда я получал бы одни и те же обои каждый день (т.е. каждый понедельник был бы одинаковыми обоями), что было бы скучно.

Любые идеи будут приветствоваться. Спасибо

Изменить: я думаю, что я мог подумать о решении. При первом запуске кода он генерирует список из семи случайных чисел со значениями 1–7, например, 4, 7, 3, 1, 5, 2, 6, и сохраняет их в параметре реестра как: 4731526. Затем каждый раз, когда Код запускается (один раз в день), он извлекает другое значение, хранящееся в реестре, которое указывает, на какой номер цикла он включен, использует этот номер позиции из случайной строки, а затем увеличивает номер цикла. Так что в моем примере выше, в первый день он использует обои 4, затем 7, затем 3 и т. Д. Когда он достигает 6 (7- ^е значение), он генерирует новый набор случайных чисел, сохраняет его в реестре и устанавливает номер цикла обратно в единицу, и цикл начинается заново с новой, другой случайной строкой.

Если это сработает, я выложу как ответ, так и код.

РЕДАКТИРОВАТЬ 2: Я считаю, что у меня есть код для достижения того, что я после. Я запустил его один раз, и он сгенерировал случайное число из семи цифр. Мне просто нужно подождать до восьмого дня, чтобы увидеть, генерирует ли код новый список случайно расположенных семи цифр.

Answer 1

Это должно работать для вас:

Sub Main()
    Dim WallpaperLastChgDate = Today()
    Dim WallpaperCurrent = -1
    On Error Resume Next 'if neither key exists, ignore error. They will get created at program end.
    WallpaperLastChgDate = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Nothing) 'get the date the wallpaper was last changed
    WallpaperCurrent = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperNumber", Nothing) 'get current wallpaper number
    On Error GoTo 0
    If WallpaperLastChgDate = Today() Then Exit Sub 'prevent changing wallpaper on every reboot during the day
    WallpaperCurrent += 1
    Dim objRandom As New System.Random(0)
    Dim Images = { "Wallpaper1.jpg", "Wallpaper2.jpg", "Wallpaper3.jpg", "Wallpaper4.jpg", "Wallpaper5.jpg", "Wallpaper6.jpg", "Wallpaper7.jpg" }
    Dim Shuffled = Enumerable.Range(0, 1000).SelectMany(Function (n) Images.OrderBy(Function (i) objRandom.NextDouble())).ToArray()
    My.Computer.FileSystem.CopyFile(Shuffled(WallpaperCurrent), "C:\Users[username]\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper.jpg", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperNumber", WallpaperCurrent) 'write new wallpaper number to registry
    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Today()) 'write new wallpaper change date to registry
End Sub

Ключ здесь состоит в том, чтобы избежать всего этого мусора об истинных случайных числах. То, что вам нужно, это хорошая случайность, но вполне предсказуемый поток чисел. Начиная с New System.Random(0) Вы гарантируете, что будете вычислять одни и те же числа каждый раз.

Итак, я просто вычислил массив из 1000 x 7 изображений с каждой серией из 7 перемешанных изображений. Затем я просто отслеживаю, по какому индексу вы находитесь каждый день, и увеличиваю, чтобы получить следующее изображение. Так что мой подход будет работать около 19,1 года.

По-прежнему существует проблема, заключающаяся в том, что последний образ серии семи может быть первым из следующего цикла. Это не будет трудно использовать .Zip оператор, чтобы удалить эти дубликаты.

Answer 2

Ваши требования доказуемо невозможны. Если у вас есть семь обоев, и вам требуется, чтобы в течение любых семи дней обои не появлялись более одного раза, то, очевидно, вы должны повторить ту же последовательность из семи обоев до бесконечности.

Доказательство. Через шесть дней единственные доступные обои - это обои, которые не появлялись в предыдущие шесть дней, то есть те, которые появились ровно семь дней назад.

Возможно, я неправильно понял ваши требования. Если так, пожалуйста, поправьте меня.

Answer 3

У меня есть свое решение, и я проверил его. Я создаю 7-значную случайную строку и сохраняю номер цикла в реестре (среди прочего). Когда моя программа запускается, она получает номер цикла и случайную строку из реестра, а затем использует функцию MID для получения соответствующего номера обоев, например, MID(String, CycleNumber, 1). Затем я использую стандартную инструкцию Select Case, чтобы скопировать нужный файл.jpg в файл TranscodedWallpaper для Window. Если бы я хотел избавиться от описательных имен файлов (например, Frontyard_Liquidamber.jpg) и изменить их все на Wallpaper1.jpg, Wallpaper2.jpg и т. Д., Я мог бы избавиться от оператора Select Case и использовать PathName & Wallpaper Number & ".jpg". Вот код:

Module Module1
        Sub Main()
        Dim WallpaperNumberNew As Integer
        Dim WallpaperNumberNewString As String
        Dim WallpaperLastChgDate As Date
        Dim WallpaperRandomList As String
        Dim WallpaperCycleNumber As Integer
        Dim CopyToLocation As String
        Dim NumberOfWallpapers As Integer
        Dim LoopNum As Integer
        NumberOfWallpapers = 8
        If My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", Nothing) Is Nothing Then
            WallpaperRandomList = GetRandomList(NumberOfWallpapers)
            My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", WallpaperRandomList)
            My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperCycleNumber", 1)
        End If
        WallpaperRandomList = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", Nothing)
        WallpaperCycleNumber = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperCycleNumber", Nothing)
        WallpaperLastChgDate = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Nothing)
        If WallpaperLastChgDate = Today() Then Exit Sub 'prevent changing wallpaper on every reboot during the day
        If WallpaperCycleNumber = NumberOfWallpapers + 1 Then
            WallpaperNumberNewString = Mid(WallpaperRandomList, WallpaperCycleNumber - 1, 1)
            WallpaperCycleNumber = 1
            Do
                WallpaperRandomList = GetRandomList(NumberOfWallpapers)
                LoopNum = LoopNum + 1
                If LoopNum > 20 Then Exit Do
            Loop While Left(WallpaperRandomList, 1) = WallpaperNumberNewString 'prevent first digit of new string from repeating last digit of old string
            My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", WallpaperRandomList)
        End If
        WallpaperNumberNewString = Mid(WallpaperRandomList, WallpaperCycleNumber, 1)
        WallpaperNumberNew = CInt(WallpaperNumberNewString)
        CopyToLocation = "C:\Users[username]\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper.jpg"
        Select Case WallpaperNumberNew
            Case 1
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper1.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case 2
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper2.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case 3
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper3.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case 4
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper4.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case 5
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper5.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case 6
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper6.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case 7
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper7.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case 8
                My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper8.jpg", CopyToLocation,
                FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
            Case Else
                Exit Sub 'do nothing
        End Select
        WallpaperCycleNumber = WallpaperCycleNumber + 1
        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperCycleNumber", WallpaperCycleNumber) 'write cycle number to registry
        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Today()) 'write new wallpaper change date to registry
        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperNumber", WallpaperNumberNew)
    End Sub
    Public Function GetRandomList(Optional ByVal High As Integer = 100) As String
        Dim StringDigit(High) As Integer
        Dim NewString As String
        Dim RndArray As Integer
        Dim temp As Integer
        For i = 1 To High
            StringDigit(i) = i
        Next i
        Randomize() 'intialize random number generator
        For i = 1 To High
            RndArray = Int((UBound(StringDigit) * Rnd() + 1)) 'generate random number and store as variable RndArray
            temp = StringDigit(i) 'temporarily store array element i to a variable called temp
            StringDigit(i) = StringDigit(RndArray) 'set array element i equal to random array element StringDigit
            StringDigit(RndArray) = temp 'set array element StringDigit to old value of array element i stored as temp
        Next i
        NewString = Nothing 'initialize variable NewString
        For i = 1 To High
            NewString = NewString & StringDigit(i) 'convert array into string NewString
        Next i
        Return NewString
    End Function
End Module

Одним приятным побочным эффектом является то, что он копирует ваш jpeg, предположительно с минимальным сжатием, непосредственно в файл TranscodedWallpaper.jpg Window, который обходит агрессивное сжатие, которое Windows применяет к вашему файлу BMP, когда он конвертирует его в выбранные вами обои. Исследуя возможные решения моей проблемы, я обнаружил, что это раздражает многих пользователей.