Skip to content
Browse files

Merge pull request #20 from missingfaktor/master

Factor solution
  • Loading branch information...
2 parents d431d81 + ba91f37 commit 89e5e5a762c9a686c94ef9f4d7427bac6a213a6f @apauley committed Jul 28, 2012
Showing with 124 additions and 0 deletions.
  1. +22 −0 factor/missingfaktor/README.md
  2. +102 −0 factor/missingfaktor/holling-berries.factor
View
22 factor/missingfaktor/README.md
@@ -0,0 +1,22 @@
+# HollingBerries Solution in Factor
+
+This is a translation of ArtyomKazak's Haskell solution.
+
+## Installing Factor
+
+Download and install Factor - stable release 0.94 from [this site](http://factorcode.org).
+
+Note that Factor is still in its infancy and breaking changes occur quite often. As such, attempting to run the program with a newer version of Factor (to be released soon) is likely to result in errors. If that happens, please notify me, and I will try to update the code to the most recent release of the language.
+
+## Running the solution
+
+In your Factor installation directory, there should be an executable file named "factor". That's "Listener", Factor's REPL. Run that, and type the following:
+
+```factor
+! Enter appropriate paths below.
+"path/to/holling-berries.factor" run-file
+USE: holling-berries
+"path/to/produce.csv" "path/to/output/file" holling-berries
+```
+
+You should see an output file created at the specified output path.
View
102 factor/missingfaktor/holling-berries.factor
@@ -0,0 +1,102 @@
+USING: kernel io accessors prettyprint locals combinators assocs continuations
+ sequences splitting calendar formatting io.files io.encodings.utf8 fry
+ alien.syntax csv grouping lexer parser math math.functions math.order
+ math.parser sequences.generalizations ;
+
+IN: holling-berries
+
+<< SYNTAX: alist{ \ } [ 2 group >alist ] parse-literal ; >>
+
+ALIAS: >n string>number
+
+ENUM: kind apple banana berry other ;
+
+CONSTANT: markup-table alist{
+ apple 1.4
+ banana 1.35
+ berry 1.55
+ other 1.5
+}
+
+CONSTANT: shelf-table alist{
+ apple 14
+ banana 5
+ berry 7
+ other 7
+}
+
+CONSTANT: code-table alist{
+ apple {
+ { 1100 1199 }
+ }
+ banana {
+ { 1200 1299 }
+ }
+ berry {
+ { 1300 1399 }
+ }
+ other {
+ { 1000 1099 }
+ { 1400 1999 }
+ }
+}
+
+: repeat ( n seq -- new-seq )
+ [ ] curry replicate concat ;
+
+: read-date ( str -- date )
+ "/" split [ >n ] map first3 <date> ;
+
+: present-date ( date -- str )
+ "%Y/%m/%d" strftime ;
+
+TUPLE: item supplier code descript day price units ;
+
+C: <item> item
+
+: present-item ( item -- str )
+ [ units>> ]
+ [
+ [ price>> ]
+ [ day>> present-date ]
+ [ descript>> 31 head ] tri "R%8.2f%10s%31s\n" sprintf
+ ] bi repeat ;
+
+: read-item ( seq -- item )
+ 6 firstn
+ item new
+ swap >n >>units
+ swap >n 100.0 / >>price
+ swap read-date >>day
+ swap >>descript
+ swap >n >>code
+ swap >n >>supplier ;
+
+: trouble? ( item -- ? )
+ supplier>> { 32 101 } member? ;
+
+: premium? ( item -- ? )
+ supplier>> { 204 219 } member? ;
+
+: between?' ( range x -- ? )
+ swap first2 between? ;
+
+: item-kind ( item -- kind )
+ '[ second [ _ code>> between?' ] any? ] code-table swap find first nip ;
+
+:: calculate ( item -- item' )
+ item clone :> item'
+ item' {
+ [ item-kind ] [ price>> ] [ trouble? ] [ premium? ] [ day>> ]
+ } cleave :> ( k pr tr pm d )
+ k [ markup-table at ] [ shelf-table at ] bi :> ( mk sh )
+ item' pm [ mk 0.1 + pr * ceiling ] [ mk pr * tr 2 0 ? - ] if 0 max >>price
+ d sh tr 3 0 ? - days time+ >>day ;
+
+: process ( csv -- str )
+ rest [ length 6 = ] filter [ read-item calculate present-item ] map concat ;
+
+:: holling-berries ( in out -- )
+ out utf8 [
+ in utf8 file>csv process "%s" printf
+ ] with-file-writer ;

0 comments on commit 89e5e5a

Please sign in to comment.
Something went wrong with that request. Please try again.