- It chooses higher rated songs more often than lower rated songs
- If you've listened to a song recently, it won't repeat for X number of days (defined in the script)
- It boosts the chances of a song being selected based on when it was last played (or added to the DB if it hasn't been played)
Also, I'm on MM3. The 'CASE WHEN' won't work in MM2, you'd have to make it an 'iif' statement. Of course, I'm not even sure if auto DJ was available in MM2.
Anyway, give it a try and let me know what you think.
Thanks,
Peter
Code: Select all
' An AutoDJ version of Radio Free Monkey
' by Peter Risser
' v1.0
' 2009-05-07
Option Explicit
'
' [AutoDJRadioFreeMonkey]
' FileName=autoDJ-RFM.vbs
' DisplayName=Radio Free Monkey
' Language=VBScript
' ScriptType=4
' %%% Add 1 to weighting for each X days since last played
Const DayFactor = 30
' %%% Anything rated this or below will not receive the 'date boost'
Const DateBoostCutoff = 1.5
' %%% The minimum number of days that must pass before a song is repeated. Zero means, go ahead
' and repeat it right away.
Const MinDaysRepeat = 4
Dim weightedRatingFormula, dateBoostFormula, ratingFormula, weightedPlayCountFormula
Dim daysSinceAdded : daysSinceAdded = "round((julianday('now') - julianday('1899-12-30') - Songs.DateAdded),0)"
Dim daysSincePlayed : daysSincePlayed = "round((julianday('now') - julianday('1899-12-30') - Songs.LastTimePlayed),0)"
Dim numberOfDays : numberOfDays = "CASE WHEN (lastTimePlayed > 0) THEN "&daysSincePlayed&" ELSE "&daysSinceAdded&" END"
dateBoostFormula = "Round((Songs.rating > "&(DateBoostCutoff*20)&") * "&numberOfDays &" / "&DayFactor&",3)"
ratingFormula = "((Songs.rating > 0) * Songs.rating / 10)"
weightedRatingFormula = ratingFormula & " + " & dateBoostFormula
Sub InitConfigSheet( Panel)
' TODO: Make the configurable items actual options in the dialog.
End Sub
' Panel = Panel where UI controls were previously placed by the script
' SaveConfig = Whether user pressed Ok and values in the dialog should be applied and saved (to registry, ini file, or so)
Sub CloseConfigSheet( Panel, SaveConfig)
' TODO: Save values to Registry, apply them to our internal variables.
End Sub
Function GenerateNewTrack
Dim SQLStatement, TotalsSQLStatement
Dim SELECT_Clause, SELECT_TOTALS_Clause, FROM_Clause, WHERE_Clause, ORDER_Clause
Dim Iter, res, total, max, min, delta, cutoff, ID
Randomize
SELECT_Clause = " SELECT Songs.Id, "&weightedRatingFormula&" as rate "
SELECT_TOTALS_Clause = " SELECT count(Songs.Id), max("&weightedRatingFormula&"), min("&weightedRatingFormula&") "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE " & daysSincePlayed & " > " & MinDaysRepeat
ORDER_Clause = " ORDER BY random(*)"
TotalsSQLStatement = SELECT_TOTALS_Clause & FROM_Clause & WHERE_Clause
'res = SDB.MessageBox(SQLStatement, mtError, Array(mbOk))
Set Iter = SDB.Database.OpenSQL(TotalsSQLStatement)
total = Iter.ValueByIndex(0)
max = Iter.ValueByIndex(1)
min = Iter.ValueByIndex(2)
delta = max - min
cutoff = rnd() * delta + min
SQLStatement = SELECT_Clause & FROM_Clause & WHERE_Clause & " and rate >= "&cutoff& ORDER_Clause
Set Iter = SDB.Database.OpenSQL(SQLStatement)
ID = Iter.ValueByIndex(0)
'res = SDB.MessageBox("max: "&max&"; cutoff:"&cutoff&"; result:"&Iter.ValueByIndex(1), mtError, Array(mbOk))
Set Iter = SDB.Database.QuerySongs( "ID=" & ID)
Set GenerateNewTrack = Iter.Item
End Function