Auto Rating Catch-Up Playlist Generator
Auto Rating Catch-Up script, uses two dimensions to classify songs based on your MediaMonkey play history.
The first dimension is Appeal, which is set in the script, but you can choose grade of the other dimension, being Classical values.
With appeal I mean Love at First Listen sort of value, and the other Classical dimension is the longevity of the song.
Here is a screen shot of the form you get by hitting the yellow Star button on the Standard toolbar after installing it.
Nothing is done to your songs ratings, all this script does is to calculate your use of your songs and create playlists for you, so you can review the results and rate as you feel is right. You can easely select all songs in a group and give them ratings that way.
This is meant as a companion script to AutoRateSongs that keep your songs up-to-date with ratings. Songs rated lower than 1.5 Star are not included in this Auto Rating Catch-Up script, due to they are most likely not worthy of coming into the accepted group of 2.5 Stars or more.
Unrated are included though
More info about AutoRateSongs can be found here.
[Link to script]
To Do
Maybe also do None and Very Low in the Classical Value section
Note: I've tested this script on a playhistory of 10.000 and 25.000, and the speed seems to be around 1 second per 2.500 plays. Results may vary, so please post your findings here.
Installation
Save the below to MediaMonkey\Scripts\Auto\AutoRatingCatchUp.vbs
After a restart of MM, you'll see a yellow star in the Standard toobar.
Code: Select all
'MediaMonkey\Scripts\Auto\AutoRatingCatchUp.vbs
'
'You'll find a yellow Star in the Standard Tool-Bar after startup.
'
'AutoRating Catch-Up script
'By DiddeLeeDoo
'2nd version, 19 May 2006
'
'----------------------------------------------------------------
Sub OnStartup
Set UI = SDB.UI
SDB.UI.AddMenuItemSep SDB.UI.Menu_TbStandard, 0, 0
Set Mnu = SDB.UI.AddMenuItem(SDB.UI.Menu_TbStandard, 0, 0)
Mnu.Caption = "Auto Rating Catch-Up"
Mnu.UseScript = Script.ScriptPath
Mnu.OnClickFunc = "ShowForm"
Mnu.IconIndex = 64
End Sub
'----------------------------------------------------------------
Dim RatingTable(5,1)
RatingTable(0,0) = 5
RatingTable(0,1) = "2.5 Stars"
RatingTable(1,0) = 10
RatingTable(1,1) = "3.0 Stars"
RatingTable(2,0) = 15
RatingTable(2,1) = "3.5 Stars"
RatingTable(3,0) = 20
RatingTable(3,1) = "4.0 Stars"
RatingTable(4,0) = 30
RatingTable(4,1) = "4.5 Stars"
RatingTable(5,0) = 50
RatingTable(5,1) = "5.0 Stars"
Set ni=SDB.IniFile
Set oShExpl= SDB.Objects("BrowserWindow")
Set oForm = SDB.Objects("arForm")
Set SongsID=CreateObject("Scripting.Dictionary")
Set SongsRL=CreateObject("Scripting.Dictionary")
n=0
'----------------------------------------------------------------
Sub ShowForm(x)
Set oForm=SDB.UI.NewForm
oForm.Common.SetRect 0, 0, 640, 480
oForm.Common.MaxHeight = 360
oForm.Common.MinHeight = 360
oForm.Common.MaxWidth = 640
oForm.Common.MinWidth = 640
oForm.FormPosition = 4
oForm.SavePositionName = "AutoRateCatchUpForm"
oForm.Caption = "Auto Rating Catch-Up"
oForm.StayOnTop = True
Set Edt = SDB.UI.NewLabel(oForm)
Edt.Common.SetRect 5, 10, 150, 25
Edt.Caption = "Auto Rating Catch-Up"
Set Edt = SDB.UI.NewLabel(oForm)
Edt.Common.SetRect 5, 30, 150, 25
Edt.Caption = "By DiddeLeeDoo May 2005"
FromTop=160
FromLeft=15
ctrWidth=40
ctrHeight=20
If ni.BoolValue("arCUScript","Exist") Then
RatingTable(0,0)=ni.IntValue("arCUScript","Star050")
RatingTable(1,0)=ni.IntValue("arCUScript","Star060")
RatingTable(2,0)=ni.IntValue("arCUScript","Star070")
RatingTable(3,0)=ni.IntValue("arCUScript","Star080")
RatingTable(4,0)=ni.IntValue("arCUScript","Star090")
RatingTable(5,0)=ni.IntValue("arCUScript","Star100")
End If
For i = 5 to 10
If i = 10 Then Rc = "R" Else Rc = "R0"
j = i-5
Set SE = SDB.UI.NewSpinEdit(oForm)
SE.Common.SetRect FromLeft, FromTop, ctrWidth, ctrHeight
SE.Value = RatingTable(j,0)
SE.Common.ControlName = Rc & i
Set Lbl = SDB.UI.NewLabel(oForm)
Lbl.Common.SetRect 58, FromTop+3, 120, ctrHeight
Lbl.Caption = "points and up for " & RatingTable(j,1)
FromTop=FromTop-21
Next
Set Lbl=SDB.UI.NewLabel(oForm)
Lbl.Common.SetRect 15, 195, 150, 25
Lbl.Caption = "Select Classic Value Priority"
Lbl.Autosize = True
Lbl.Alignment = 0
Set DD=SDB.UI.NewDropDown(oForm)
DD.Common.SetRect 15, 210, 150, 25
DD.Common.ControlName = "Clas"
DD.Style = 2 ' List
DD.AddItem "Low"
DD.AddItem "Medium"
DD.AddItem "High"
If ni.IntValue("arCUScript","Classic")=0 Then
DD.ItemIndex=0
Else
DD.ItemIndex=ni.IntValue("arCUScript","Classic")
End If
Set Btn=SDB.UI.NewButton(oForm)
Btn.Caption = "Display Results"
Btn.Common.SetRect 15, 245, 150, 30
Btn.UseScript = Script.ScriptPath
Btn.OnClickFunc = "DoStuff"
Set Btn=SDB.UI.NewButton(oForm)
Btn.Caption = "Generate Playlists"
Btn.Common.SetRect 15, 285, 150, 28
Btn.Common.ControlName = "BtnDoMore"
Btn.Common.Enabled = False
Btn.UseScript = Script.ScriptPath
Btn.OnClickFunc = "DoMoreStuff"
Set Nfo=SDB.UI.NewPanel(oForm)
Nfo.Common.SetRect 195, 10, 430, 315
Set Lbl=SDB.UI.NewLabel(Nfo)
Lbl.Common.SetRect 10, 235, 400, 20
Lbl.Caption = "Do fine calibration by starting at the top, with 5.0 Stars first, then go one down."
Lbl.Autosize = True
Lbl.Alignment = 0
Set Lbl=SDB.UI.NewLabel(Nfo)
Lbl.Common.SetRect 10, 250, 400, 25
Lbl.Caption = "Use another Classic Value setting if you find you do not reach the desired results"
Lbl.Autosize = True
Lbl.Alignment = 0
Set Lbl=SDB.UI.NewLabel(Nfo)
Lbl.Common.SetRect 10, 275, 400, 20
Lbl.Caption = "When you feel happy with the Graph above, Generate Playlist will close this form and"
Lbl.Autosize = True
Lbl.Alignment = 0
Set Lbl=SDB.UI.NewLabel(Nfo)
Lbl.Common.SetRect 10, 290, 400, 20
Lbl.Caption = "start generating 'Auto Rating Catch-Up' Playlists based on the calibration"
Lbl.Autosize = True
Lbl.Alignment = 0
SDB.Objects("arForm") = oForm
Set oShExpl=SDB.UI.NewActiveX(oForm, "Shell.Explorer")
oShExpl.Common.SetRect 200, 15, 420, 213
oShExpl.Common.ControlName = "oShExpl"
SDB.Objects("BrowserWindow")=oShExpl.Interf
Script.RegisterEvent oForm, "OnClose", "CloseSave"
oForm.Common.Visible = True
End Sub
'----------------------------------------------------------------
Sub DoStuff(x)
'HourGlass Cursor On
CreateObject("SongsDB.SDBApplication").CursorType=-11
Set fc=SDB.Objects("arForm").Common
cClassic = fc.ChildControl("Clas").ItemIndex
Select Case cClassic
Case 0
ymww="'m'"
Case 1
ymww="'ww'"
Case 2
ymww="'y'"
End Select
sSQL="SELECT Int(Avg(Score)) AS TotTolR "_
+"FROM (SELECT TOP 5 CD*CX AS Score "_
+"FROM (SELECT IDG, Count(IDG) AS CD, "_
+"Max(IDCount) AS CX "_
+"FROM (SELECT IdSong AS IDG, "_
+"Count(IdSong) AS IDCount "_
+"FROM Played GROUP BY IdSong, "_
+"Format(DatePart("&ymww&",PlayDate),'000')) "_
+"GROUP BY IDG) "_
+"ORDER BY CD*CX DESC)"
Select Case cClassic
Case 0
If ni.IntValue("arCUScript","TopL")=0 Then
UsrTpAvg=SDB.Database.OpenSQL(sSQL).ValueByIndex(0)
ni.IntValue("arCUScript","TopL")=UsrTpAvg
Else
UsrTpAvg=ni.IntValue("arCUScript","TopL")
End If
Case 1
If ni.IntValue("arCUScript","TopM")=0 Then
UsrTpAvg=SDB.Database.OpenSQL(sSQL).ValueByIndex(0)
ni.IntValue("arCUScript","TopM")=UsrTpAvg
Else
UsrTpAvg=ni.IntValue("arCUScript","TopM")
End If
Case 2
If ni.IntValue("arCUScript","TopH")=0 Then
UsrTpAvg=SDB.Database.OpenSQL(sSQL).ValueByIndex(0)
ni.IntValue("arCUScript","TopH")=UsrTpAvg
Else
UsrTpAvg=ni.IntValue("arCUScript","TopH")
End If
End Select
m=0
Dim Dnr(5)
For i = 0 to 5
Select Case i
Case 0
cTo=1000
cFrom=fc.ChildControl("R10").value
Case 1
cTo = fc.ChildControl("R10").value
cFrom = fc.ChildControl("R09").value
Case 2
cTo = fc.ChildControl("R09").value
cFrom = fc.ChildControl("R08").value
Case 3
cTo=fc.ChildControl("R08").value
cFrom=fc.ChildControl("R07").value
Case 4
cTo = fc.ChildControl("R07").Value
cFrom = fc.ChildControl("R06").Value
Case 5
cTo = fc.ChildControl("R06").value
cFrom = fc.ChildControl("R05").value
End Select
sSQL="SELECT SubSQL00.IDG, Int(((CD*CX)/"&UsrTpAvg&")*100) AS Score, "_
+"Artists.Artist, Songs.SongTitle, Songs.Rating "_
+"FROM (SELECT IDG, Count(IDG) AS CD, Max(IDCount) AS CX "_
+"FROM (SELECT IdSong AS IDG, Count(IdSong) AS IDCount "_
+"FROM Played GROUP BY IdSong, Format(DatePart("&ymww&", PlayDate),'000')) "_
+"GROUP BY IDG) AS SubSQL00 INNER JOIN (Artists INNER JOIN Songs ON "_
+"Artists.ID = Songs.IDArtist) ON SubSQL00.IDG = Songs.ID "_
+"WHERE (((Songs.Rating) Not Between 0 And 30) AND "_
+"((Int(((CD*CX)/"&UsrTpAvg&")*100))>="&cFrom&" And "_
+"(Int(((CD*CX)/"&UsrTpAvg&")*100))<"&cTo&")) "_
+"ORDER BY SubSQL00.IDG"
Set dbT = SDB.Database.OpenSQL(sSQL)
While Not dbT.EOF
SongsID.Item(n)=dbT.ValueByIndex(0)
SongsRL.Item(n)=i
n=n+1
dbT.Next
Wend
Dnr(i)=n-m
m=n
Next
sDoc="<html><body topmargin=3 leftmargin=10 bgcolor=#FFFBF0>"
sDoc=sDoc&"<TABLE cellSpacing=0 cellPadding=0 border= 0 width=360>"_
+"<TR><TD colspan=4><font face=Arial size=2><b>Auto Rating Catch"_
+"-Up Results</b></font></TD></TR><TR><TD><p align=center>"_
+"<font face=Arial size=2><b>*</b></font></TD><TD align="_
+"right><font face=Arial size=1><b>Songs</b></font></TD>"_
+"<TD> </TD><TD> </TD></TR><TR><TD height=21>"_
+"<b><font face=Arial size=2>5.0</font></b></TD><TD align"_
+"=right><font face=Arial size=2>"&Dnr(0)&"</font></TD><TD "_
+"width=9> </TD><TD><TABLE bgColor=blue height=10 width"_
+"="&Dnr(0)&" cellSpacing=0 cellPadding=0 border= 0><TR><TD>"_
+"</TD></TR></TABLE></TD></TR><TR><TD height=21><b><font face"_
+"=Arial size=2>4.5</font></b></TD><TD align=right><font face"_
+"=Arial size=2>"&Dnr(1)&"</font></TD><TD width=9> </TD>"_
+"<TD><TABLE bgColor=blue height=10 width="&Dnr(1)&" cellSpacing"_
+"=0 cellPadding=0 border= 0><TR><TD></TD></TR></TABLE></TD>"_
+"</TR><TR><TD height=21><b><font face=Arial size=2>4.0</font>"_
+"</b></TD><TD align=right><font face=Arial size=2>"&Dnr(2)&"</font>"_
+"</TD><TD width=9> </TD><TD><TABLE bgColor=blue height=10 "_
+"width="&Dnr(2)&"cellSpacing=0 cellPadding=0 border= 0><TR><TD>"_
+"</TD></TR></TABLE></TD></TR><TR><TD height=21><b><font face="_
+"Arial size=2>3.5</font></b></TD><TD align=right><font face="_
+"Arial size=2>"&Dnr(3)&"</font></TD><TD width=9> </TD>"_
+"<TD><TABLE bgColor=blue height=10 width="&Dnr(3)&" cellSpacing"_
+"=0 cellPadding=0 border= 0><TR><TD></TD></TR></TABLE></TD></TR>"_
+"<TR><TD height=21><b><font face=Arial size=2>3.0</font></b></TD>"_
+"<TD align=right><font face=Arial size=2>"&Dnr(4)&"</font></TD>"_
+"<TD width=9> </TD><TD><TABLE bgColor=blue height=10 width"_
+"="&Dnr(4)&" cellSpacing=0 cellPadding=0 border= 0><TR><TD></TD>"_
+"</TR></TABLE></TD></TR><TR><TD height=21><b><font face=Arial "_
+"size=2>2.5</font></b></TD><TD align=right><font face=Arial "_
+"size=2> "&Dnr(5)&" </font></TD><TD width=9> "_
+"</TD><TD><TABLE bgColor=blue height=10 width="&Dnr(5)&" "_
+"cellSpacing=0 cellPadding=0 border= 0><TR><TD></TD></TR>"_
+"</TABLE></TD></TR></TABLE>"
sDoc=sDoc&"</body></html>"
Set Doc=SDB.Objects("BrowserWindow").Document
Doc.Write sDoc
Doc.Close
SDB.Objects("ToDoLst")=SongsID
SDB.Objects("ToDoLvl")=SongsRL
fc.ChildControl("BtnDoMore").Common.Enabled = True
'HourGlass Cursor Off
CreateObject("SongsDB.SDBApplication").CursorType=0
End Sub
'----------------------------------------------------------------
Sub DoMoreStuff(x)
SaveUserSettings
oForm.Common.Visible = False
Set Prg = SDB.Progress
Prg.MaxValue = SDB.Objects("ToDoLst").Count
Prg.Text="Adding tracks to playlist..."
n=0
Set MthrPlst=SDB.PlaylistByTitle("").CreateChildPlaylist("Auto Rating Catch-Up")
For i = 0 to 5
Set ChldPlst = MthrPlst.CreateChildPlaylist(RatingTable(5-i,1))
ChldPlst.Clear
Do While SDB.Objects("ToDoLvl").Item(n)=i
ChldPlst.AddTrackById(SDB.Objects("ToDoLst").Item(n))
n=n+1
Prg.Value=n
If Prg.Terminate Then Exit Do
Loop
If Prg.Terminate Then Exit For
Next
EmptyStuff
SDB.Objects("arForm")=Nothing
End Sub
'----------------------------------------------------------------
Sub CloseSave(m)
SaveUserSettings
EmptyStuff
SDB.Objects("arForm")=Nothing
End Sub
'----------------------------------------------------------------
Sub SaveUserSettings
Set fc=SDB.Objects("arForm").Common
ni.IntValue("arCUScript","Classic")=fc.ChildControl("Clas").ItemIndex
ni.IntValue("arCUScript","Star100")=fc.ChildControl("R10").Value
ni.IntValue("arCUScript","Star090")=fc.ChildControl("R09").Value
ni.IntValue("arCUScript","Star080")=fc.ChildControl("R08").Value
ni.IntValue("arCUScript","Star070")=fc.ChildControl("R07").Value
ni.IntValue("arCUScript","Star060")=fc.ChildControl("R06").Value
ni.IntValue("arCUScript","Star050")=fc.ChildControl("R05").Value
ni.BoolValue("arCUScript","Exist")=True
If ni.StringValue("arCUScript","LastLevel")="" Then
ni.StringValue("arCUScript","LastLevel")=Date
ElseIf DateDiff("d", ni.StringValue("arCUScript","LastLevel"), Date) > 50 Then
ni.IntValue("arCUScript","TopL")=0
ni.IntValue("arCUScript","TopM")=0
ni.IntValue("arCUScript","TopH")=0
ni.StringValue("arCUScript","LastLevel")=Date
End If
End Sub
Sub EmptyStuff
SDB.Objects("ToDoLvl")=Nothing
SDB.Objects("ToDoLst")=Nothing
SDB.Objects("BrowserWindow")=Nothing
End Sub
Note to other scripters.
No modified version of this script should be posted anywhere else than this thread, and never in a complete form. Only the modified part should be posted in this thread and in this tread only!