Auto Rating of Songs & Radio Announcer v5.02 [Script]

[agentsmart]

well leave it to the cowboy to compair it to a western movie.

[confused]

the autorate catch up script is going slow on my computer it takes forever to do anything then the lights on front of the computer flash but nothing happens on screen i get tired and stop the monkey by closing it which causes an error because a com thingy is still connected to monkey so i close it too. what is going on

[rovingcowboy]

so it is going slow for you too confused?

i also gave up i let it run for about 4 hours but gave up on it since it was on the small pent 2 cpu, i thought that might have been it.

but now you said it is slow maybe it was not my cpu?

[DiddeLeeDoo]

Main reason for the slow performance is the display of the artists and their songs. This operation takes a lot of CPU power.

I've rearranged some code and added a function that show the numbers only, which takes about 2 seconds for all star levels on my machine. I just haven't finished that part yet.

But now when I know someone actually want to give this a spinn, I'll finish that part and drop it in here hopefully within some hours.

I added this to the script post yesterday I think..

Things that I want to add and improve on
1. Improve performance
2. Show Quck numerical results, of all rating levels without showing artists. (takes seconds in Dev version)
3. Progress bar (already in development version)
4. Show Graphical results of all rating levels, like the graph above.
5. Disable certain Rating Levels. Like only do 3-5 Stars for example.
6. Test the DateAdded Theory

[DiddeLeeDoo]

News 16 May 2006
AutoRateSongs.vbs received one litte update related to the Radio Announcer only.

[Link to script]

The Radio Announcer now pause the music while speaking. In addition the Text to Speech part were simplefied a bit.

No need to update AutoRateSongs.vbs if you do not use the Radio Announcer.

I hope to be able over time to make the Announcer part better by putting it into the multi tasking environment, instead of a vbs script.

[DiddeLeeDoo]

The Catch-Up script is taken out at the moment. Found an error in the SQL part, which could be the cause of the huge demand for power.

Currently have a version in development, but it's not finished, so I figured it's best to use some more time to get together something that do not contain silly errors like the first one.

[rovingcowboy]

i did notice if i kept clearing ram the script did run faster.

if that helps you.

but that 10 hours dang near drained me because it was with out the music playing.

[DiddeLeeDoo]

That is just incredible!

GUI is exhausting and I was just happy to have something that could be tried out, hinting about 'just try 5 Stars'

I cannot believe that you have so much patience. I normally cannot wait more than 15 seconds max for anything on the computer..

Thank you for trying it out though. I appreciate that, and will try to get together a quick version next...

[DiddeLeeDoo]

Here's a version in development... not much added, as I've been concentrating on tuning up the SQL part.

Just a raport at this stage, but I think the speed is up considerably...

Code: Select all

Taken out too... need a few days to get this one finished

[Guest]

i ain't that patiant.

that was the 5 th time i tried it i had to tie my hands down so i could not touch the mouse or keyboard.

i finally got the ropes loose in 10 and 1 half hours. then i stopped it.

i am hyper so that really dang near wore me out.

will try this one.

roving cowboy / keith hall.

see i leaned over the fence and signed it for you this time steegy.

[DiddeLeeDoo]

I just woke up here, and I give it another test here. With one table having 25.000 plays over 3 years, and one with 10.000 plays over 1 year, and it's about as quick as browsing music in MM itself.

The error I found a bit late were that I got a 0 swapped over in a date formula. That could create a huge report on big databases. Sorry about that!

I didn't spot it here, due to my playhistory do not go over years. But anyways that 0 system is not used in the version above, and I will not use that again... pommise...

The 'second' version of this script is going to get a totally different profile. Just takes awhile to get it all together.. May take a few days...

[bilzebub]

Hi,

not sure what my problem is, but I can seem to get the autorater to work: i copied the three scripts onto notepad, save them as vbs and ini respectively, and restarted mm, but no sign of autorate in options (I am using the latest beta is that a problem?)

Thanks,
Bill

[DiddeLeeDoo]

The AutoRate Option Sheet needs to go in the Scripts\Auto folder. Then restart, and you should be right I think..

Thanks for giving it a go....

Working hard at the moment to get finished another script too, that allow you to catch up with ratings... Hope to have it ready today or tomorrow....

[DiddeLeeDoo]

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>&nbsp;</TD><TD>&nbsp;</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>&nbsp;</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>&nbsp;</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>&nbsp;</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>&nbsp;</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>&nbsp;</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>&nbsp;&nbsp;"&Dnr(5)&" </font></TD><TD width=9>&nbsp;"_
+"</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!

[rovingcowboy]

well it took about 5 seconds on this winXp but that is only about 3 years worth of database songs to go through.

with your default settings.

the win98 is also a slower cpu. and 5 years of database songs. so it might take longer.



how ever you know me. get that steel ruler out.

this changing your scripts is getting harder but i want them other 5 star ratings. soo..

then to think again. this script does not adjust the file's rating it just makes a playlist? are you going to included the rating or just let that up to the keep update rating script.?

so i got that changed already.

no need to change this one.?