9
\$\begingroup\$

The challenge is to implement a 2-dimensional ray tracing program, text-based.

Sources of white light are @ symbols. R, G and B are light filters. / and \ are mirrors with 80% reflectivity. ? is a light sensor. >, <, ^ and V combine light in the appropriate direction (e.g. if one red and one green came into a > the light would be emitted toward the right and it would be yellow). Other non-whitespace characters absorb all light. Light is emitted from @ symbols in four directions.

When the program is run, it should produce output the same as the input, but with traced rays. Because this is 2 dimensional, and I guarantee in the input no rays will ever cross, there will be no problem with that. Each ray should be represented by a letter; r=red, g=green, b=blue, c=cyan, m=magenta, y=yellow, w=white. There won't be any ternary colors, ever. The casing is important to differentiate it from the input. After that output, the values of light captured by the question marks (in order of their appearance, left to right top to bottom) should be outputted as percentages and colors. For example, this input:

 /                  @
                    -
 \R>                 ?

 @B/

Should give the output:

 /wwwwwwwwwwwwwwwwww@w
 w                  -
w\R>mmmmmmmmmmmmmmmmm?
 w b
 @B/

#1: 72% Magenta

Another important point to note - when two colors are combined using a "prism" (the arrows) the strength of the combined light becomes the average strength of the two. Output must be exactly as specified (e.g. #x: [x][x]x% Color).

If your language cannot read from STDIN and write to STDOUT, create a function (anonymous or lambda when available) that accepts the input as an argument and returns the result.

Directives to the compiler, structures required or recommended for all or most programs created in the language, etc. can be omitted. For example, #include and using directives (but not #define) may be removed in C-style languages, #/usr/bin/perl -options in Perl, and

 Module Module1
      Sub Main()
      End Sub
 End Module

in VB.NET, for example. If you import namespaces or add include directives, please note them in your answer.

Is that hard enough, now? :)

\$\endgroup\$
  • \$\begingroup\$ Related to Code Golf: Lasers on Stack Overflow. \$\endgroup\$ – dmckee May 17 '11 at 23:05
  • \$\begingroup\$ The behaviour of the mirrors in your example doesn't make sense. You have a \ (escaping is broken) affecting light which is going straight past it. It would seem much more sensible to have light come in on the same row as the mirror and leave on the same column, or vice versa. Similarly the > is capturing light which is going straight past it. And if the w from the top goes through that R, so should the b from the bottom. Finally (I think), you're wrong about rays not crossing. To give a one-line example, what would the correct output be for @R> B@? \$\endgroup\$ – Peter Taylor May 17 '11 at 23:14
  • \$\begingroup\$ Why did you add a random w and break all of the spacing? And the light is not going straight past it, not sure what you mean. \$\endgroup\$ – Ry- May 17 '11 at 23:16
  • \$\begingroup\$ @minitech, that @ in the bottom-left emits light in all four directions, doesn't it? So in particular, it emits that w. And I haven't broken any spacing, at least as rendered in Chromium. As to going straight past it, my edit may clear that up. \$\endgroup\$ – Peter Taylor May 17 '11 at 23:18
  • 5
    \$\begingroup\$ minitech: As an advice for future tasks: Ask for comments in the Sandbox or Puzzle Lab first which should suffice to iron out inconsistencies and early problems with tasks. That way, once you post the task here, you'll know it has been checked (and maybe implemented) already by some others. \$\endgroup\$ – Joey May 17 '11 at 23:47
2
\$\begingroup\$

Python, 602 559 614 chars

import sys
S=sys.stdin.readlines()
X=max(len(s)for s in S)
I='#'*X+''.join(t[:-1]+' '*(X-len(t))+'\n'for t in S)+'#'*X
L=len(I)
R=range(L)
B=[0]*L
C=[0]*L
for p in R:
 if'@'!=I[p]:continue
 for d in(1,-1,X,-X):
  q=p;c=7;b=100.
  while 1:
   q+=d;a=I[q];B[q]+=b;C[q]|=c
   if a in'\/':d=(ord(a)/30-2)*X/d;b*=.8
   elif a in'RGB':c&=ord(a)/5-12
   elif a in'><^V':d={'>':1,'<':-1,'^':-X,'V':X}[a];b/=2
   elif' '!=a:break
print''.join(I[p]if' '!=I[p]else' bgcrmyw'[C[p]]for p in R[X:-X])
i=0
for p in R:
 if'?'==I[p]:i+=1;print'#%d:'%i,'%.0f%%'%B[p],[0,'Blue','Green','Cyan','Red','Magenta','Yellow','White'][C[p]]

Edit: fixed so it doesn't need trailing spaces.

\$\endgroup\$
  • \$\begingroup\$ Almost - but the test case result is incorrect. See: ideone.com/kUTxE . +1 anyways, though, it's great!!! \$\endgroup\$ – Ry- May 18 '11 at 18:05
  • \$\begingroup\$ @minitech:I think this has to do with the lack of trailing spaces. My code assumes that each row is the same length, padded with spaces if necessary. Is that not the case? If so, then how do you know, e.g., how far the upper light source goes to the right? \$\endgroup\$ – Keith Randall May 18 '11 at 19:09
  • \$\begingroup\$ Using the length of the longest line to pad it, you can figure out the whole grid. However, even when padded with spaces, it gives this (input #4): ideone.com/kUTxE \$\endgroup\$ – Ry- May 18 '11 at 19:19
  • \$\begingroup\$ @minitech: you're missing a space on the 4th line. I'll fix my code to not require trailing spaces. \$\endgroup\$ – Keith Randall May 18 '11 at 19:36
  • \$\begingroup\$ Oh, wow it does work!! Good job. But yes, it would be good if it didn't require padding. \$\endgroup\$ – Ry- May 18 '11 at 19:43
2
\$\begingroup\$

F#

#nowarn "0025"

open System

type MirrorDirection = bool
type LightDirection = bool * bool
type Sq =
  | Air // [ ]
  | Mirror of MirrorDirection // [/] [\]
  | FilterR
  | FilterG
  | FilterB
  | Sensor // [?]
  | Combine of LightDirection // [^] [v] [<] [>]
  | Emitter // [@]
  | Wall of Char // non-whitespace

let [ mL; mR ] : MirrorDirection list = [ true; false ]
(* true T^/
       F</>F
        /vT   false
 *)
let [ dN; dS; dW; dE ] : LightDirection list = [ true, true; false, true; true, false; false, false ]
let bounce (m : MirrorDirection) ((a, b) : LightDirection) =
  m <> a, not b

let dv (a : LightDirection) =
  if a = dN then 0, -1
  elif a = dS then 0, 1
  elif a = dW then -1, 0
  else 1, 0

let fo<'a> : (('a option)[,] -> 'a seq) =
  Seq.cast
  >> Seq.filter Option.isSome
  >> Seq.map Option.get

let input = Console.In.ReadToEnd().Replace("\r\n", "\n")
let sqs =
  input.Split('\n')
  |> Array.map (fun x ->
    x.ToCharArray()
    |> Array.map (
      function
      | ' ' | '\t' | '\v' -> Air
      | '/' -> Mirror mL
      | '\\' -> Mirror mR
      | 'R' -> FilterR
      | 'G' -> FilterG
      | 'B' -> FilterB
      | '?' -> Sensor
      | '^' -> Combine dN
      | 'v' -> Combine dS
      | '<' -> Combine dW
      | '>' -> Combine dE
      | '@' -> Emitter
      | x -> Wall x
    )
  )

let w =
  Array.map Array.length sqs
  |> Set.ofArray
  |> Set.maxElement
let h = sqs.Length

let ib x y = -1 < x && x < w && -1 < y && y < h

let arr = Array2D.init w h (fun x y ->
  if x < sqs.[y].Length then
    sqs.[y].[x]
  else
    Air
)

let board =
  Array2D.map (
    function
    | _ -> 0.0, 0.0, 0.0
  ) arr

let mutable rays =
  Array2D.mapi (fun x y a ->
    match a with
    | Emitter -> Some(x, y)
    | _ -> None
  ) arr
  |> fo
  |> Seq.map (fun (x, y) ->
    [|
      dN, x, y, 1., 1., 1.
      dS, x, y, 1., 1., 1.
      dW, x, y, 1., 1., 1.
      dE, x, y, 1., 1., 1.
    |]
  )
  |> Seq.reduce Array.append

for i = 0 to w * h * 2 do
  rays <-
    rays
    |> Array.map (
      (fun (dir, x, y, r, g, b) ->
        let dx, dy = dv dir
        dir, x + dx, y + dy, r, g, b
      )
      >> (fun (dir, x, y, r, g, b) ->
        if ib x y then
          match arr.[x, y] with
          | Wall _ -> Array.empty
          | Sensor -> [| dir, x, y, r, g, b |]
          | FilterR -> [| dir, x, y, r, 0., 0. |]
          | FilterG -> [| dir, x, y, 0., g, 0. |]
          | FilterB -> [| dir, x, y, 0., 0., b |]
          | Mirror d -> [| bounce d dir, x, y, r * 0.8, g * 0.8, b * 0.8 |]
          | _ -> [| dir, x, y, r, g, b |]
        else
          Array.empty
      ))
    |> Array.concat
  Array2D.mapi (fun x y a ->
    match a with
    | Combine d -> Some(x, y, d)
    | _ -> None
  ) arr
  |> fo
  |> Seq.iter (fun (x, y, d) ->
    for i = 0 to rays.Length - 1 do
      let (d', x', y', r, g, b) = rays.[i]
      if x' = x && y' = y then
        rays.[i] <- (d, x, y, r, g, b)
  )
  for d, x, y, r, g, b in rays do
    if ib x y then
      match board.[x, y] with
      | r', g', b' -> board.[x, y] <- r + r', g + g', b + b'

printfn "%s" (
  let mutable s = ""
  for y = 0 to h - 1 do
    for x = 0 to w - 1 do
      s <- s + (match arr.[x, y] with
                | Air ->
                  match board.[x, y] with
                  | r, g, b ->
                    if r + g + b = 0.0 then ' '
                    else
                      if g = 0.0 && b = 0.0 then 'r'
                      elif r = 0.0 && b = 0.0 then 'g'
                      elif r = 0.0 && g = 0.0 then 'b'
                      elif r = 0.0 then 'c'
                      elif g = 0.0 then 'm'
                      elif b = 0.0 then 'y'
                      else 'w'
                | Wall z -> z
                | Mirror z -> if z = mL then '/' else '\\'
                | FilterR -> 'R'
                | FilterG -> 'G'
                | FilterB -> 'B'
                | Sensor -> '?'
                | Combine z -> if z = dN then '^' elif z = dS then 'v' elif z = dW then '<' else '>'
                | Emitter -> '@'
                |> sprintf "%c")
    s <- s + "\n"
  s
)

Array2D.mapi (fun x y a ->
  match a with
  | Sensor -> Some(x, y)
  | _ -> None
) arr
|> fo
|> Seq.iteri (fun i (x, y) ->
  let (r, g, b) = board.[x, y]
  let desc =
    if r + g + b = 0.0 then "None"
    elif g = 0.0 && b = 0.0 then "Red"
    elif r = 0.0 && b = 0.0 then "Green"
    elif r = 0.0 && g = 0.0 then "Blue"
    elif r = 0.0 then "Cyan"
    elif g = 0.0 then "Magenta"
    elif b = 0.0 then "Yellow"
    else "White"
  let avg = int((r + g + b) * 100.0 / (match desc with
                                       | "White" | "None" -> 3.0
                                       | "Red" | "Green" | "Blue" -> 1.0
                                       | _ -> 2.0))
  printfn "#%d: %d%% %s" (i + 1) avg desc
)
\$\endgroup\$
  • \$\begingroup\$ Ungolfed but still awesome! +1. \$\endgroup\$ – Ry- May 18 '11 at 23:23

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.