by D!m » Sat Nov 24, 2007 6:21 am
I do some bug fix.
Mainly, the BoostNewSongs now work with unrated songs. Songs with a weight higher than 10 were never picked, theirs weight are now fixed to 10.
I fixed also the option to disable some genres.
Code: Select all
' RadioFreeMonkey
' Version 1.7.1
' A script to create a "radio station" for you based on your song ratings.
' #####################
' Version 1.2 by Risser
' This script creates a root node in the tree, beneath the library node, called "RadioFreeMonkey".
' Under this node, you have a Radio List node, a Done node and a Weightings node.
' - The Radio List node lists 20 songs, in random order. These are weighted, so songs
' with a higher weighting have a higher chance of getting selected.
' - If you have selected a sorting column, even though the songs are selected randomly, the
' radio list will be sorted based on that column. To return the list to "random" sorting, click
' on any playlist (Now Playing works nicely). When you visit the Radio List node, the songs will
' be unsorted, in true random order.
' - The Done list shows you which songs aren't going to be played. This includes songs that have
' passed their maximum playcount, or anything within MinDaysRepeat.
' - The Weighting node shows all tunes, sorted by their calculated weights. This can help you
' determine what the optimal weighting choices are for you. Plus, it's just nice to see what's
' more likely to be played.
' Songs are weighted as follows:
' Rating * 2 (5 stars = 10, 3.5 stars = 7, 0 stars = 0)
' - Number of Plays (if Reduce if Played is TRUE)
' + Days since added to library / DayFactor (always rounded down)
' However, the weighting can't be more than the original rating (* 2).
' TO DO: At some point, I'd like to make the main 'list' node a PlayList instead of a regular
' list of tracks, but I'm not sure how to do this.
'
' This script can be freely used and modified.
' This is an early release and there may be bugs. If it's causing you problems, simply delete
' it or move it out of the scripts\auto folder.
'
' The script does not modify the database, registry or INI file.
' #####################
' Version 1.5 by popper
' - added possibility to boost songs that have been added to the DB recently
' - added possibility to define the genres that should be played
' - redesign of the mechanism that selects the actual songs to be played (because I did not
' really understand what was going on in the existing algorithm ;-), with the goal of making
' it easier to influence what will be played (e.g. 30% of songs with a weighting of 8-10 and
' 70% with a weighting of 5-7))
' #####################
' Version 1.6 by ElGringo
' - Fixes to the algorithm
' - 1. There was always a song that had nothing to do in my playlists, investigated
' and saw the error in FillGoodLeaf
' - 2. There is an error in the calculation of the dateboost formula, the
' dateboostcutoff*20 should be dateboostcutoff*10. There were a couple of places wrong
' - 3. By adding, the BoostNewSongsModifier, the actual weight calculated, could go higher
' than 10, but the algorithm was never picking songs with a weight higher than 10. So,
' i fixed a couple of places in the script, so that calculated weight higher than 10,
' are now fixed at 10.
' - 4.There was a bug, when the BoostNewSongsModifier is set to 0... fixed it.
'
'
'
' #####################
' Version 1.6.1 by popper
' - In my opinion, the dateboostcutoff*20 (point 2. from ElGringo's list above) was correct
' ("Please correct me if I am wrong, but the ratings are stored in the database using
' numbers from 0 (or -1) to 100. So to calculate the number of stars from a rating in
' the database, you have to divide by 20, and not by ten.")
' So I changed it back in this release.
' No other modifications made. ElGringo was right in all other points ;-)
'
'
' #####################
' Version 1.7 by RedX
'
' - Improvements to the algorithm
' 1. I have replaced all looping with SQL access statements improving overall query time and
' and IMHO readabilty of the code
' 2. Added option to improve weights of songs with low played count especially one that have not yet
' been heard at all but are old in the db, old means longer then boostnewsongsdays
' 3. Added check for SetXPercentage and numberofsongs
' My modifications are restricted to FillGoodLeaf and adding a new Formula in the general section
'
'
' #####################
' Version 1.7.1 by D!m
'
' - Fix some bugs
' 1. BoostNewSongs now work with unrated songs.
' 2. Song with a weight higher than 10 are now fixed at 10.
' 3. Option genres that should not be played now work.
'
' Disclaimer:
' Use at your own risk. Back up your data before using.
' Changing some of the values might lead to endless loops that can only be solved by
' killing the MediaMonkey process, so take care when modifying anything!
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Global Variables and Declarations
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Option Explicit
' %%% The caption for the root node.
Const RootNodeCaption = "Radio FreeMonkey 1.7.1"
' %%% Add 1 to weighting for each X days since added to library
Const DayFactor = 20
' %%% 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 = 1
' %%% Reduce the weighting by the number of times played. This means, as songs are played more often,
' they are less likely to be played again
Const ReduceIfPlayed = True
' %%% Boost Songs that have been added during the last n days (MinDaysRepeat does still apply for these)
Const BoostNewSongsDays = 30
' %%% The boost modifier for new songs (Zero means, don't boost):
' Add x to the weighting of these songs
Const BoostNewSongsModifier = 3
' %%% Anything rated this or below will not receive the 'new song boost'
Const BoostNewSongsCutoff = 1.5
' %%% Tracks that have not been heard yet and have not been recently added receive this bonus (Dateadded > BoostNewSongsDays)
Const BoostNotPlayedModifier=5
' %%% Limit for the not heard Bonus, 0 means only songs u never played get the bonus
Const BoostNotPlayedCutoff=0
' %%% Boost not rated songs (problem is bomb = not rated = rating -1)
Const BoostNotPlayedNotRated=True
' %%% In case some of the non played songs have a rating do not pick songs with ratings below (0 to 10)
' %% 2 = 20=1 star 4=40=2 stars
Const BoostNotPlayedRatingCutoff=5
' %%% Genres that should not be played. Leave empty (Const NotPlayGenres = "") to ignore.
' "-1, 13, 17, 20, 24" means "empty genre field, Pop, Rock, Alternative, Soundtrack"
' Look up the other genre Ids in the database by using MS Access
Const NotPlayGenres = ""
' %%% Number of Songs in list
Const NumberOfSongs = 25
' %%% Influence which songs will be played. You have three sets that you can use
' Example:
' Const Set1Weight = 8.5 ' Basic weight for this set is 8.5
' Const Set1Boundary = 1.5 ' with a variation of 1.5, which means that songs between 7 and 10 will be chosen
' Const Set1Percentage = 60 ' this is how big the part of this set should be in the overall contents
Const Set1Weight = 7.0
Const Set1Boundary = 3
Const Set1Percentage = 90 ' make sure all 3 percentages sum up to 100!
Const Set2Weight = 2.0
Const Set2Boundary = 2
Const Set2Percentage = 10 ' make sure all 3 percentages sum up to 100!
Const Set3Weight = 1.0 ' Right now, it is not possible to choose songs with a weight < 1, so unfortunately you cannot add unrated songs
Const Set3Boundary = 1
'Const Set3Percentage = 20 ' This is not needed because it just takes what is missing to 100%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' The Meat. Don't change anything under here.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' the text of the formulas to be used throughout
Dim weightedRatingFormula, dateBoostFormula, ratingFormula, weightedPlayCountFormula, boostNewSongsFormula, boostNotPlayedFormula
If BoostNewSongsModifier <> 0 Then
dateBoostFormula = "IIF(Songs.rating <= " & (BoostNewSongsCutoff *10) & " OR FIX(DateDiff('d',Songs.DateAdded,Now) <= " & BoostNewSongsDays & "), 0, FIX(DateDiff('d',Songs.DateAdded,Now) / " & DayFactor & "))"
Else
dateBoostFormula = "IIF(Songs.rating <= " & (DateBoostCutoff*10) & ", 0, FIX(DateDiff('d',Songs.DateAdded,Now) / " & DayFactor & "))"
End If
'If the songs played MORE then x times OR Songs' shorter then X days in DB or rating below X then RETURN 0 ELSE is ok
If BoostNotPlayedModifier > 0 then
if boostnotplayednotrated=true then
boostNotPlayedFormula= " IIF((Songs.PlayCounter >" & BoostNotPlayedCutoff & " OR FIX(Datediff('d',Songs.DateAdded,Now))<" & BoostNewSongsDays & " OR (Songs.rating<"& boostnotplayedratingcutoff*10 & " AND songs.rating <> -1)),0,"& BoostNotPlayedModifier &") "
else
boostNotPlayedFormula= " IIF(Songs.PlayCounter >" & BoostNotPlayedCutoff & " OR FIX(Datediff('d',Songs.DateAdded,Now))<" & BoostNewSongsDays & " OR Songs.rating<"& boostnotplayedratingcutoff*10 & ",0,"& BoostNotPlayedModifier &") "
end if
end if
ratingFormula = "(IIF(Songs.rating < 0, 0, Songs.rating) / 10)"
If ReduceIfPlayed Then
weightedPlayCountFormula = "(Songs.PlayCounter - " & dateBoostFormula & ")"
Else
weightedPlayCountFormula = "0"
End If
If BoostNewSongsModifier <> 0 Then
boostNewSongsFormula = "IIF(Songs.rating <= " & (BoostNewSongsCutoff*10) & " AND songs.rating <> -1, 0, (IIF(FIX(DateDiff('d',Songs.DateAdded,Now) > " & BoostNewSongsDays & "), 0, " & BoostNewSongsModifier & ")))"
End If
weightedRatingFormula = ratingFormula & "-" & weightedPlayCountFormula
if boostNewSongsFormula <> "" then weightedRatingFormula = weightedRatingFormula & "+ " & boostNewSongsFormula
'msgbox boostnotplayedformula
if boostNotPlayedFormula <> "" then weightedRatingFormula = weightedRatingFormula & "+ " & boostNotPlayedFormula
weightedRatingFormula = " IIF( " & weightedRatingFormula & "> 10,10, " & weightedRatingFormula & ") "
Sub FillStandardProperties(parentNode, childNode)
With childNode
.CustomNodeId = parentNode.CustomNodeId
.CustomDataId = parentNode.CustomDataId + 1
.UseScript = Script.ScriptPath
End With
End Sub
'msgbox weightedRatingFormula & vbcrlf & vbcrlf & dateBoostFormula & vbcrlf & vbcrlf & ratingFormula & vbcrlf & vbcrlf & weightedPlayCountFormula & vbcrlf & vbcrlf & boostNewSongsFormula
Sub FillGoodLeaf(Node)
Randomize
'Before anything let's check the weights for correct input!
if numberofsongs<=0 then
msgbox "You don't want any songs? Please set value of NumberOfSongs > 0 !"
exit sub
end if
if (set1percentage+set2percentage)>100 or set1percentage>100 or set2percentage>100 then
msgbox "Your SetXPercentage settings are messed up! They add to over 100% !"
exit sub
end if
Dim Tracks
Dim SQLStatement,SQL
Dim SELECT_TOP_Clause, SELECT_Clause, FROM_Clause, WHERE_Clause, WHERE_WEIGHT_Clause, ORDER_Clause
Dim Iter, res, i, total, sum, index
Dim weight, minweight, maxweight
Dim hold, weights, average, start, baseweight, boundary,alreadyused
Dim R, max : max = NumberOfSongs
Dim inStr : inStr = ""
Set hold = CreateObject("Scripting.Dictionary") ' define an associative array or "hash array" to hold the songs
Set weights = CreateObject("Scripting.Dictionary") ' define an associative array or "hash array" to hold the weightings
Set alreadyused = CreateObject("Scripting.Dictionary") 'define an array with the list of already used tracks
SELECT_TOP_Clause = "SELECT TOP "
SELECT_Clause = " Songs.Id, IIF(" & weightedRatingFormula & ">10,10," & weightedRatingFormula & ") "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE " & weightedPlayCountFormula &" < " & ratingFormula & " AND DateDiff('d',Songs.LastTimePlayed, Now) > " & MinDaysRepeat
If NotPlayGenres <> "" then
WHERE_Clause = WHERE_Clause & " AND Songs.Genre NOT IN (" & NotPlayGenres & ")"
End If
ORDER_Clause = " ORDER BY Rnd((1000*Songs.ID)*Now())" ' This is important because otherwise they will all come as they are stored in the DB
'SQLStatement = SELECT_Clause & FROM_Clause & WHERE_Clause & ORDER_Clause
'Stricly debug
' msgbox "Attention hidden box from ie!"
' Dim objIE
' Set objIE = CreateObject("InternetExplorer.Application")
' objIE.Navigate("about:blank")
' objIE.document.parentwindow.clipboardData.SetData "text",SQLStatement
' objIE.Quit
' Set objIE=nothing
' msgbox "Copied!"
'End Debug
'From below here it's old code!
'Was nice but i'll try it with SQL only
'All 3 weighting statements!
Set Tracks = SDB.MainTracksWindow
For i=1 to 3
'each i correspons do one section of weights
if i=1 then
Select_top_clause = "SELECT TOP " & (max * Set1Percentage / 100)
Where_weight_clause= " AND (" & weightedratingformula & " between " & set1weight-set1boundary & " AND " & set1weight+set1boundary & ") "
elseif i=2 then
if set1percentage=100 then
exit for
end if
Select_top_clause = "SELECT TOP " & (max * Set2Percentage / 100)
Where_weight_clause= " AND (" & weightedratingformula & " between " & set2weight-set2boundary & " AND " & set2weight+set2boundary & ") "
elseif i=3 then
if set1percentage+set2percentage=100 then
exit for
end if
Select_top_clause = "SELECT TOP " & (max * (100-(Set1Percentage+Set2Percentage)) / 100)
Where_weight_clause= " AND (" & weightedratingformula & " between " & set3weight-set3boundary & " AND " & set3weight+set3boundary & ") "
end if
SQL =SELECT_TOP_Clause & SELECT_Clause & FROM_Clause & WHERE_Clause & WHERE_WEIGHT_Clause & ORDER_Clause
Set Iter = SDB.Database.OpenSQL(SQL)
'Stricly debug
'msgbox "Attention hidden box from ie!"
'Dim objIE
'Set objIE = CreateObject("InternetExplorer.Application")
'objIE.Navigate("about:blank")
'objIE.document.parentwindow.clipboardData.SetData "text",SQL
'objIE.Quit
'Set objIE=nothing
'msgbox "Copied!"
'End Debug
do while iter.eof =false
if instr ="" then
instr=iter.stringbyindex(0)
else
instr = instr & ", " & iter.StringByIndex(0)
end if
iter.next
loop
Next
'msgbox instr
If inStr <> "" then
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & inStr & ") ORDER BY Rnd((1000*Songs.ID)*Now())")
Tracks.FinishAdding
End If
Set iter=nothing
set tracks = nothing
End Sub
Sub FillWeightNode(Node)
Dim Tree, newNode
Dim SQLStatement ' SQL query to the database
Dim Iter ' SDBD Iterator obtained by running the SQL query to get the nodes
Set Tree = SDB.MainTree
Node.HasChildren = false ' To delete all old children
SQLStatement = "SELECT DISTINCT IIF(" & weightedRatingFormula & ">10,10," & weightedRatingFormula & ") from Songs "
'res = InputBox("SQL Statement Node: ", SQLStatement, SQLStatement) ' For debugging
Set Iter = SDB.Database.OpenSQL(SQLStatement)
While Not Iter.EOF
Set newNode = Tree.CreateNode
NewNode.Caption = Iter.StringByIndex(0)
NewNode.iconIndex = 32
newNode.CustomData = Iter.StringByIndex(0)
FillStandardProperties node,newNode
newNode.onFillTracksFunct = "FillWeightLeaf"
newNode.hasChildren = False
Tree.AddNode Node, NewNode, 3
Iter.Next
Wend
End Sub
Sub FillWeightLeaf(Node)
Dim Weight
Dim Tracks
Dim SELECT_Clause, FROM_Clause, WHERE_Clause
Weight = Node.CustomData
SELECT_Clause = " SELECT Songs.Id "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE IIF(" & weightedRatingFormula & ">10,10," & weightedRatingFormula & ") = " & Weight & " AND DateDiff('d',Songs.LastTimePlayed, Now) > " & MinDaysRepeat
If NotPlayGenres <> "" then
WHERE_Clause = WHERE_Clause & " AND Songs.Genre NOT IN (" & NotPlayGenres & ")"
End If
'res = InputBox("SQL Statement Leaf: ", "Debugging", SELECT_Clause & FROM_Clause & WHERE_Clause) ' For debugging
Set Tracks = SDB.MainTracksWindow
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")")
Tracks.FinishAdding
End Sub
Sub FillDoneLeaf(Node)
Dim Tracks
Dim SELECT_Clause, FROM_Clause, WHERE_Clause
SELECT_Clause = " SELECT Songs.Id "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE DateDiff('d',Songs.LastTimePlayed, Now) <= " & MinDaysRepeat
If NotPlayGenres <> "" then
WHERE_Clause = WHERE_Clause & " OR Songs.Genre IN (" & NotPlayGenres & ")"
End If
Set Tracks = SDB.MainTracksWindow
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")")
Tracks.FinishAdding
End Sub
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Startup Function
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Sub onStartUp
Dim Tree, RadioFreeMonkeyRoot
Dim RadioMonkeyGood, RadioMonkeyBad, RadioMonkeyWeight
Set Tree = Sdb.MainTree
Set RadioFreeMonkeyRoot = Tree.createNode
RadioFreeMonkeyRoot.Caption = RootNodeCaption
RadioFreeMonkeyRoot.IconIndex = 14
RadioFreeMonkeyRoot.UseScript = Script.ScriptPath
RadioFreeMonkeyRoot.hasChildren = True
Tree.AddNode Tree.Node_Library, RadioFreeMonkeyRoot, 1
SDB.Objects("RadioFreeMonkeyRoot") = RadioFreeMonkeyRoot
Set RadioMonkeyGood = Tree.createNode
RadioMonkeyGood.Caption = "Radio List"
RadioMonkeyGood.IconIndex = 14
RadioMonkeyGood.UseScript = Script.ScriptPath
RadioMonkeyGood.hasChildren = False
RadioMonkeyGood.onFillTracksFunct = "FillGoodLeaf"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyGood, 2
SDB.Objects("RadioMonkeyGood") = RadioMonkeyGood
Set RadioMonkeyWeight = Tree.createNode
RadioMonkeyWeight.Caption = "Weightings"
RadioMonkeyWeight.IconIndex = 32
RadioMonkeyWeight.UseScript = Script.ScriptPath
RadioMonkeyWeight.hasChildren = True
RadioMonkeyWeight.onFillTracksFunct = "FillWeightNode"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyWeight, 3
SDB.Objects("RadioMonkeyWeight") = RadioMonkeyWeight
Set RadioMonkeyBad = Tree.createNode
RadioMonkeyBad.Caption = "Done"
RadioMonkeyBad.IconIndex = 15
RadioMonkeyBad.UseScript = Script.ScriptPath
RadioMonkeyBad.hasChildren = False
RadioMonkeyBad.onFillTracksFunct = "FillDoneLeaf"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyBad, 3
SDB.Objects("RadioMonkeyBad") = RadioMonkeyBad
End Sub
I do some bug fix.
Mainly, the BoostNewSongs now work with unrated songs. Songs with a weight higher than 10 were never picked, theirs weight are now fixed to 10.
I fixed also the option to disable some genres.
[code]' RadioFreeMonkey
' Version 1.7.1
' A script to create a "radio station" for you based on your song ratings.
' #####################
' Version 1.2 by Risser
' This script creates a root node in the tree, beneath the library node, called "RadioFreeMonkey".
' Under this node, you have a Radio List node, a Done node and a Weightings node.
' - The Radio List node lists 20 songs, in random order. These are weighted, so songs
' with a higher weighting have a higher chance of getting selected.
' - If you have selected a sorting column, even though the songs are selected randomly, the
' radio list will be sorted based on that column. To return the list to "random" sorting, click
' on any playlist (Now Playing works nicely). When you visit the Radio List node, the songs will
' be unsorted, in true random order.
' - The Done list shows you which songs aren't going to be played. This includes songs that have
' passed their maximum playcount, or anything within MinDaysRepeat.
' - The Weighting node shows all tunes, sorted by their calculated weights. This can help you
' determine what the optimal weighting choices are for you. Plus, it's just nice to see what's
' more likely to be played.
' Songs are weighted as follows:
' Rating * 2 (5 stars = 10, 3.5 stars = 7, 0 stars = 0)
' - Number of Plays (if Reduce if Played is TRUE)
' + Days since added to library / DayFactor (always rounded down)
' However, the weighting can't be more than the original rating (* 2).
' TO DO: At some point, I'd like to make the main 'list' node a PlayList instead of a regular
' list of tracks, but I'm not sure how to do this.
'
' This script can be freely used and modified.
' This is an early release and there may be bugs. If it's causing you problems, simply delete
' it or move it out of the scripts\auto folder.
'
' The script does not modify the database, registry or INI file.
' #####################
' Version 1.5 by popper
' - added possibility to boost songs that have been added to the DB recently
' - added possibility to define the genres that should be played
' - redesign of the mechanism that selects the actual songs to be played (because I did not
' really understand what was going on in the existing algorithm ;-), with the goal of making
' it easier to influence what will be played (e.g. 30% of songs with a weighting of 8-10 and
' 70% with a weighting of 5-7))
' #####################
' Version 1.6 by ElGringo
' - Fixes to the algorithm
' - 1. There was always a song that had nothing to do in my playlists, investigated
' and saw the error in FillGoodLeaf
' - 2. There is an error in the calculation of the dateboost formula, the
' dateboostcutoff*20 should be dateboostcutoff*10. There were a couple of places wrong
' - 3. By adding, the BoostNewSongsModifier, the actual weight calculated, could go higher
' than 10, but the algorithm was never picking songs with a weight higher than 10. So,
' i fixed a couple of places in the script, so that calculated weight higher than 10,
' are now fixed at 10.
' - 4.There was a bug, when the BoostNewSongsModifier is set to 0... fixed it.
'
'
'
' #####################
' Version 1.6.1 by popper
' - In my opinion, the dateboostcutoff*20 (point 2. from ElGringo's list above) was correct
' ("Please correct me if I am wrong, but the ratings are stored in the database using
' numbers from 0 (or -1) to 100. So to calculate the number of stars from a rating in
' the database, you have to divide by 20, and not by ten.")
' So I changed it back in this release.
' No other modifications made. ElGringo was right in all other points ;-)
'
'
' #####################
' Version 1.7 by RedX
'
' - Improvements to the algorithm
' 1. I have replaced all looping with SQL access statements improving overall query time and
' and IMHO readabilty of the code
' 2. Added option to improve weights of songs with low played count especially one that have not yet
' been heard at all but are old in the db, old means longer then boostnewsongsdays
' 3. Added check for SetXPercentage and numberofsongs
' My modifications are restricted to FillGoodLeaf and adding a new Formula in the general section
'
'
' #####################
' Version 1.7.1 by D!m
'
' - Fix some bugs
' 1. BoostNewSongs now work with unrated songs.
' 2. Song with a weight higher than 10 are now fixed at 10.
' 3. Option genres that should not be played now work.
'
' Disclaimer:
' Use at your own risk. Back up your data before using.
' Changing some of the values might lead to endless loops that can only be solved by
' killing the MediaMonkey process, so take care when modifying anything!
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Global Variables and Declarations
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Option Explicit
' %%% The caption for the root node.
Const RootNodeCaption = "Radio FreeMonkey 1.7.1"
' %%% Add 1 to weighting for each X days since added to library
Const DayFactor = 20
' %%% 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 = 1
' %%% Reduce the weighting by the number of times played. This means, as songs are played more often,
' they are less likely to be played again
Const ReduceIfPlayed = True
' %%% Boost Songs that have been added during the last n days (MinDaysRepeat does still apply for these)
Const BoostNewSongsDays = 30
' %%% The boost modifier for new songs (Zero means, don't boost):
' Add x to the weighting of these songs
Const BoostNewSongsModifier = 3
' %%% Anything rated this or below will not receive the 'new song boost'
Const BoostNewSongsCutoff = 1.5
' %%% Tracks that have not been heard yet and have not been recently added receive this bonus (Dateadded > BoostNewSongsDays)
Const BoostNotPlayedModifier=5
' %%% Limit for the not heard Bonus, 0 means only songs u never played get the bonus
Const BoostNotPlayedCutoff=0
' %%% Boost not rated songs (problem is bomb = not rated = rating -1)
Const BoostNotPlayedNotRated=True
' %%% In case some of the non played songs have a rating do not pick songs with ratings below (0 to 10)
' %% 2 = 20=1 star 4=40=2 stars
Const BoostNotPlayedRatingCutoff=5
' %%% Genres that should not be played. Leave empty (Const NotPlayGenres = "") to ignore.
' "-1, 13, 17, 20, 24" means "empty genre field, Pop, Rock, Alternative, Soundtrack"
' Look up the other genre Ids in the database by using MS Access
Const NotPlayGenres = ""
' %%% Number of Songs in list
Const NumberOfSongs = 25
' %%% Influence which songs will be played. You have three sets that you can use
' Example:
' Const Set1Weight = 8.5 ' Basic weight for this set is 8.5
' Const Set1Boundary = 1.5 ' with a variation of 1.5, which means that songs between 7 and 10 will be chosen
' Const Set1Percentage = 60 ' this is how big the part of this set should be in the overall contents
Const Set1Weight = 7.0
Const Set1Boundary = 3
Const Set1Percentage = 90 ' make sure all 3 percentages sum up to 100!
Const Set2Weight = 2.0
Const Set2Boundary = 2
Const Set2Percentage = 10 ' make sure all 3 percentages sum up to 100!
Const Set3Weight = 1.0 ' Right now, it is not possible to choose songs with a weight < 1, so unfortunately you cannot add unrated songs
Const Set3Boundary = 1
'Const Set3Percentage = 20 ' This is not needed because it just takes what is missing to 100%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' The Meat. Don't change anything under here.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' the text of the formulas to be used throughout
Dim weightedRatingFormula, dateBoostFormula, ratingFormula, weightedPlayCountFormula, boostNewSongsFormula, boostNotPlayedFormula
If BoostNewSongsModifier <> 0 Then
dateBoostFormula = "IIF(Songs.rating <= " & (BoostNewSongsCutoff *10) & " OR FIX(DateDiff('d',Songs.DateAdded,Now) <= " & BoostNewSongsDays & "), 0, FIX(DateDiff('d',Songs.DateAdded,Now) / " & DayFactor & "))"
Else
dateBoostFormula = "IIF(Songs.rating <= " & (DateBoostCutoff*10) & ", 0, FIX(DateDiff('d',Songs.DateAdded,Now) / " & DayFactor & "))"
End If
'If the songs played MORE then x times OR Songs' shorter then X days in DB or rating below X then RETURN 0 ELSE is ok
If BoostNotPlayedModifier > 0 then
if boostnotplayednotrated=true then
boostNotPlayedFormula= " IIF((Songs.PlayCounter >" & BoostNotPlayedCutoff & " OR FIX(Datediff('d',Songs.DateAdded,Now))<" & BoostNewSongsDays & " OR (Songs.rating<"& boostnotplayedratingcutoff*10 & " AND songs.rating <> -1)),0,"& BoostNotPlayedModifier &") "
else
boostNotPlayedFormula= " IIF(Songs.PlayCounter >" & BoostNotPlayedCutoff & " OR FIX(Datediff('d',Songs.DateAdded,Now))<" & BoostNewSongsDays & " OR Songs.rating<"& boostnotplayedratingcutoff*10 & ",0,"& BoostNotPlayedModifier &") "
end if
end if
ratingFormula = "(IIF(Songs.rating < 0, 0, Songs.rating) / 10)"
If ReduceIfPlayed Then
weightedPlayCountFormula = "(Songs.PlayCounter - " & dateBoostFormula & ")"
Else
weightedPlayCountFormula = "0"
End If
If BoostNewSongsModifier <> 0 Then
boostNewSongsFormula = "IIF(Songs.rating <= " & (BoostNewSongsCutoff*10) & " AND songs.rating <> -1, 0, (IIF(FIX(DateDiff('d',Songs.DateAdded,Now) > " & BoostNewSongsDays & "), 0, " & BoostNewSongsModifier & ")))"
End If
weightedRatingFormula = ratingFormula & "-" & weightedPlayCountFormula
if boostNewSongsFormula <> "" then weightedRatingFormula = weightedRatingFormula & "+ " & boostNewSongsFormula
'msgbox boostnotplayedformula
if boostNotPlayedFormula <> "" then weightedRatingFormula = weightedRatingFormula & "+ " & boostNotPlayedFormula
weightedRatingFormula = " IIF( " & weightedRatingFormula & "> 10,10, " & weightedRatingFormula & ") "
Sub FillStandardProperties(parentNode, childNode)
With childNode
.CustomNodeId = parentNode.CustomNodeId
.CustomDataId = parentNode.CustomDataId + 1
.UseScript = Script.ScriptPath
End With
End Sub
'msgbox weightedRatingFormula & vbcrlf & vbcrlf & dateBoostFormula & vbcrlf & vbcrlf & ratingFormula & vbcrlf & vbcrlf & weightedPlayCountFormula & vbcrlf & vbcrlf & boostNewSongsFormula
Sub FillGoodLeaf(Node)
Randomize
'Before anything let's check the weights for correct input!
if numberofsongs<=0 then
msgbox "You don't want any songs? Please set value of NumberOfSongs > 0 !"
exit sub
end if
if (set1percentage+set2percentage)>100 or set1percentage>100 or set2percentage>100 then
msgbox "Your SetXPercentage settings are messed up! They add to over 100% !"
exit sub
end if
Dim Tracks
Dim SQLStatement,SQL
Dim SELECT_TOP_Clause, SELECT_Clause, FROM_Clause, WHERE_Clause, WHERE_WEIGHT_Clause, ORDER_Clause
Dim Iter, res, i, total, sum, index
Dim weight, minweight, maxweight
Dim hold, weights, average, start, baseweight, boundary,alreadyused
Dim R, max : max = NumberOfSongs
Dim inStr : inStr = ""
Set hold = CreateObject("Scripting.Dictionary") ' define an associative array or "hash array" to hold the songs
Set weights = CreateObject("Scripting.Dictionary") ' define an associative array or "hash array" to hold the weightings
Set alreadyused = CreateObject("Scripting.Dictionary") 'define an array with the list of already used tracks
SELECT_TOP_Clause = "SELECT TOP "
SELECT_Clause = " Songs.Id, IIF(" & weightedRatingFormula & ">10,10," & weightedRatingFormula & ") "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE " & weightedPlayCountFormula &" < " & ratingFormula & " AND DateDiff('d',Songs.LastTimePlayed, Now) > " & MinDaysRepeat
If NotPlayGenres <> "" then
WHERE_Clause = WHERE_Clause & " AND Songs.Genre NOT IN (" & NotPlayGenres & ")"
End If
ORDER_Clause = " ORDER BY Rnd((1000*Songs.ID)*Now())" ' This is important because otherwise they will all come as they are stored in the DB
'SQLStatement = SELECT_Clause & FROM_Clause & WHERE_Clause & ORDER_Clause
'Stricly debug
' msgbox "Attention hidden box from ie!"
' Dim objIE
' Set objIE = CreateObject("InternetExplorer.Application")
' objIE.Navigate("about:blank")
' objIE.document.parentwindow.clipboardData.SetData "text",SQLStatement
' objIE.Quit
' Set objIE=nothing
' msgbox "Copied!"
'End Debug
'From below here it's old code!
'Was nice but i'll try it with SQL only
'All 3 weighting statements!
Set Tracks = SDB.MainTracksWindow
For i=1 to 3
'each i correspons do one section of weights
if i=1 then
Select_top_clause = "SELECT TOP " & (max * Set1Percentage / 100)
Where_weight_clause= " AND (" & weightedratingformula & " between " & set1weight-set1boundary & " AND " & set1weight+set1boundary & ") "
elseif i=2 then
if set1percentage=100 then
exit for
end if
Select_top_clause = "SELECT TOP " & (max * Set2Percentage / 100)
Where_weight_clause= " AND (" & weightedratingformula & " between " & set2weight-set2boundary & " AND " & set2weight+set2boundary & ") "
elseif i=3 then
if set1percentage+set2percentage=100 then
exit for
end if
Select_top_clause = "SELECT TOP " & (max * (100-(Set1Percentage+Set2Percentage)) / 100)
Where_weight_clause= " AND (" & weightedratingformula & " between " & set3weight-set3boundary & " AND " & set3weight+set3boundary & ") "
end if
SQL =SELECT_TOP_Clause & SELECT_Clause & FROM_Clause & WHERE_Clause & WHERE_WEIGHT_Clause & ORDER_Clause
Set Iter = SDB.Database.OpenSQL(SQL)
'Stricly debug
'msgbox "Attention hidden box from ie!"
'Dim objIE
'Set objIE = CreateObject("InternetExplorer.Application")
'objIE.Navigate("about:blank")
'objIE.document.parentwindow.clipboardData.SetData "text",SQL
'objIE.Quit
'Set objIE=nothing
'msgbox "Copied!"
'End Debug
do while iter.eof =false
if instr ="" then
instr=iter.stringbyindex(0)
else
instr = instr & ", " & iter.StringByIndex(0)
end if
iter.next
loop
Next
'msgbox instr
If inStr <> "" then
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & inStr & ") ORDER BY Rnd((1000*Songs.ID)*Now())")
Tracks.FinishAdding
End If
Set iter=nothing
set tracks = nothing
End Sub
Sub FillWeightNode(Node)
Dim Tree, newNode
Dim SQLStatement ' SQL query to the database
Dim Iter ' SDBD Iterator obtained by running the SQL query to get the nodes
Set Tree = SDB.MainTree
Node.HasChildren = false ' To delete all old children
SQLStatement = "SELECT DISTINCT IIF(" & weightedRatingFormula & ">10,10," & weightedRatingFormula & ") from Songs "
'res = InputBox("SQL Statement Node: ", SQLStatement, SQLStatement) ' For debugging
Set Iter = SDB.Database.OpenSQL(SQLStatement)
While Not Iter.EOF
Set newNode = Tree.CreateNode
NewNode.Caption = Iter.StringByIndex(0)
NewNode.iconIndex = 32
newNode.CustomData = Iter.StringByIndex(0)
FillStandardProperties node,newNode
newNode.onFillTracksFunct = "FillWeightLeaf"
newNode.hasChildren = False
Tree.AddNode Node, NewNode, 3
Iter.Next
Wend
End Sub
Sub FillWeightLeaf(Node)
Dim Weight
Dim Tracks
Dim SELECT_Clause, FROM_Clause, WHERE_Clause
Weight = Node.CustomData
SELECT_Clause = " SELECT Songs.Id "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE IIF(" & weightedRatingFormula & ">10,10," & weightedRatingFormula & ") = " & Weight & " AND DateDiff('d',Songs.LastTimePlayed, Now) > " & MinDaysRepeat
If NotPlayGenres <> "" then
WHERE_Clause = WHERE_Clause & " AND Songs.Genre NOT IN (" & NotPlayGenres & ")"
End If
'res = InputBox("SQL Statement Leaf: ", "Debugging", SELECT_Clause & FROM_Clause & WHERE_Clause) ' For debugging
Set Tracks = SDB.MainTracksWindow
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")")
Tracks.FinishAdding
End Sub
Sub FillDoneLeaf(Node)
Dim Tracks
Dim SELECT_Clause, FROM_Clause, WHERE_Clause
SELECT_Clause = " SELECT Songs.Id "
FROM_Clause = " FROM Songs "
WHERE_Clause = " WHERE DateDiff('d',Songs.LastTimePlayed, Now) <= " & MinDaysRepeat
If NotPlayGenres <> "" then
WHERE_Clause = WHERE_Clause & " OR Songs.Genre IN (" & NotPlayGenres & ")"
End If
Set Tracks = SDB.MainTracksWindow
Tracks.AddTracksFromQuery("AND Songs.ID IN (" & SELECT_Clause & FROM_Clause & WHERE_Clause & ")")
Tracks.FinishAdding
End Sub
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' Startup Function
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Sub onStartUp
Dim Tree, RadioFreeMonkeyRoot
Dim RadioMonkeyGood, RadioMonkeyBad, RadioMonkeyWeight
Set Tree = Sdb.MainTree
Set RadioFreeMonkeyRoot = Tree.createNode
RadioFreeMonkeyRoot.Caption = RootNodeCaption
RadioFreeMonkeyRoot.IconIndex = 14
RadioFreeMonkeyRoot.UseScript = Script.ScriptPath
RadioFreeMonkeyRoot.hasChildren = True
Tree.AddNode Tree.Node_Library, RadioFreeMonkeyRoot, 1
SDB.Objects("RadioFreeMonkeyRoot") = RadioFreeMonkeyRoot
Set RadioMonkeyGood = Tree.createNode
RadioMonkeyGood.Caption = "Radio List"
RadioMonkeyGood.IconIndex = 14
RadioMonkeyGood.UseScript = Script.ScriptPath
RadioMonkeyGood.hasChildren = False
RadioMonkeyGood.onFillTracksFunct = "FillGoodLeaf"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyGood, 2
SDB.Objects("RadioMonkeyGood") = RadioMonkeyGood
Set RadioMonkeyWeight = Tree.createNode
RadioMonkeyWeight.Caption = "Weightings"
RadioMonkeyWeight.IconIndex = 32
RadioMonkeyWeight.UseScript = Script.ScriptPath
RadioMonkeyWeight.hasChildren = True
RadioMonkeyWeight.onFillTracksFunct = "FillWeightNode"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyWeight, 3
SDB.Objects("RadioMonkeyWeight") = RadioMonkeyWeight
Set RadioMonkeyBad = Tree.createNode
RadioMonkeyBad.Caption = "Done"
RadioMonkeyBad.IconIndex = 15
RadioMonkeyBad.UseScript = Script.ScriptPath
RadioMonkeyBad.hasChildren = False
RadioMonkeyBad.onFillTracksFunct = "FillDoneLeaf"
Tree.AddNode RadioFreeMonkeyRoot, RadioMonkeyBad, 3
SDB.Objects("RadioMonkeyBad") = RadioMonkeyBad
End Sub[/code]