Reddit daily programmer

Oforth examples. Feel free to post your own code.

Reddit daily programmer

Postby sotolf » 23 Nov 2016 15:54

[2016-11-21] Challenge #293 [Easy] Defusing the bomb
https://www.reddit.com/r/dailyprogrammer/comments/5e4mde/20161121_challenge_293_easy_defusing_the_bomb/

Having a lot of fun solving this, and trying to get a grip of oforth again, I'm sure a lot of what I have done is not optimal, but it works :)

Code: Select all
import: console

: getLines \ -- [String] Get input lines until empty
| lst | ArrayBuffer new ->lst
doWhile: [ System.Console accept "" .cr
           dup size 0 > ifTrue: [ lst add true ]
           else: [ drop false ] ] lst ;

ArrayBuffer method: clone \ AB -- AB(clone)
ArrayBuffer new dup self swap addAll ;

: makePairs \ AB AB -- [Pairs]
dup removeFirst drop zip ;

: whitePair? \ Pair -- ? \ check if white pair ok
second dup
"white" == swap
"black" == or not ;

: redPair? \ Pair -- ? \ check if red pair ok
second "green" == ;

: blackPair? \ Pair -- ? \ check if black pair ok
second dup dup
"white" == swap
"green" == rot
"orange" == or or not ;

: orangePair? \ Pair -- ? \ check if orange pair ok
second dup
"red" == swap
"black" == or ;

: greenPair? \ Pair -- ? \ check if green pair ok
second dup
"orange" == swap
"white" == or ;

: purplePair? \ Pair -- ? \ check if purple pair ok
second dup
"purple" == swap
dup "green" == swap
dup "orange" == swap
"white" == or or or not ;

: checkPair \ Pair -- ? \ check if pair ok
dup first
dup "white" == ifTrue: [ drop whitePair? return ]
dup "red"   == ifTrue: [ drop redPair? return ]
dup "black" == ifTrue: [ drop blackPair? return ]
dup "orange" == ifTrue: [ drop orangePair? return ]
dup "green" == ifTrue: [ drop greenPair? return ]
"purple" == ifTrue: [ purplePair? ] ;

: testPairs \ [Pair] -- i/o
#checkPair swap map
#and swap reduce
ifTrue: [ "Bomb defused" .cr ] else: [ "Boom" .cr ];

getLines dup clone makePairs testPairs


I'm unsure if the way I'm doing input is the way that I'm supposed to, and the checkPair word seems a bit overly long, there has to be a better way to solve that? But I had a lot of fun doing it.

@franck: I have to say that I'm really happy with the changes you have made to oforth, it's really even more fun than it was before :)
sotolf
 
Posts: 55
Joined: 30 Jul 2015 15:53

Re: Reddit daily programmer

Postby Franck » 23 Nov 2016 21:37

Cool. And, if you had fun, that is the most important :)
Thank you very much for your comments.

Some remarks on your code :
1) clone already exists : #asArrayBuffer. This works on all collections and creates a new arrayBuffer.
2) I think using () to send parameters can sometimes be better than swaps (see testPairs), but do as you feel better.
3) I have defined a constant RULES with rules in order to simplify #checkPair.
4) I have used symbols instead of strings because symbols are identity strings.

Here is another possible version (not tested) :

Code: Select all
import: console

[ [ $white,  #[ [ $white, $black ] include not ] ],
  [ $red,    #[ $green = ] ],
  [ $black,  #[ [ $white, $green, $orange ] include not ] ],
  [ $orange, #[ [ $red, $black ] include ] ],
  [ $green,  #[ [ $orange, $white ] include ] ],
  [ $purple, #[ [ $purple, $green, $orange, $white ] include not ] ]
] const: RULES

: getLines \ -- [String] Get input lines until empty
   ArrayBuffer new
   while ( System.Console accept "" .cr dup notEmpty ) [
      asSymbol over add
      ]
   drop
;

: makePairs \ AB AB -- [Pairs]
   dup removeFirst drop zip ;

: checkPair \ ( pair -- ? )  \ check if pair ok
   dup second swap first RULES valueAt perform ; 

: testPairs \ [Pair] -- i/o
   map( #checkPair ) reduce ( #and )
   ifTrue: [ "Bomb defused" .cr ] else: [ "Boom" .cr ] ;

getLines dup asArrayBuffer makePairs testPairs


Franck
Franck
 
Posts: 140
Joined: 29 Oct 2014 19:01

Re: Reddit daily programmer

Postby sotolf » 24 Nov 2016 09:29

Wow, thank you!

It's amazing how much shorter and elegant the code can be when it's done by someone that knows what they are doing :D

1) clone already exists : #asArrayBuffer. This works on all collections and creates a new arrayBuffer.

Ah, so I can use that, I didn't find that one, now I know :) Still have to read more in the manual, it's really nice.

2) I think using () to send parameters can sometimes be better than swaps (see testPairs), but do as you feel better.

Yeah, looks better, and is easier to read just have to remember that it exists, I always tend to forget.

3) I have defined a constant RULES with rules in order to simplify #checkPair.

I would never have have thought about making a rule like that, but it's so much cleaner/shorter/easy to read. That looks really amazing too, I'll be trying to understand it, so that I can use that superpower for myself as well :)

4) I have used symbols instead of strings because symbols are identity strings.

So that means that $white == "white" ? because I was thinking a bit about using symbols, but then I didn't find a way to change the words to symbols :)

EDIT: Ah, now I see it, there was an asSymbol in there, that explains it :)


Thank you so much for your reply, and it's amazingly helpful for me, and hopefully for others as well to see how one first thinks it can be, and how well it can turn out when one knows better to factor, and make it beautiful and nice. Just thank you for being an amazing guy and giving happiness into my life that quite sorely needs it at the moment :) I just wanted to say thank you, and that I really appreciate what you're doing with oforth :)
sotolf
 
Posts: 55
Joined: 30 Jul 2015 15:53

Re: Reddit daily programmer

Postby Franck » 24 Nov 2016 21:43

You're welcome.

The best compliment is that you have fun with Oforth and I hope you will always have ;)

You are right, some pieces of code can be elegant and fun. And I think that this feeling can happen more with languages like Oforth.
For instance, I often come back to my code to improve it or to find better factors. I don't do this so often in other languages...

As for factoring this daily programmer, I have kept some words, but, if I had to write it from scratch,
I think #makePairs factor is not necessary if #tail is used. For instance :

Code: Select all
import: console

[ [ $white,  #[ [ $white, $black ] include not ] ],
  [ $red,    #[ $green = ] ],
  [ $black,  #[ [ $white, $green, $orange ] include not ] ],
  [ $orange, #[ [ $red, $black ] include ] ],
  [ $green,  #[ [ $orange, $white ] include ] ],
  [ $purple, #[ [ $purple, $green, $orange, $white ] include not ] ]
] const: RULES

: getInput       \ -- [String] Get input lines until empty
   ArrayBuffer new
   while ( System.Console accept printcr dup notEmpty ) [
      asSymbol over add
      ] drop
;

: checkCables    \ aPair -- ?
   dup second swap first RULES valueAt perform ;

: bomb
   getInput dup tail zip
   map( #checkCables ) reduce( #and )
   ifTrue: [ "Bomb defused" ] else: [ "Boom" ] .cr
;


Franck
Franck
 
Posts: 140
Joined: 29 Oct 2014 19:01


Return to Oforth examples

Who is online

Users browsing this forum: No registered users and 1 guest

cron