Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #34901

Re: Rosetta Code: Top rank per group

Show all headers | View raw

Julian Fondren wrote:

> Hello clf,
> 
> Rosetta Code has a 'top rank per group' task:
> http://rosettacode.org/wiki/Top_rank_per_group
> 
> Which reads:
> 
> ---
> Find the top N salaries in each department, where N is provided as a parameter.
> Use this data as a formatted internal data structure (adapt it to your
> language-native idioms, rather than parse at runtime), or identify your
> external data source:
> 
> Employee Name,Employee ID,Salary,Department
> Tyler Bennett,E10297,32000,D101
> John Rappl,E21437,47000,D050
> George Woltman,E00127,53500,D101
> Adam Smith,E63535,18000,D202
> Claire Buckman,E39876,27800,D202
> David McClellan,E04242,41500,D101
> Rich Holcomb,E01234,49500,D202
> Nathan Adams,E41298,21900,D050
> Richard Potter,E43128,15900,D101
> David Motsinger,E27002,19250,D202
> Tim Sampair,E03033,27000,D101
> Kim Arlich,E10001,57000,D190
> Timothy Grove,E16398,29900,D190
> ---
> 
> If you look on the page you'll note that there is no Forth solution.
> 
> In general, I think there are three good kinds of solutions to this problem,
> with the best depending on your circumstances.  They are:
> 
> 1. brute-force the answer with high-level data structures: walk the table,
> adding departments as keys to a hash table, the values of which are lists of
> salaries.  Once you've exhausted the table, sort the keys of the hash (for nice
> output) and then print them and their top N of the sorted lists of salaries.
> 
> (If you've never used a Perl oneliner that you wrote in a minute to chew on
> multiple repquota streams and spit out the top diskspace-using users, then that
> I call this a 'good solution' may puzzle you.)
> 
> 2. feed this table to a relational DBMS and then use SQL to get the answer.
> 
> 3. partially reinvent relational databases.  Even if the most advanced text
> that you've read is The Manga Guide to Databases, it'll immediately strike you
> that the table above may look nice, but... if you split it up and rearrange it
> a bit *like so*, it can be much easier to work with...
> 
> There is also, no pun intended and nothing meant by it, a fourth solution:
> solve the problem with custom data types and algorithms that are closely
> dependent on both the exact query and the exact data.
> 
> I'd like to demonstrate a solution of this last kind.
> 
> First, an uninteresting representation of the employee table: a solid mass of
> counted strings.
> 
> : string, ( c-addr u -- )
>   dup c,  here swap  dup allot  move ;
> 
> variable #employees
> : | ( -- )
>   1 #employees +!
>   begin [char] , parse dup while string, repeat 2drop ;
> 
> create employees
> \ Employee Name,Employee ID,Salary,Department
> >  Tyler Bennett,E10297,32000,D101
> >  John Rappl,E21437,47000,D050
> >  George Woltman,E00127,53500,D101
> >  Adam Smith,E63535,18000,D202
> >  Claire Buckman,E39876,27800,D202
> >  David McClellan,E04242,41500,D101
> >  Rich Holcomb,E01234,49500,D202
> >  Nathan Adams,E41298,21900,D050
> >  Richard Potter,E43128,15900,D101
> >  David Motsinger,E27002,19250,D202
> >  Tim Sampair,E03033,27000,D101
> >  Kim Arlich,E10001,57000,D190
> >  Timothy Grove,E16398,29900,D190
> 
> 4 constant #columns
> 
> : .employee ( a -- )
>   cr #columns 1 do count 2dup type ." , " + loop count type ;
> 
> : /employee ( a -- a' )
>   #columns 0 do count + loop ;
> 
> : salary ( a -- n )
>   count + count + count 0. 2swap >number 2drop d>s ;
> 
> : department ( a -- n )
>   count + count + count + count 0. 2swap 1 /string >NUMBER 2drop d>s ;
> 
> : .employees ( -- )
>   employees  #employees @ 0 do dup .employee /employee loop drop ;
> 
> Second, an always-sorted 'top N' type:
> 
> ( top-N array : {max,cur,x*cur} )
> : topn ( n -- a )
>   dup 2 + cells  dup allocate throw tuck swap erase
>   tuck ! 0 over cell+ ! ;
> 
> : >topn ( n a -- )
>   dup 2@ <> if 1 over cell+ +! then
>   dup 2 cells + swap  cell+ @ cells bounds do
>     dup i @ > if i @ swap i ! then
>   cell +loop drop ;
> 
> : .topn ( a -- )
>   cell+ dup cell+ swap @ cells bounds ?do i @ . cell +loop ;
> 
> Third, since the departments are numerical and with a small range, and again so
> that I don't have to sort anything, an array of potential departments with
> their values either 0 or a TOPN, and then the final words.
> 
> ( query )
> variable max-n
> 
> 300 constant #departments
> create departments  #departments cells allot
> 
> : >department ( n-salary n-department -- )
>   cells departments + dup @ if @ >topn
>   else max-n @ topn tuck swap ! >topn then ;
> 
> : query ( -- ) \ top N salaries by department
>   departments #departments cells erase
>   employees #employees @ 0 do
>     dup salary over department >department
>   /employee loop drop ;
> 
> : .top-salaries ( -- )
>   #departments 0 do
>     i cells departments + @
>     dup if cr ." D" i 0 .r space .topn else drop
>   then loop ;
> 
> : top-salaries ( n -- )
>   max-n ! query .top-salaries ;
> 
> And that's it.  No questions about any of that?  OK.  With
> user input indented and with extra spacing:
> 
>   3 top-salaries
> D50 47000 21900
> D101 53500 41500 32000
> D190 57000 29900
> D202 49500 27800 19250  ok
> 
>   1 top-salaries
> D50 47000
> D101 53500
> D190 57000
> D202 49500  ok
> 
>   400 top-salaries
> D50 47000 21900
> D101 53500 41500 32000 27000 15900
> D190 57000 29900
> D202 49500 27800 19250 18000  ok
> 
> Although the query is 'top salaries by department', now that I look at the
> other answers on that page, I see that every one of them provides the employee
> record associated with the top salaries.  For that, TOPN could have pairs of
> (salary,employee record address) cells.

OCaml:

#load "str.cma";;

let get_salary record = int_of_string (List.nth record 2) ;;
let get_dept record = List.nth record 3 ;;
let compare_salaries a b =
  - (compare (get_salary a) (get_salary b)) ;;

let records =
  List.sort
    compare_salaries
    (List.map (fun s -> Str.split (Str.regexp ",") (String.trim s))
      (Str.split (Str.regexp "\n")
        "Tyler Bennett,E10297,32000,D101
        John Rappl,E21437,47000,D050
        George Woltman,E00127,53500,D101
        Adam Smith,E63535,18000,D202
        Claire Buckman,E39876,27800,D202
        David McClellan,E04242,41500,D101
        Rich Holcomb,E01234,49500,D202
        Nathan Adams,E41298,21900,D050
        Richard Potter,E43128,15900,D101
        David Motsinger,E27002,19250,D202
        Tim Sampair,E03033,27000,D101
        Kim Arlich,E10001,57000,D190
        Timothy Grove,E16398,29900,D190")) ;;

let departments =
  List.sort compare
    (List.fold_left
      (fun accum s -> if List.mem s accum then accum else s::accum)
      []
      (List.map get_dept records)) ;;

let print_record record =
  print_string "  ";
  print_endline (String.concat ", " record) ;;

let top_salaries n =
  List.iter
    (fun dept ->
      print_endline dept ;
      let recs = (List.filter (fun r -> dept = get_dept r) records) in
        for i = 1 to (min n (List.length recs)) do
           print_record (List.nth recs (pred i))
        done)
    departments ;;

# top_salaries 0 ;;
D050
D101
D190
D202
- : unit = ()
# top_salaries 1 ;;
D050
  John Rappl, E21437, 47000, D050
D101
  George Woltman, E00127, 53500, D101
D190
  Kim Arlich, E10001, 57000, D190
D202
  Rich Holcomb, E01234, 49500, D202
- : unit = ()
# top_salaries 2 ;;
D050
  John Rappl, E21437, 47000, D050
  Nathan Adams, E41298, 21900, D050
D101
  George Woltman, E00127, 53500, D101
  David McClellan, E04242, 41500, D101
D190
  Kim Arlich, E10001, 57000, D190
  Timothy Grove, E16398, 29900, D190
D202
  Rich Holcomb, E01234, 49500, D202
  Claire Buckman, E39876, 27800, D202
- : unit = ()
# top_salaries 9 ;;
D050
  John Rappl, E21437, 47000, D050
  Nathan Adams, E41298, 21900, D050
D101
  George Woltman, E00127, 53500, D101
  David McClellan, E04242, 41500, D101
  Tyler Bennett, E10297, 32000, D101
  Tim Sampair, E03033, 27000, D101
  Richard Potter, E43128, 15900, D101
D190
  Kim Arlich, E10001, 57000, D190
  Timothy Grove, E16398, 29900, D190
D202
  Rich Holcomb, E01234, 49500, D202
  Claire Buckman, E39876, 27800, D202
  David Motsinger, E27002, 19250, D202
  Adam Smith, E63535, 18000, D202

Back to comp.lang.forth | Previous | Next | Find similar | Unroll thread

Thread

Re: Rosetta Code: Top rank per group "WJ" <w_a_x_man@yahoo.com> - 2014-12-13 18:29 +0000

csiph-web