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


Groups > comp.lang.forth > #11508

Re: Google CodeJam?

From hughaguilar96@yahoo.com
Newsgroups comp.lang.forth
Subject Re: Google CodeJam?
Date 2012-04-21 15:13 -0700
Organization http://groups.google.com
Message-ID <13201023.2427.1335046423871.JavaMail.geo-discussion-forums@ynbi17> (permalink)
References <97af1620-3418-40b0-8c6f-b4ef828227c2@iu9g2000pbc.googlegroups.com> <ef8dcfcf-f7b6-474f-a20d-197d269575cd@f37g2000yqc.googlegroups.com>

Show all headers | View raw


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 ;
    

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


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