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

Groups > comp.lang.forth > #34848

Re: Rosetta Code: Top rank per group

Show all headers | View raw

Julian Fondren wrote:

> 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
> ---
> 


> : 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




WRONG.

There is no department D50.



> 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
> 

Gauche Scheme:

(define (get-fields str)
  (map (^x (if (#/^\d/ x) (string->number x) x))
       (string-split str #\,)))

(define records
  (map get-fields
    (string-split
      "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"
      #/\s*\n\s*/)))

(define salary-table (make-tree-map))
(dolist (rec records)
  (tree-map-push! salary-table (last rec) (ref rec 2)))

(define (top-salaries n)
  (tree-map-for-each salary-table
    (lambda (dept salaries)
      (display dept)
      (dolist (s (take* (sort salaries >) n)) (display #" ~s"))
      (print))))

gosh> (top-salaries 1)
D050 47000
D101 53500
D190 57000
D202 49500
#<undef>
gosh> (top-salaries 2)
D050 47000 21900
D101 53500 41500
D190 57000 29900
D202 49500 27800
#<undef>
gosh> (top-salaries 4)
D050 47000 21900
D101 53500 41500 32000 27000
D190 57000 29900
D202 49500 27800 19250 18000
#<undef>
gosh> (top-salaries 98765432198765432198765432100000000000000000)
D050 47000 21900
D101 53500 41500 32000 27000 15900
D190 57000 29900
D202 49500 27800 19250 18000
#<undef>

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-09 00:53 +0000

csiph-web