Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #11518
| From | "WJ" <w_a_x_man@yahoo.com> |
|---|---|
| Newsgroups | comp.lang.forth |
| Subject | Re: Google CodeJam? |
| Date | 2012-04-22 04:03 +0000 |
| Organization | NewsGuy - Unlimited Usenet $19.95 |
| Message-ID | <jmvvul02moh@enews4.newsguy.com> (permalink) |
| References | <97af1620-3418-40b0-8c6f-b4ef828227c2@iu9g2000pbc.googlegroups.com> <ef8dcfcf-f7b6-474f-a20d-197d269575cd@f37g2000yqc.googlegroups.com> <13201023.2427.1335046423871.JavaMail.geo-discussion-forums@ynbi17> |
hughaguilar96@yahoo.com wrote:
> On Thursday, April 12, 2012 1:43:19 AM UTC-6, Hugh Aguilar wrote:
> > Just for fun, lets have our own comp.lang.forth contest to write the
> > best Forth solution to the "alien language" problem.
> > http://code.google.com/codejam/contest/90101/dashboard#s=p0
> > This will be a loser's consolation contest, as none of us have any
> > chance at the real contest.
>
> I've waited and waited, but nobody has come forward. To qualify for the CodeJam contest, the program had to be written in under 8 minutes. That is very fast programming; I think that a typical programmer using a modern language would take about 1/2 hour. My own Forth program took me about 3 hours, so I am 6 times slower than pretty much everybody. This is a big part of why Forth is not used in the work world. No employer is going to pay anybody to program in Forth when it takes 6 times longer to write a program than it does in any other language. Also, I had the advantage of having my novice package available. Without the novice package, I think most Forth programmers would take maybe 3 days to write a program like this (that is why nobody responded to my challenge).
>
> It seems extremely unlikely that any Forther is going to come up with a Forth program to compete against mine. I would like to see programmers of other languages, such as Lisp and Ruby and so forth, present their own programs along with a mention of how much time was required. It is okay to post non-Forth code on comp.lang.forth --- nobody is posting Forth code --- if we are going to get any code posted, it will have to be in other languages.
>
> Here is my own Forth code:
>
> \ This is the solution to the "alien language" example problem from Google CodeJam.
> \ http://code.google.com/codejam/contest/90101/dashboard#s=p0
>
> \ Written by Hugh Aguilar --- copyright (c) 2012 --- BSD license
>
> \ requires novice.4th and list.4th
>
> marker alien.4th
>
>
> \ ******
> \ ****** input and output
> \ ******
>
> variable #letters
> variable #words
> variable #patterns
>
> : seqs ( name-str -- word-seq pattern-seq )
> read-seq
> dup .line @ count evaluate
> #patterns ! #words ! #letters !
> .fore @ \ -- word-seq
> dup #words @ nth \ -- word-seq pattern-seq
> delink
> dup #patterns @ nth \ -- word-seq pattern-seq extraneous-seq
> delink kill-seq \ -- word-seq pattern-seq
> \ error checking
> over length #words @ <> abort" *** bad word-seq ***"
> dup length #patterns @ <> abort" *** bad pattern-seq ***"
> over each[ .line @ c@ #letters @ <> abort" *** string in word-seq is wrong length ***" ]each ;
>
> : dump-result ( pattern-list name-str -- )
> <cstr +cstr c" .result" +cstr cstr> write-seq ;
>
>
> \ ******
> \ ****** convert pattern string into any-seq list
> \ ****** each node in the list represents one char in the target string
> \ ****** the .LINE string of each node contains all of the character that would match
> \ ******
>
> : check-any-str { pattern-str head -- }
> head length #letters @ <> if
> cr ." *** any-seq is the wrong length ***"
> cr pattern-str count type
> cr true abort" *** aborting ***
> then ;
>
> \ If CHECK-ANY-STR fails, this is usually because the pattern-str is longer than 255 characters and it got truncated.
> \ This happens in the file: A-large-practice.in
> \ I could upgrade the program to deal with this problem, but doing so would involve rewriting the SEQ code in LIST.4TH.
>
> : <make-any-seq> ( head str -- head )
> dup c@ if new-seq link \ str has characters in it
> else drop then ;
>
> : make-any-seq { pattern-str | group? -- any-seq }
> nil <cstr
> pattern-str count bounds ?do \ -- head
> group? if \ if inside of ( ) group
> I c@ [char] ) = if false to group? cstr> <make-any-seq> <cstr
> else I c@ char+cstr then
> else \ else outside of ( ) group
> I c@ [char] ( = if true to group?
> else I c@ char+cstr cstr> <make-any-seq> <cstr then
> then
> loop
> cstr> <make-any-seq>
> pattern-str over check-any-str ;
>
>
> \ ******
> \ ****** generate pattern matcher
> \ ******
>
> char & comment \ this is an example of what will get generated
>
> :noname ( char-adr -- match? ) \ this is for: a(bc)
>
> false \ -- char-adr any?
> over c@ 97 = if true or then
> 0= if drop false exit then
> 1+ \ -- new-char-adr
>
> false \ -- char-adr any?
> over c@ 98 = if true or then
> over c@ 99 = if true or then
> 0= if drop false exit then
> 1+ \ -- new-char-adr
>
> drop true ;
>
> &
>
> : <generate-pattern> { node -- }
> s" false " evaluate
> node .line @ count bounds do
> s" over c@ " evaluate
> I c@ lit,
> s" = if true or then " evaluate
> loop
> s" 0= if drop false exit then 1+ " evaluate ;
>
> : generate-pattern ( any-seq -- xt )
> >r
> s" :noname ( char-adr -- match? ) " evaluate
> r> ['] <generate-pattern> each
> s" drop true ; " evaluate ;
>
>
> \ ******
> \ ****** upgrade pattern-seq
> \ ******
>
> seq \ .LINE starts out as pattern-str, later gets changed to result-str
> w field .any \ pointer to any-seq
> w field .xt \ xt of generated pattern matcher
> w field .matches \ count of matches for this pattern
> constant pattern
>
> : <kill-pattern> ( node -- )
> dup .any @ kill-seq
> <kill-seq> ;
>
> : kill-pattern ( head -- )
> each[ <kill-pattern> ]each ;
>
> : init-pattern ( pattern-str node -- node )
> init-seq >r
> r@ .line @ make-any-seq r@ .any !
> r@ .any @ generate-pattern r@ .xt !
> 0 r@ .matches !
> r> ;
>
> : new-pattern ( str -- node )
> pattern alloc
> init-pattern ;
>
> : upgrade-pattern ( pattern-seq -- pattern-list ) \ create a PATTERN list given a SEQ list
> nil swap \ -- pattern-list pattern-seq
> each[ .line @ new-pattern link ]each ;
>
>
> \ ******
> \ ****** pattern-match
> \ ******
>
> : <check-word> ( pattern-list-node word-seq-node -- )
> .line @ count drop \ -- pattern-list-node char-adr \ assume str size is correct
> over .xt @ execute \ -- pattern-list-node match?
> if 1 over .matches +! then ; \ -- pattern-list-node
>
> : <check-pattern> ( word-seq pattern-list-node -- word-seq )
> over ['] <check-word> each \ -- word-seq pattern-list-node
> drop ;
>
> : check-pattern ( word-seq pattern-list -- )
> ['] <check-pattern> each \ -- word-seq
> drop ;
>
>
> \ ******
> \ ****** make result strings
> \ ******
>
> : u>str ( u -- adr cnt )
> u>d <# #s #> ;
>
> : <fill-result> ( pattern# pattern-list-node -- new-pattern# )
> dup .line @ dealloc \ get rid of pattern-str in .LINE
> <cstr
> c" Case #" +cstr
> over u>str <+cstr>
> c" : " +cstr
> dup .matches @ u>str <+cstr>
> cstr> hstr swap .line ! \ -- pattern# \ set result-str to .LINE
> 1+ ; \ -- new-pattern#
>
> : fill-result ( pattern-list -- )
> 1 swap ['] <fill-result> each \ -- pattern#
> drop ;
>
>
> \ ******
> \ ****** main program
> \ ******
>
> : alien ( name-str -- )
> dup seqs { name-str word-seq pattern-seq | pattern-list -- }
> s" marker upgrade-pattern-stuff " evaluate \ so we can get rid of the UPGRADE-PATTERN words
> pattern-seq upgrade-pattern to pattern-list
> word-seq pattern-list check-pattern
> pattern-list fill-result
> pattern-list name-str dump-result
> \ clean up
> word-seq kill-seq
> pattern-seq kill-seq
> pattern-list kill-pattern
> s" upgrade-pattern-stuff " evaluate ;
>
Ruby:
_, numwords, numpatterns = gets().split.map{|s| s.to_i}
words = (1 .. numwords).map{ gets().strip }
patterns = (1 .. numpatterns).map{ gets().strip }
patterns.each_with_index{|pat,i|
regex = Regexp.new( pat.gsub("(", "[").gsub(")", "]") )
printf "Case #%d: %d\n", i, words.grep( regex ).size
}
Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread
Google CodeJam? Ian Osgood <iano@quirkster.com> - 2012-04-11 16:23 -0700
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-12 00:43 -0700
Re: Google CodeJam? hughaguilar96@yahoo.com - 2012-04-21 15:13 -0700
Re: Google CodeJam? Bernd Paysan <bernd.paysan@gmx.de> - 2012-04-22 02:19 +0200
Re: Google CodeJam? "WJ" <w_a_x_man@yahoo.com> - 2012-04-22 04:03 +0000
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-22 23:08 -0700
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-22 23:17 -0700
Re: Google CodeJam? "WJ" <w_a_x_man@yahoo.com> - 2012-04-23 19:27 +0000
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-23 22:08 -0700
Re: Google CodeJam? "WJ" <w_a_x_man@yahoo.com> - 2012-04-24 08:30 +0000
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-24 23:00 -0700
Re: Google CodeJam? "WJ" <w_a_x_man@yahoo.com> - 2012-04-26 09:19 +0000
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-26 03:17 -0700
Re: Google CodeJam? vandys@vsta.org - 2012-04-26 16:45 +0000
Re: Google CodeJam? Paul Rubin <no.email@nospam.invalid> - 2012-04-26 10:47 -0700
Re: Google CodeJam? Paul Rubin <no.email@nospam.invalid> - 2012-04-27 02:26 -0700
Re: Google CodeJam? vandys@vsta.org - 2012-04-27 16:37 +0000
Re: Google CodeJam? Paul Rubin <no.email@nospam.invalid> - 2012-04-27 10:17 -0700
Re: Google CodeJam? vandys@vsta.org - 2012-04-27 18:15 +0000
Re: Google CodeJam? Rugxulo <rugxulo@gmail.com> - 2012-04-26 16:00 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-22 12:12 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-22 14:11 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-22 14:17 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-25 14:25 +0200
Re: Google CodeJam? mhx@iae.nl (Marcel Hendrix) - 2012-04-22 18:23 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-22 22:24 +0200
Re: Google CodeJam? mhx@iae.nl (Marcel Hendrix) - 2012-04-23 20:59 +0200
Re: Google CodeJam? Paul Rubin <no.email@nospam.invalid> - 2012-04-23 13:56 -0700
Re: Google CodeJam? mhx@iae.nl (Marcel Hendrix) - 2012-04-22 18:29 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-22 21:36 +0200
Re: Google CodeJam? Bernd Paysan <bernd.paysan@gmx.de> - 2012-04-22 23:08 +0200
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-22 23:06 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-23 23:19 +0200
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-23 22:35 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-25 01:59 +0200
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-24 22:16 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-25 14:25 +0200
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-25 11:58 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-26 00:23 +0200
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-25 11:58 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-26 00:23 +0200
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-25 11:58 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-26 00:23 +0200
Re: Google CodeJam? Albert van der Horst <albert@spenarnc.xs4all.nl> - 2012-04-26 12:36 +0000
Re: Google CodeJam? anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2012-04-25 13:39 +0000
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-04-25 10:05 -0700
Re: Google CodeJam? anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2012-04-26 16:30 +0000
Re: Google CodeJam? Bernd Paysan <bernd.paysan@gmx.de> - 2012-04-27 15:21 +0200
Re: Google CodeJam? Paul Rubin <no.email@nospam.invalid> - 2012-04-24 00:51 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-25 01:59 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-25 01:59 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-27 14:15 +0200
Re: Google CodeJam? hughaguilar96@yahoo.com - 2012-04-30 23:54 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-05-02 01:44 +0200
Re: Google CodeJam? Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-05-01 20:45 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-05-02 23:38 +0200
Re: Google CodeJam? Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2012-04-24 12:50 +0100
Re: Google CodeJam? Paul Rubin <no.email@nospam.invalid> - 2012-04-24 08:22 -0700
Re: Google CodeJam? mhx@iae.nl (Marcel Hendrix) - 2012-04-24 22:28 +0200
Re: Google CodeJam? Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2012-04-25 09:50 +0100
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-25 01:59 +0200
Re: Google CodeJam? Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2012-04-25 09:49 +0100
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-04-27 18:28 +0200
Re: Google CodeJam? Bruno Gauthier <bgauthier@free.fr> - 2012-05-01 17:59 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-05-01 19:12 +0200
Re: Google CodeJam? Bruno Gauthier <bgauthier@free.fr> - 2012-05-01 20:39 +0200
Re: Google CodeJam? mhx@iae.nl - 2012-05-01 16:00 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-05-02 02:29 +0200
Re: Google CodeJam? Paul Rubin <no.email@nospam.invalid> - 2012-05-01 19:18 -0700
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-05-02 05:14 +0200
Re: Google CodeJam? awegel@arcor.de (Alex Wegel) - 2012-05-02 01:44 +0200
csiph-web