Data commit

Task/Rosetta-Code-Rank-languages-by-popularity/Tcl/rosetta-code-rank-languages-by-popularity-1.tcl

@@ -0,0 +1,40 @@
+package require Tcl 8.5
+package require http
+
+set response [http::geturl http://rosettacode.org/mw/index.php?title=Special:Categories&limit=8000]
+
+array set ignore {
+    "Basic language learning"           1
+    "Encyclopedia"                      1
+    "Implementations"                   1
+    "Language Implementations"          1
+    "Language users"                    1
+    "Maintenance/OmitCategoriesCreated" 1
+    "Programming Languages"             1
+    "Programming Tasks"                 1
+    "RCTemplates"                       1
+    "Solutions by Library"              1
+    "Solutions by Programming Language" 1
+    "Solutions by Programming Task"     1
+    "Unimplemented tasks by language"   1
+    "WikiStubs"                         1
+    "Examples needing attention"	1
+    "Impl needed"			1	
+}
+# need substring filter
+proc filterLang {n} {
+    return [expr {[string first "User" $n] > 0}]
+}
+# (sorry the 1 double quote in the regexp kills highlighting)
+foreach line [split [http::data $response] \n] {
+    if {[regexp {title..Category:([^"]+).* \((\d+) members\)} $line -> lang num]} {
+        if {![info exists ignore($lang)] && ![filterLang $lang]} {
+            lappend langs [list $num $lang]
+        }
+    }
+}
+
+foreach entry [lsort -integer -index 0 -decreasing $langs] {
+    lassign $entry num lang
+    puts [format "%d. %d - %s" [incr i] $num $lang]
+}

Task/Rosetta-Code-Rank-languages-by-popularity/Tcl/rosetta-code-rank-languages-by-popularity-2.tcl

@@ -0,0 +1,110 @@
+package require Tcl 8.5
+package require http
+package require tdom
+
+namespace eval rc {
+    ### Utility function that handles the low-level querying ###
+    proc rcq {q xp vn b} {
+	upvar 1 $vn v
+	dict set q action "query"
+        # Loop to pick up all results out of a category query
+	while 1 {
+	    set url "http://rosettacode.org/mw/api.php?[http::formatQuery {*}$q]"
+	    puts -nonewline stderr .		;# Indicate query progress...
+	    set token [http::geturl $url]
+	    set doc [dom parse [http::data $token]]
+	    http::cleanup $token
+
+	    # Spoon out the DOM nodes that the caller wanted
+	    foreach v [$doc selectNodes $xp] {
+		uplevel 1 $b
+	    }
+
+	    # See if we want to go round the loop again
+	    set next [$doc selectNodes "//query-continue/categorymembers"]
+	    if {![llength $next]} break
+	    dict set q cmcontinue [[lindex $next 0] getAttribute "cmcontinue"]
+	}
+    }
+
+    ### API function: Iterate over the members of a category ###
+    proc members {page varName script} {
+	upvar 1 $varName var
+	set query [dict create cmtitle "Category:$page" {*}{
+	    list "categorymembers"
+	    format "xml"
+	    cmlimit "500"
+	}]
+	rcq $query "//cm" item {
+	    # Tell the caller's script about the item
+	    set var [$item getAttribute "title"]
+	    uplevel 1 $script
+	}
+    }
+
+    ### API function: Count the members of a list of categories ###
+    proc count {cats catVar countVar script} {
+	upvar 1 $catVar cat $countVar count
+	set query [dict create prop "categoryinfo" format "xml"]
+	for {set n 0} {$n<[llength $cats]} {incr n 20} {    ;# limit fetch to 20 at a time
+	    dict set query titles [join [lrange $cats $n $n+19] |]
+	    rcq $query "//page" item {
+		# Get title and count
+		set cat [$item getAttribute "title"]
+		set info [$item getElementsByTagName "categoryinfo"]
+		if {[llength $info]} {
+		    set count [[lindex $info 0] getAttribute "pages"]
+		} else {
+		    set count 0
+		}
+		# Let the caller's script figure out what to do with them
+		uplevel 1 $script
+	    }
+	}
+    }
+
+    ### Assemble the bits into a whole API ###
+    namespace export members count
+    namespace ensemble create
+}
+
+# Get the list of programming languages
+rc members "Programming Languages" lang {
+    lappend langs $lang
+}
+puts stderr ""			;# Because of the progress dots...
+puts "There are [llength $langs] languages"
+
+# Get the count of solutions for each, stripping "Category:" prefix
+rc count $langs l c {
+    dict set langcounts [regsub {^Category:} $l {}] $c
+}
+puts stderr ""			;# Because of the progress dots...
+
+# Print the output
+puts "Here are the top fifteen:"
+set langcounts [lsort -stride 2 -index 1 -integer -decreasing $langcounts]
+set i 0
+foreach {lang count} $langcounts {
+    puts [format "%1\$3d. %3\$3d - %2\$s" [incr n] $lang $count]
+    if {[incr i]>=15} break
+}
+
+# --- generate a full report, similar in format to REXX example
+proc popreport {langcounts} {
+    set bycount {}
+    foreach {lang count} $langcounts {
+	dict lappend bycount $count $lang
+    }
+    set bycount [lsort -stride 2 -integer -decreasing $bycount]
+    set rank 1
+    foreach {count langs} $bycount {
+	set tied [expr {[llength $langs] > 1 ? "\[tied\]" : ""}]
+	foreach lang $langs {
+	    puts [format {%15s:%4d  %-12s %12s  %s} rank $rank $tied "($count entries)" $lang]
+	}
+	incr rank [llength $langs]
+    }
+}
+
+popreport $langcounts