Generate a rolling 'party shuffle' playlist with rating bias

Author: vect

For why this is Winamp Party Shuffle 3.2 see the Party Shuffle Changelog.

playlist_Party Shuffle.vbs:

' +--------------------------------+
' |    Winamp Party Shuffle 3.2    |
' +--------------------------------+
' Formerly "Biased Party Shuffle v1.1"
' vect 2008
 
' Automatically enqueues a new random song each time another is played.
' An ActiveWinamp script by vect, based on Winamp Party Shuffle 2.5 by osmosis,
' which is based on Party Shuffle by neFAST.
 
' There is bias - you can make certain tracks more likely to be played.
' Fully configurable below, defaults to 20 tracks with lower replay chance for lower rated tracks.
 
' What it does:
' - Keeps history of artists added to avoid repeat artists
' - Keeps history of tracks added to avoid repeat tracks
' - Infinite levels of bias (provided you code them)
 
' Script quits when playback is completely stopped.
' Do not run script again once already running (can cause Winamp memory usage to skyrocket).
 
' Known Issues: 1) Due to the way in which Nullsoft Tray Control 2.0 gets the currently playing
'                  track info, it is possible that Party Shuffle may cause the tooltip information
'                  to display incorrectly when in compact mode.
'               2) Editing a playlist entry or ID3 tag during a track change results in the edited
'                  track/entry replacing the one in the position it used to occupy.
 
' last modified: 13th May 2008 by osm
 
dim artistHistory(), songhistory(), artistsDict
 
' *** CONFIG START ***
 
' Standard media library query inclusive of all the tracks you want to hear
mainQuery = "type = 0"
 
artistHistorySize = 30 ' number of artists to play without repeat
songHistorySize = 150 ' number of songs to play without repeat
forecast = 14 ' number of songs to enqueue ahead of time, total=backlog+1+forecast
backlog = 5
 
clearPrev = false ' when the PL isn't cleared on startup, true removes tracks previous to current
 
bias = 1.0
' The greater the bias, the greater influence the track's rating has on its chance of playing.
' The value should be greater than zero, and can be fractional.
' A value of 0.0 gives each track the same chance of being enqueued, and a value of 10.0 will
' effectively make tracks with ratings of 1 not get enqueued.
' I would recommend trying bias = 1.0 - then if you think lower rated tracks should get more plays,
' decrease the bias, and vice versa.
 
' Technical: 1.0 bias makes the scale linear, > 1.0: polynomial, 0.0 < bias < 1.0: fractional power.
 
' Chances are you won't need to change these values
artistHistoryMaxPercent = 20
songHistoryMaxPercent = 30 ' max percent of the library
safetylimit = 100 ' to stop infinite loops
 
' For debugging
showWarnings = true
 
' Rate function at the end of the script is also configurable. See for instructions.
 
' *** CONFIG END ***
 
startup=msgbox("Start new Party Shuffle playlist?",_
        vbYesNoCancel+vbDefaultButton2+vbQuestion,_
        "Winamp Party Shuffle ("+CStr(backlog+1+forecast)+" track)")
 
clearPlaylist = false
if startup=2 then ' abort if requested
   quit
elseif startup=6 then ' clear PL if desired
   clearPlaylist = true
end if
 
' tracks start at index 1 ?
' The query and the artist dictionary take the bulk of the startup time
tracks = MediaLibrary.RunQueryArray(mainQuery)
 
if ubound(tracks) = 0 then
  msgbox("No tracks. Add tracks to the library and/or fix the query in the script.")
  quit
end if
 
' if all the tracks have zero rating, quit
allzero = true
for each track in tracks
  if rate(track) > 0.0 then
    allzero = false
    exit for
  end if
next
if allzero then
  msgbox("All the tracks have zero rating. Tracks need positive ratings to be played. "+_
         "Fix the conditions in the rate function.")
  quit
end if
 
' Count the number of artists in tracks by using an associative array (dictionary)
Set artistsDict = CreateObject("Scripting.dictionary")
artistsDict.CompareMode = BinaryCompare
for each track in tracks
  ' case insensitive
  artistsDict(lcase(track.artist)) = vbNullString
next
 
' Change song history size if there are not many songs
maxSongHistorySize = int((ubound(tracks)+1) * songHistoryMaxPercent/100)
if maxSongHistorySize < songHistorySize then
  songHistorySize = maxSongHistorySize
end if
 
' Change artist history size if there are not many artists
maxArtistHistorySize = int((artistsDict.count) * artistHistoryMaxPercent/100)
if maxArtistHistorySize < artistHistorySize then
  artistHistorySize = maxArtistHistorySize
end if
 
redim artistHistory(artistHistorySize-1)
redim songHistory(songHistorySize-1)
 
artistHistoryPos = 0
songHistoryPos = 0
 
Randomize
 
if clearPlaylist then
  playlist.clear
else
  if clearPrev then
    ' remove playlist items before current playing track
    for i = 0 to playlist.position-1-1
      playlist.deleteindex(1)
    next
  end if
  ' look at the current playlist - add songs to history
  for i = 1 to playlist.count
    addArtist(playlist.item(i).artist)
    addSong(playlist.item(i).DBindex)
  next
end if
 
' Now let's play (if it's not already playing)
shuffle = false
if playstate = 0 then ' stopped - going from stopped to play triggers changedTrack
  if playlist.count = 0 then
    Application_ChangedTrack
  end if
  play
elseif playstate = 3 then ' paused
  Application_ChangedTrack
  play
else 'playing
  ' to fill the playlist if needed
  Application_ChangedTrack
end if
if clearPlaylist then play
 
' This will remove past songs and fill up the playlist
sub Application_ChangedTrack
 
  if playlist.position > backlog+1 then
     ' We delete however many the PL position has changed by
      for p = 0 to playlist.position-backlog-1-1
        playlist.deleteindex(1)
      next
  end if
 
  ' Detect tracks that the user manually added to the playlist and adds them to the history
  ' so they don't get enqueued again for a while
  for i = playlist.position to playlist.count
    if not arraycontains(songHistory, playlist.item(i).DBindex) then
      addArtist(playlist.item(i).artist)
      addSong(playlist.item(i).DBindex)
    end if
  next
  
  ' Generate songs ahead of current one
  do while (playlist.count < (playlist.position + forecast))
    safety = 0 ' to stop infinite loops
    do
      safety = safety+1
      randsong = Int((ubound(tracks))*Rnd)+1 ' the indexes go from 1 to ubound, very weird
      
      keep = rnd < chancekeep(tracks(randsong)) ' for bias
      
    ' make sure the artist of new song and the actual song to be enqueued have not recently played
    loop until ((not arraycontains(artistHistory, lcase(tracks(randsong).artist)))_
                  and (not arraycontains(songHistory, tracks(randsong).DBindex)) and keep)_
                  or safety > safetylimit
    
    if showWarnings and safety > safetylimit then
      msgbox("Safe limit hit. If you're repeatedly getting this message, "+_
             "you're probably doing something wrong and will get bad results.")
    end if
    
    ' add the track
    tracks(randsong).enqueue
    
    addArtist(tracks(randsong).Artist)
    addSong(tracks(randsong).DBindex)
  loop
 
  ' The track history records the dbindex. Track dbindexes change when the library is updated.
  ' We need to detect this situation and update the cache with the correct dbindex values.
  ' The histories are still invalidated so behavior soon after this event may be unpredictable.
 
  ' This solution may not be the best. 
  ' All the tracks in the playlist after the current, should be in the history.
  ' Any inconsistencies signal that the winamp library has changed.
  librarychanged = false
  for i = playlist.position to playlist.count
    if not arraycontains(songHistory, playlist.item(i).DBindex) then
      if not librarychanged then
        if showWarnings then
          msgbox("Your library has changed. Automatically restarted shuffle with current playlist.")
        end if
 
        librarychanged = true
 
        ' redo the query
        tracks = MediaLibrary.RunQueryArray(mainQuery)
      end if
 
      if librarychanged then
        addArtist(playlist.item(i).artist)
        addSong(playlist.item(i).DBindex)
      end if
    end if
  next
 
end sub
 
' Quit the script if playback is stopped
sub Application_ChangedStatus
 
  if PlayState=0 then
     'exit if state has changed to stopped
     quit
  end if
 
end sub
 
' Add song to song history
sub addSong(songNumber)
  songHistory(songHistoryPos) = songNumber
  songHistoryPos = (songHistoryPos + 1) mod (ubound(songHistory)+1)
end sub
 
' Add artist to artist history
sub addArtist(artistName)
  artistHistory(artistHistoryPos) = lcase(artistName) ' lcase so can compare later case insensitive
  artistHistoryPos = (artistHistoryPos + 1) mod (ubound(artistHistory)+1)
end sub
 
function arraycontains(array, value)
  for each element in array
    if element = value then
      arraycontains = true
      exit function
    end if
  next
  arraycontains = false
end function
 
' returns the chance of keeping the track if selected
' lower chance for lower rating items
function chancekeep(item)
  rating = rate(item)
  if rating < 0.0 then rating = 0.0 ' no max() ?
  
  chancekeep = 1/(5^bias) * rating^bias ' includes (0,0) and (5,1)
end function
 
' *** RATE CONFIG CODE START ***
' Modify this function to change what the bias is based on
' Store a number between 0.0 and 5.0 inclusive in 'rate'.
' 0.0 means it is never played. 5.0 means it is always played
 
function rate(item)
  ' Use the rating in winamp
  if item.rating = 0 then
    rating = 3 'give unrated songs a rating of 3 or else they won't get played
  else
    rating = item.rating
  end if
 
  ' Example with lots of ratings: Plays newer songs more, but still takes ratings into account
  ' This one is quite subtle - A track from the 1980s with rating 5, gets an adjusted rating of 4.5
 
  'itemyearstring = item.ATFString("%year%")
  'if isNumeric(itemyearstring) then ' %year% might not be a number
  '  itemyear = cint(itemyearstring)
  'else
  '  itemyear = 0
  'end if
  'if itemyear > 2005 then
  '  rating = rating
  'elseif itemyear > 2000 then
  '  rating = rating * 0.975
  'elseif itemyear > 1990 then
  '  rating = rating * 0.95
  'elseif itemyear > 1980 then
  '  rating = rating * 0.90
  'else
  '  rating = rating * 0.85
  'end if
 
  rate = rating
end function
 
' *** RATE CONFIG CODE END ***