Sync
This commit is contained in:
Ingy döt Net
parent
6f050a029e
commit
776bba907c
3887 changed files with 59894 additions and 7280 deletions
|
|
@ -0,0 +1,42 @@
|
|||
USING: arrays assocs concurrency.combinators
|
||||
concurrency.semaphores formatting hashtables http.client io
|
||||
json.reader kernel math math.parser sequences splitting
|
||||
urls.encoding ;
|
||||
IN: rosetta-code.count-examples
|
||||
|
||||
CONSTANT: list-url "http://rosettacode.org/mw/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&cmprop=title&format=json"
|
||||
|
||||
: titles ( query -- titles )
|
||||
"query" of "categorymembers" of [ "title" of ] map ;
|
||||
: continued-url ( query -- url/f )
|
||||
"query-continue" of "categorymembers" of
|
||||
[ assoc>query list-url swap "&" glue ] [ f ] if* ;
|
||||
|
||||
: (all-programming-titles) ( titles url -- titles' url' )
|
||||
http-get nip json> [ titles append ] [ continued-url ] bi
|
||||
[ (all-programming-titles) ] [ f ] if* ;
|
||||
: all-programming-titles ( -- titles ) { } list-url (all-programming-titles) drop ;
|
||||
|
||||
CONSTANT: content-base-url "http://rosettacode.org/mw/index.php?title=&action=raw"
|
||||
: content-url ( title -- url )
|
||||
" " "_" replace
|
||||
"title" associate assoc>query
|
||||
content-base-url swap "&" glue ;
|
||||
|
||||
: occurences ( seq subseq -- n ) split-subseq length 1 - ;
|
||||
: count-examples ( title -- n )
|
||||
content-url http-get nip "=={{header|" occurences ;
|
||||
|
||||
: print-task ( title n -- ) "%s: %d examples.\n" printf ;
|
||||
: print-total ( assoc -- ) values sum "Total: %d examples.\n" printf ;
|
||||
: fetch-counts ( titles -- assoc )
|
||||
10 <semaphore> [
|
||||
[ dup count-examples 2array ] with-semaphore
|
||||
] curry parallel-map ;
|
||||
|
||||
: print-counts ( titles -- )
|
||||
[ [ print-task ] assoc-each nl ] [ print-total ] bi ;
|
||||
: rosetta-examples ( -- )
|
||||
all-programming-titles fetch-counts print-counts ;
|
||||
|
||||
MAIN: rosetta-examples
|
||||
|
|
@ -9,57 +9,74 @@ link strings
|
|||
link hexcvt
|
||||
|
||||
procedure main(A) # simple single threaded read all at once implementation
|
||||
|
||||
index := ReadURL(RCINDEX) # 1. read the index
|
||||
|
||||
pages := []
|
||||
index ? while tab(find("<cm ") & find(s :="title=\"")+*s) do
|
||||
put(pages,tab(find("\""))) # 2. extract the pages
|
||||
|
||||
Tasks := table(0)
|
||||
every p := !pages do { # 3. process each page
|
||||
|
||||
if p << A[1] then next # for tests on small #s
|
||||
|
||||
page := ReadURL(url := RCTASK||CleanURI(p))
|
||||
Tasks[TASKTOT] +:= 1 # . count pages (tasks)
|
||||
every find("=={{header|",page) do { # . count headers
|
||||
Tasks[p] +:= 1
|
||||
Tasks[TOTTOT] +:= 1
|
||||
}
|
||||
}
|
||||
|
||||
every insert(O := set(),key(Tasks)) # 4. extract & sort keys
|
||||
O := put(sort(O--set(TOTTOT,TASKTOT)),TASKTOT,TOTTOT) # move totals at the end
|
||||
|
||||
every write(k := !O, " : ", Tasks[k]," examples.") # 5. report
|
||||
Tasks := table(0)
|
||||
every task := taskNames() do {
|
||||
Tasks[TASKTOT] +:= 1 # count tasks
|
||||
every lang := languages(task) do { # count languages
|
||||
Tasks[task] +:= 1
|
||||
Tasks[TOTTOT] +:= 1
|
||||
}
|
||||
}
|
||||
every insert(O := set(),key(Tasks)) # extract & sort keys
|
||||
O := put(sort(O--set(TOTTOT,TASKTOT)),TASKTOT,TOTTOT) # move totals to end
|
||||
every write(k := !O, " : ", Tasks[k]," examples.") # report
|
||||
end
|
||||
|
||||
procedure CleanURI(u) #: clean up a URI
|
||||
static tr,dxml # xml & http translation
|
||||
initial {
|
||||
tr := table()
|
||||
every c := !string(~(&digits++&letters++'-_.!~*()/\'')) do
|
||||
tr[c] := "%"||hexstring(ord(c),2)
|
||||
every /tr[c := !string(&cset)] := c
|
||||
tr[" "] := "_" # wiki convention
|
||||
every push(dxml := [],"&#"||right(ord(c := !"&<>'\""),3,"0")||";",c)
|
||||
}
|
||||
|
||||
dxml[1] := u # insert URI as 1st arg
|
||||
u := replacem!dxml # de-xml it
|
||||
every (c := "") ||:= tr[!u] # reencode everything
|
||||
return c
|
||||
# Generate task names
|
||||
procedure taskNames()
|
||||
continue := ""
|
||||
while \(txt := ReadURL(RCINDEX||continue)) do {
|
||||
txt ? {
|
||||
while tab(find("<cm ") & find(s :="title=\"")+*s) do
|
||||
suspend tab(find("\""))\1
|
||||
if tab(find("cmcontinue=")) then {
|
||||
continue := "&"||tab(upto(' \t'))
|
||||
}
|
||||
else break
|
||||
}
|
||||
}
|
||||
end
|
||||
|
||||
procedure ReadURL(url) #: read URL into string
|
||||
write(&errout,"Opening ",image(url))
|
||||
page := open(url,"m",RCUA,RCXUA) | stop("Unable to open ",url)
|
||||
text := ""
|
||||
if page["Status-Code"] < 300 then
|
||||
while text ||:= reads(page,-1)
|
||||
else
|
||||
stop(page["Status-Code"]," ",page["Reason-Phrase"])
|
||||
close(page)
|
||||
return text
|
||||
# Generate language headers in a task
|
||||
procedure languages(task)
|
||||
static WS
|
||||
initial WS := ' \t'
|
||||
page := ReadURL(RCTASK||CleanURI(task))
|
||||
page ? while (tab(find("\n==")),tab(many(WS))|"",tab(find("{{"))) do {
|
||||
header := tab(find("=="))
|
||||
header ? {
|
||||
while tab(find("{{header|")) do {
|
||||
suspend 2(="{{header|",tab(find("}}")))\1
|
||||
}
|
||||
}
|
||||
}
|
||||
end
|
||||
|
||||
procedure CleanURI(u) #: clean up a URI
|
||||
static tr,dxml # xml & http translation
|
||||
initial {
|
||||
tr := table()
|
||||
every c := !string(~(&digits++&letters++'-_.!~*()/\'`')) do
|
||||
tr[c] := "%"||hexstring(ord(c),2)
|
||||
every /tr[c := !string(&cset)] := c
|
||||
tr[" "] := "_" # wiki convention
|
||||
every push(dxml := [],"&#"||right(ord(c := !"&<>'\""),3,"0")||";",c)
|
||||
}
|
||||
|
||||
dxml[1] := u # insert URI as 1st arg
|
||||
u := replacem!dxml # de-xml it
|
||||
every (c := "") ||:= tr[!u] # reencode everything
|
||||
c := replace(c,"%3E","'") # Hack to put single quotes back in
|
||||
c := replace(c,"%26quot%3B","\"") # Hack to put double quotes back in
|
||||
return c
|
||||
end
|
||||
|
||||
procedure ReadURL(url) #: read URL into string
|
||||
page := open(url,"m",RCUA,RCXUA) | stop("Unable to open ",url)
|
||||
text := ""
|
||||
if page["Status-Code"] < 300 then while text ||:= reads(page,-1)
|
||||
else write(&errout,image(url),": ",
|
||||
page["Status-Code"]," ",page["Reason-Phrase"])
|
||||
close(page)
|
||||
return text
|
||||
end
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue