Code Golf: Numeric Ranges - language-agnostic

Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
Challenge
Compactify a long list of numbers by replacing consecutive runs with ranges.
Example
Input
1, 2, 3, 4, 7, 8, 10, 12, 13, 14, 15
The input is guaranteed to be in ascending order and will not contain duplicates.
Output
1 - 4, 7, 8, 10, 12 - 15
Note that ranges of two numbers should be left as is. (7, 8; not 7 - 8)
Rules
You can accept a sorted list of integers (or equivalent datatype) as a method parameter, from the commandline, or from standard in. (pick whichever option results in shorter code)
You can output a list of strings by printing them, or by returning either a single string or set of strings.
Reference Implementation
(C#)
IEnumerable<string> Sample(IList<int> input) {
for (int i = 0; i < input.Count; ) {
var start = input[i];
int size = 1;
while (++i < input.Count && input[i] == start + size)
size++;
if (size == 1)
yield return start.ToString();
else if (size == 2) {
yield return start.ToString();
yield return (start + 1).ToString();
} else if (size > 2)
yield return start + " - " + (start + size - 1);
}
}

Python, 98 characters
def f(a):
for x in a:
if x-1not in a or x+1not in a:print x,"-"if x+1in a and x+2in a else",",
Python - 86 characters
This one doesn't include an extra ',' at the end
f=lambda a:''.join(`x`+",-"[(x+1in a)&x+2in a]for x in a if(x-1in a)&(x+1in a)^1)[:-1]

Python, 83 characters
def f(l,a=2):
for x in l:
b,a=a,(x+1in l)*(x-1in l)
if a<1:print',- '[b],`x`,
Demo:
>>> l=[1, 2, 3, 4, 7, 8, 10, 12, 13, 14, 15]
>>> f(l)
1 - 4 , 7 , 8 , 10 , 12 - 15

Ruby, 165 characters
a=[]
def o(a)print "#{#s}#{a[0]}#{"#{a.size<3?',':' -'} #{a[-1]}"if a.size>1}";#s=', 'end
ARGV[0].split(', ').each{|n|if a[0]&&a[-1].succ!=n;o(a);a=[]end;a<<n;};o(a)

C++, 166 characters
#define o std::cout
void f(std::vector<int> v){for(int i=0,b=0,z=v.size();i<z;)i==z-1||v[i+1]>v[i]+1?b?o<<", ":o,(i-b?o<<v[b]<<(i-b>1?" - ":", "):o)<<v[i],b=++i:++i;}
Don't you all just love abusing the ?: operator? ;)
More readable version:
#define o std::cout
void f(std::vector<int> v){
for(int i=0,b=0,z=v.size();i<z;)
i==z-1||v[i+1]>v[i]+1 ?
b?o<<", ":o,
(i-b?o<<v[b]<<(i-b>1?" - ":", "):o)<<v[i],
b=++i
:++i;
}

Common Lisp, 442/206 chars
(defun d (l)
(if l
(let ((f (car l))
(r (d (cdr l))))
(if r
(if (= (+ f 1) (caar r))
(push `(,f ,(cadar r)) (cdr r))
(push `(,f ,f) r))
`((,f ,f))
))
nil))
(defun p (l)
(mapc #'(lambda (x)
(if (= (car x) (cadr x))
(format t "~a " (car x))
(if (= (+ 1 (car x)) (cadr x))
(format t "~a ~a " (car x) (cadr x))
(format t "~a-~a " (car x) (cadr x)))))
(d l)))
The "d" function rewrites the input list into a canonical form. For fun I did this entirely recursively. The "p" function formats the output to the equivalent of the reference implementation.

F#, 188 chars
let r(x::s)=
let f=printf
let p x=function|1->f"%A "x|2->f"%A %A "x (x+1)|n->f"%A-%A "x (x+n-1)
let rec l x n=function|y::s when y=x+n->l x (n+1)s|y::s->p x n;l y 1 s|[]->p x n
l x 1 s
More readable:
let range (x::xs) =
let f = printf
let print x = function
| 1 -> f "%A " x
| 2 -> f "%A %A " x (x+1)
| n -> f "%A-%A " x (x+n-1)
let rec loop x n = function
| y::ys when y=x+n ->
loop x (n+1) ys
| y::ys ->
print x n
loop y 1 ys
| [] ->
print x n
loop x 1 xs

Ruby : 123 characters
def y(n) t=[];r=[];n.each_with_index do |x,i| t<<x;if(x.succ!=n[i+1]);r=((t.size>2)?r<<t[0]<<-t[-1]:r+t);t=[];end;end;r;end
More Readable
def y(n)
t=[];r=[];
n.each_with_index do |x,i|
t << x
if (x.succ != n[i+1])
r = ((t.size > 2) ? r << t[0] << -t[-1] : r+t)
t=[]
end
end
r
end
And execute like
> n=[1, 2, 3, 4, 7, 8, 10, 12, 13, 14, 15]
> y n
=> [1, -4, 7, 8, 10, 12, -15]

PHP 95 chars
(actually it's the second language after python)
Given $a=array(numbers);
Algos:
for($i=0;$i<count($a);$i++){$c=$i;while($a[$i+2]==$a[$i]+2)$i++;echo $a[$c],$i-$c>1?'-':',';}

Related

Average of user input

I want to take the user input of a list of numbers and find the average. However, after looking for examples I have not found any that seems to match what I am doing because I can have from 2 - 100 numbers in a list. Any help/advice is appreciated.
Below is my working code as is.
main = do
putStrLn "Enter how many numbers:"
listlen <- getLine
if ((read listlen) <= 100) -- read converts a string to a number
then do
putStrLn "Enter a String of numbers:"
--numberString <- getLine
numberString<- getLine
let ints = map read (words numberString) :: [Int]
putStrLn("The List: " ++(numberString))
putStrLn("The average: ")
putStrLn("Number of values greater than average: ")
else do
putStrLn " Error: listlen must be less than or = to 100"
main
Ok, this is homework, but homework can be really tough when you have to do it in Haskell. I'll try to explain step by step how you can do.
Good to know
First, Haskell is functional. You can find different defintions of "functional", but basically you can think of it as a property of the language: everything is constant (no side effect).
Second, you can start a REPL by typing ghci in a terminal:
jferard#jferard-Z170XP-SLI:~$ ghci
GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help
Prelude> :set +m -- enable parsing of multiline commands
Prelude> -- type the expression you want to evaluate here
Recursion
How do you compute the sum of the elements of a list? In an imperative language, you will do something like that (Python like):
s = 0
for every x in xs:
s <- s + x
But s is not constant. It's updated on every iteration until we get the sum. Can we reformulate the algorithm to avoid this mutation? Fortunately yes. Here's the key idea:
sum [x] = x
sum [x1, ..., xn] = x1 + sum [x2, ..., xn]
With a little imagination, you can say that sum [] = 0. So we can write it in Haskell:
sum [] = 0
sum (x:xs) = x + sum xs
-- sum [1, 2, 3, 5] == 11
(x:xs) means: x (the head) followed by the list xs (the tail). If you have understood that, you know how we can avoid side effects in many situations: just call another function to do the rest of the job. (Note: if you know about the stack, you can imagine what happens under the hood.)
Now, how do you compute the length of a list? In a Python-like language, you'd do something like (forget len(..)):
l = 0
for every x in xs:
l <- l + 1
Again, with a recursive definition, you have:
length [] = 0
length (x:xs) = 1 + length xs
-- len [1, 2, 3, 5] == 4
Folds
Computing sum and length is so common that they are built-in functions in Haskell. But there is something more important: if you examine the two functions carefully, you'll notice this pattern:
f [] = <initial value>
f (x:xs) = g(f xs, x)
For sum, initial value is 0 and g(f xs, x) = x + f xs. For length, initial value is 0 and g(f xs, x) = 1 + f xs. This pattern is so common that Haskell has a built-in function (actually several built-in functions) for it: foldl. foldl takes a function, an initial value and a list and returns the function repeatedly applied to the previous result and the current element, until the list is consumed. You can think of the function as the the body of the loop:
sum xs = foldl (+) 0 xs
(Note on curryfication: 1. You will maybe learn some day that Haskell functions always take one argument, but that's not the point here. 2. You can remove xs on both sides: sum = foldl (+) 0)
Prelude> foldl (+) 0 [1,2,3,5]
11 -- (((0+1)+2)+3)+5
With scanl, you can in some way "debug" the foldl:
Prelude> scanl (+) 0 [1,2,3,5]
[0,1,3,6,11]
length is more tricky, since you don't have a built-in function g(f xs, x) = 1 + f xs. You can use a lambda function: \acc x -> 1 + acc where acc is the current value:
length xs = foldl (\acc x -> 1 + acc) 0 xs
Your question
Average
Let's try to write average with the built-in sum and length functions:
Prelude> average xs = sum xs / length xs
<interactive>:1:14: error:
• Could not deduce (Fractional Int) arising from a use of ‘/’
...
What does that mean? I won't get into details, but you have to know that Haskell is very strict with numbers. You can't divide two integers and expect a float result without a little work.
Prelude> :t (/)
(/) :: Fractional a => a -> a -> a
This means that / will take Fractionals. Thus, the work is: cast integers into Fractionals.
average xs = fromIntegral (sum xs) / fromIntegral (length xs)
-- average [1, 2, 3, 5] == 2.75
Number of values greater than average
Now, the number of values greater than the mean. In a Python-like langage, you'll write:
c = 0
for every x in xs:
if x > avg:
c <- c + 1
Let's try the recursive method:
gtAvg [] = 0
gtAvg (x:xs) = (if x>avg then 1) + sum xs -- WRONG
You see that there is something missing. In the imperative version, if x <= avg, we simply do nothing (and thus do not update the value). Here, we must return something:
gtAvg [] = 0
gtAvg (x:xs) = (if x>avg then 1 else 0) + gtAvg xs
But where does the avg value come from? We need to precompute it. Let's define a function that takes avg as an argument:
gtAvg' [] _ = 0
gtAvg' (x:xs) avg = (if fromIntegral x>avg then 1 else 0) + gtAvg' xs avg
-- gtAvg' [1, 2, 3, 5] (average [1, 2, 3, 5]) == 2
And then:
gtAvg xs = gtAvg' xs (average xs)
-- gtAvg [1, 2, 3, 5] == 2
Obviously, this is more simple with a foldl:
gtAvg xs = foldl (\acc x -> if fromIntegral x>average xs then acc+1 else acc) 0 xs
More (map, filter and list comprehension)
When we are on the basics of Haskell, you may need three more constructs.
Filter
First, a filter:
Prelude> filter (>2.75) [1, 2, 3, 5]
[3.0,5.0]
If you take the length of that list, you get the number of elements greater than the average:
gtAvg xs = length $ filter (\x -> fromIntegral x >average xs) xs
(Or with a composition of functions: length $ filter ((> average xs).fromIntegral) xs) Don't be disturbed by the $ sign: it means that the right side of the expression (filter...) is one block, like if it were in parenthesis.
Map
Second, map applies a function to every element of a list and returns the list of mapped elements. For instance, if you want to some squares of elements of a list:
Prelude> sum $ map (**2) [1, 2, 3, 5]
39.0
You can use it like that:
gtAvg xs = length $ filter (>average xs) $ map fromIntegral xs
It converts elements to Fractional, then it applies the filter.
List comprehension
Third, you can have filter and a map with a list comprehension:
gtAvg xs = length [x | x<-xs, fromIntegral x>average xs]
I left a lot of things aside and made probably approximations, but now you should have the basic knowledge to answer your question.
listlen :: [a] -> Int
listlen xs = go 0 xs -- 0 = initial value of accumulator
where go s [] = s -- return accumulator
go s (a:as) = go (s+1) as -- compute the next value of the accumulator
sumx :: [a] -> Int
sumx xs = go 0 xs
where go s [] = s
go s (a:as) = go ... as -- flll in the blank ... -- and recurse
lenAndSum :: [a] -> (Int,Int)
lenAndSum xs = go (0,0) xs -- (0,0) = initial values of both accumulators
where go (s1,s2) [] = (s1,s2) -- return both accumulators at the end
go (s1,s2) (a:as) = go ... as -- left as an exercise
main = do
putStrLn "Enter how many numbers:"
listlen <- getLine
if ((read listlen) <= 100) -- read converts a string to a number
then do
putStrLn "Enter a String of numbers:"
--numberString <- getLine
numberString<- getLine
let ints = map read (words numberString) :: [Int]
putStrLn("The List: " ++(numberString))
putStrLn("The average: ")
putStrLn("Number of values greater than average: ")
else do
putStrLn " Error: listlen must be less than or = to 100"
main`enter code here`

Factorise numbers (Erlang)

Im looking to factorise a number based on Head or Middle recursion in Erlang. The function is called fact and takes 1 parameter, fact/1. The result will return a list of the numbers that are factors of the number.
24 returns the following: [1,2,3,4,6,8,12,24]
Does anyone have any ideas how I would go about this?
I propose you this solution. I search first the decomposition in prime factors, and then build the list of divisors. I think it should be more efficient in average.
divlist(N) -> automult([1|decomp(N)]).
decomp(N) when is_integer(N), (N > 0) ->
lists:reverse(decomp(N,[],2)).
decomp(N,R,I) when I*I > N -> [N|R];
decomp(N,R,I) when (N rem I) =:= 0 -> decomp(N div I,[I|R],I);
decomp(N,R,2) -> decomp(N,R,3);
decomp(N,R,I) -> decomp(N,R,I+2).
automult(L=[H]) when is_number(H)-> L;
automult([H|Q]) when is_number(H)->
L1 = automult(Q),
L2 = [H*X || X <- L1],
lists:usort([H|L1]++L2).
The solutions proposed by #Zoukaye and #P_A and mine give the same result, but both of their solutions have a complexity of O(n). My proposal is more complex to evaluate since it is divided in 2 parts. The search or prime decomposition is majored by 0(log(n)), and the second part depend of the result of the first one, the interesting point is that it cannot be the worse case for both part:
if a number has many prime factor, the search of them is fast, and the composition of all divider takes longer.
if a number has few (1) prime factor, the search take longer, but the composition is short.
Last remark, #Zoukaye uses an intermediate list of integer. if you intend to use this for looooong integer, it is a bad idea since you will crash for lack of memory just building this list.
I made a performance test comparing the solutions where I create a list of N random numbers less than Max, evaluate the whole execution time for each solution, verify that they are equivalent and return times. The result is
10 000 tests for number less than 10 000:
mine: 63ms, P_A: 788ms, Zoukaye: 1383ms
10 000 tests for number less than 100 000:
mine: 80ms, P_A: 9240ms, Zoukaye: 13594ms
10 000 tests for number less than 1000 000:
mine: 105ms, P_A: 101001ms, Zoukaye: 137145ms
Here is the code I used:
-module (test).
-compile((export_all)).
test(Nbtest,Max) ->
random:seed(erlang:now()),
L = [random:uniform(Max) || _ <- lists:seq(1,Nbtest)],
F1 = fun() -> [{X,divlist(X)} || X <- L] end,
F2 = fun() -> [{X,fact_comp(X)} || X <- L] end,
F3 = fun() -> [{X,fact_rec(X)} || X <- L] end,
{T1,R} = timer:tc(F1),
{T2,R} = timer:tc(F2),
{T3,R} = timer:tc(F3),
{T1,T2,T3}.
% Method1
divlist(N) -> automult([1|decomp(N)]).
decomp(N) when is_integer(N), (N > 0) ->
lists:reverse(decomp(N,[],2)).
decomp(N,R,I) when I*I > N -> [N|R];
decomp(N,R,I) when (N rem I) =:= 0 -> decomp(N div I,[I|R],I);
decomp(N,R,2) -> decomp(N,R,3);
decomp(N,R,I) -> decomp(N,R,I+2).
automult(L=[H]) when is_number(H)-> L;
automult([H|Q]) when is_number(H)->
L1 = automult(Q),
L2 = [H*X || X <- L1],
lists:usort([H|L1]++L2).
% Method 2
fact_comp(N) ->
if N > 0 ->
[ V || V <- lists:seq(1, N div 2), N rem V =:= 0 ] ++ [ N ];
N < 0 ->
Na = 0 - N,
[ V || V <- lists:seq(1, Na div 2), Na rem V =:= 0 ] ++ [ Na ];
N =:= 0 -> []
end.
% Method 3
fact_rec(N) ->
fact_rec(N, 1, []).
fact_rec(N, I, Acc) when I =< trunc(N/2) ->
case N rem I of
0 -> fact_rec(N, I+1, [I | Acc]);
_ -> fact_rec(N, I+1, Acc)
end;
fact_rec(N, _I, Acc) -> lists:reverse(Acc) ++ [N].
Something like this?
-module(fact).
-export([fact_rec/1]).
fact_rec(N) ->
fact_rec(N, 1, []).
fact_rec(N, I, Acc) when I =< trunc(N/2) ->
case N rem I of
0 -> fact_rec(N, I+1, [I | Acc]);
_ -> fact_rec(N, I+1, Acc)
end;
fact_rec(N, _I, Acc) -> lists:reverse(Acc) ++ [N].
Using list comprehension
fact_comp(N) ->
if N > 0 ->
[ V || V <- lists:seq(1, N div 2), N rem V =:= 0 ] ++ [ N ];
N < 0 ->
Na = 0 - N,
[ V || V <- lists:seq(1, Na div 2), Na rem V =:= 0 ] ++ [ Na ];
N =:= 0 -> []
end.

What this functions in Scheme language do?

I'm a newbie and I didn't understand very well the language. Could anyone please explain to me what this functions do?
First function:
(define (x l)
(cond
((null? l) 0)
((list? (car l))
(+ (x (car l)) (x (cdr l))))
(else (+ 1 (x (cdr l))))
))
Second function:
(define (x l)
(cond
((null? l) 0)
((list? (car l))
(+ (x (car l)) (x (cdr l))))
(else (+ (car l) (x (cdr l)))
))
I do understand the begining but the conditions I didn't understand. Any help?
I will call your second function y.
Writing in pseudocode,
x [] -> 0
x [a . b] -> x a + x b , if list a
x [a . b] -> 1 + x b , else, i.e. if not (list a)
y [] -> 0
y [a . b] -> y a + y b , if list a
y [a . b] -> a + y b , else, i.e. if not (list a)
So for example,
x [2,3] = x [2 . [3]]
= 1 + x [3]
= 1 + x [3 . []]
= 1 + (1 + x [])
= 1 + (1 + 0 )
and
y [2,3] = y [2 . [3]]
= 2 + y [3]
= 2 + y [3 . []]
= 2 + ( 3 + y [])
= 2 + ( 3 + 0 )
See? The first counts something in the argument list, the second sums them up.
Of course both functions could be called with some non-list, but then both would just cause an error trying to get (car l) in the second clause, (list? (car l)).
You might have noticed that the two are almost identical. They both accumulates (fold) over a tree. Both of them will evaluate to 0 on the empty tree and both of them will sum the result of the same procedure on the car and cdr when the car is a list?. The two differ when the car is not a list and in the first it adds 1 for each element in the other it uses the element itself in the addition. It's possible to write the same a little more compact like this:
(define (sum l)
(cond
((null? l) 0) ; null-value
((not (pair? l)) l) ; term
(else (+ (sum (car l)) (sum (cdr l)))))) ; combine
Here is a generalisation:
(define (accumulate-tree tree term combiner null-value)
(let rec ((tree tree))
(cond ((null? tree) null-value)
((not (pair? tree)) (term tree))
(else (combiner (rec (car tree))
(rec (cdr tree)))))))
You can make both of your procedures in terms of accumulate-tree:
(define (count tree)
(accumulate-tree tree (lambda (x) 1) + 0))
(define (sum tree)
(accumulate-tree tree (lambda (x) x) + 0))
Of course you can make a lot more than this with accumulate-tree. It doesn't have to turn into an atomic value.
(define (double tree)
(accumulate-tree tree (lambda (x) (* 2 x)) cons '()))
(double '(1 2 ((3 4) 2 3) 4 5)) ; ==> (2 4 ((6 8) 4 6) 8 10)

What is wrong with this Lisp Function?

This function is a CLisp function, this is part of a homework problem, but which is supposed to be written in this different format (the second function).
(defun range (m M) (cond
((> m M) '() )
((= m M) '() )
((< m M) (cons m (range (+ m 1) M ) ) )
)
)
(define (range m M) (cond
((> m M) '() )
((= m M) '() )
((< m M) (cons m (range (+ m 1) M ) ) )
)
)
These should both take a min value (m) and a max value (M) and return the list of integers from min to max (exluding the max value / M-1)
I have traced this over and over and I can't see why it is just returning NIL it must be a very dumb logic mistake.
(range 1 4) => result (1 2 3)
m=1 | M=4 ==> return (cons 1 (2 3) )
m=2 | M=4 ==> return (cons 2 (3) )
m=3 | M=4 ==> return (cons 3 () )
m=4 | M=4 ==> return ()
v ^
---------/
I'm going crazy trying to figure out WHY this is not performing like I trace it.
Again, when I execute the function it results in NIL.
I ran this using SBCL and it complained that the variable M appears twice in the parameter list. Lisp is not case-sensitive for variable names.
On changing it to
(defun range (m MM)
(cond
((> m MM) '() )
((= m MM) '() )
((< m MM) (cons m (range (+ m 1) MM)))))
It worked fine.
> (trace range)
> (range 1 4)
0: (RANGE 1 4)
1: (RANGE 2 4)
2: (RANGE 3 4)
3: (RANGE 4 4)
3: RANGE returned NIL
2: RANGE returned (3)
1: RANGE returned (2 3)
0: RANGE returned (1 2 3)
-> (1 2 3)
I checked with CLISP. With different variable names it works OK. CLISP does not pick up the error, unlike SBCL.
<[1]> (defun range (m MM) (cond ((>= m MM) '())((< m MM) (cons m (range (+ m 1) MM )))))
RANGE
[2]> (range 1 4)
(1 2 3)
Here is your version:
[3]> (defun range (m M) (cond ((>= m M) '())((< m M) (cons m (range (+ m 1) M)))))
RANGE
[4]> (range 1 4)
Nil

Code Golf: New Year's Fireworks [closed]

Closed. This question is off-topic. It is not currently accepting answers.
Closed 11 years ago.
Locked. This question and its answers are locked because the question is off-topic but has historical significance. It is not currently accepting new answers or interactions.
The year 2009 is coming to an end, and with the economy and all, we'll save our money and instead of buying expensive fireworks, we'll celebrate in ASCII art this year.
The challenge
Given a set of fireworks and a time, take a picture of the firework at that very time and draw it to the console.
The best solution entered before midnight on New Year's Eve (UTC) will receive a bounty of 500 rep. This is code golf, so the number of characters counts heavily; however so do community votes, and I reserve the ultimate decision as to what is best/coolest/most creative/etc.
Input Data
Note that our coordinate system is left-to-right, bottom-to-top, so all fireworks are launched at a y-coordinate of 0 (zero).
The input data consists of fireworks of the form
(x, speed_x, speed_y, launch_time, detonation_time)
where
x is the position (column) where the firework is launched,
speed_x and speed_y are the horizontal and vertical velocity of the firework at launch time,
launch_time is the point in time that this firework is launched,
detonation_time is the point in time that this firework will detonate.
The firework data may be hardcoded in your program as a list of 5-tuples (or the equivalent in your language), not counting towards your character count. It must, however, be easy to change this data.
You may make the following assumptions:
there is a reasonable amount of fireworks (say, fewer then a hundred)
for each firework, all five numbers are integers within a reasonable range (say, 16 bits would suffice for each),
-20 <= x <= 820
-20 <= speed_x <= 20
0 < speed_y <= 20
launch_time >= 0
launch_time < detonation_time < launch_time + 50
The single additional piece of input data is the point of time which is supposed to be rendered. This is a non-negative integer that is given to you via standard input or command line argument (whichever you choose).
The idea is that (assuming your program is a python script called firework.py) this bash script gives you a nice firework animation:
#!/bin/bash
I=0
while (( 1 )) ; do
python firework.py $I
I=$(( $I + 1 ))
done
(feel free to put the equivalent .BAT file here).
Life of a firework
The life of a firework is as follows:
Before the launch time, it can be ignored.
At launch time, the rocket has the position (x, 0) and the speed vector (speed_x, speed_y).
For each time step, the speed vector is added to the position. With a little stretch applied to Newton's laws, we assume that the speed stays constant.
At detonation time, the rocket explodes into nine sparks. All nine sparks have the same position at this point in time (which is the position that the rocket would have, hadn't it exploded),
but their speeds differ. Each speed is based on the rocket's speed, with -20, 0, or 20 added to speed_x and -10, 0, or 10 added to speed_y. That's nine possible combinations.
After detonation time, gravity starts to pull: With each time step, the gravitational constant, which happens to be 2 (two), is subtracted from every spark's speed_y.
The horizontal speed_x stays constant.
For each time step after the detonation time, you first add the speed vector to the position, then subtract 2 from speed_y.
When a spark's y position drops below zero, you may forget about it.
Output
What we want is a picture of the firework the way it looks at the given point in time. We only look at the frame 0 <= x <= 789 and 0 <= y <= 239, mapping it to a 79x24 character output.
So if a rocket or spark has the position (247, 130), we draw a character in column 24 (zero-based, so it's the 25th column), row 13 (zero-based and counting from the bottom, so it's line 23 - 13 = 10, the 11th line
of the output).
Which character gets drawn depends on the current speed of the rocket / spark:
If the movement is horizontal*, i.e. speed_y == 0 or abs(speed_x) / abs(speed_y) > 2, the character is "-".
If the movement is vertical*, i.e. speed_x == 0 or abs(speed_y) / abs(speed_x) > 2, the character is "|".
Otherwise the movement is diagonal, and the character is "\" or "/" (you'll guess the right one).
If the same position gets drawn to more than once (even if it's the same character), we put "X" instead. So assuming you have a spark at (536, 119) and one at (531, 115), you draw an "X", regardless of their speeds.
* update: these are integer divisions, so the slope has to be at least 3, or at most 1/3, respectively
The output (written to standard output) is 24 lines, each terminated by a newline character. Trailing spaces are ignored, so you may, but don't need to, pad to a width of 79. The lines may not be longer than 79 characters (excluding the newline). All interior spacing must be space characters (ASCII 32).
Sample Data
Fireworks:
fireworks = [(628, 6, 6, 3, 33),
(586, 7, 11, 11, 23),
(185, -1, 17, 24, 28),
(189, 14, 10, 50, 83),
(180, 7, 5, 70, 77),
(538, -7, 7, 70, 105),
(510, -11, 19, 71, 106),
(220, -9, 7, 77, 100),
(136, 4, 14, 80, 91),
(337, -13, 20, 106, 128)]
Output at time 33:
\ | /
/ \
- | /
- | -
/ \
Output at time 77:
\
\
X
\
Output at time 93:
\ | /
\ / /
- - - \
\
/ \ \
Update: I have uploaded the expected output at the times 0 thru 99 to firework.ü-wie-geek.de/NUMBER.html, where NUMBER is the time. It includes debug information; click on a particle to see its current position, speed, etc. And yes, it's an umlaut domain. If your browser can't handle that (as obviously neither can Stack Overflow), try firework.xn---wie-geek-p9a.de.
Another update: As hinted at in the comments below, a longer firework is now available on YouTube. It was created with a modified version of MizardX' entry, with a total fireworks count of 170 (yes, that's more than the spec asked for, but the program handled it gracefully). Except for the color, the music, and the end screen, the animation can be recreated by any entry to this code golf. So, if you're geeky enough to enjoy an ASCII art firework (you know you are): Have fun, and a happy new year to all!
Heres my solution in Python:
c = [(628, 6, 6, 3, 33),
(586, 7, 11, 11, 23),
(185, -1, 17, 24, 28),
(189, 14, 10, 50, 83),
(180, 7, 5, 70, 77),
(538, -7, 7, 70, 105),
(510, -11, 19, 71, 106),
(220, -9, 7, 77, 100),
(136, 4, 14, 80, 91),
(337, -13, 20, 106, 128)]
t=input()
z=' '
s=([z]*79+['\n'])*23+[z]*79
def p(x,y,i,j):
if 0<=x<790 and 0<=y<240:p=x/10+(23-y/10)*80;I=abs(i);J=abs(j);s[p]='X-|\\/'[[s[p]!=z,I>=3*J,J>=3*I,i*j<0,1].index(1)]
for x,i,j,l,d in c:
T=t-l;x+=i*T
if t>=d:e=t-d;[p(x+X*e,j*T+e*(Y-e+1),i+X,j+Y-2*e)for X in -20,0,20 for Y in -10,0,10]
elif t>=l:p(x,j*T,i,j)
print ''.join(s)
Takes the time from the stdin and it has the nice number of 342 characters. I'm still trying to imagine how the OP got 320 :P
Edit:
This is the best I could get, 322 chars acording to wc
t=input()
s=([' ']*79+['\n'])*24
def p(x,y,i,j):
if 790>x>-1<y<240:p=x/10+(23-y/10)*80;I=abs(i);J=abs(j);s[p]='X-|\\/'[[s[p]>' ',I>=3*J,J>=3*I,i*j<0,1].index(1)]
for x,i,j,l,d in c:
T=t-l;x+=i*T;e=t-d
if t>=d:[p(x+X*e,j*T+e*(Y-e+1),i+X,j+Y-2*e)for X in-20,0,20for Y in-10,0,10]
elif t>=l:p(x,j*T,i,j)
print''.join(s),
Now that the winner is chosen – congratulations to Juan – here is my own solution, 304 characters in Python:
t=input()
Q=range
for y in Q(24):print"".join((["\\/|-"[3*(h*h>=9*v*v)or(v*v>=9*h*h)*2or h*v>0]for X,H,V,L,D in F for s,Z,K,P,u in[(t-D,t>D,t-L,G%3*20-20,G/3*10-10)for G in[Q(9),[4]][t<D]]for h,v in[[P+H,u+V-2*s*Z]]if((X+H*K+P*s)/10,23-(V*K-s*(Z*s-Z-u))/10)==(x,y)][:2]+[" ","X"])[::3][-1]for x in Q(79))
This is not really fast, because for each point in the 79x24 display, it loops through all fireworks to see if any of them is visible at this point.
Here is a version that tries to explain what's going on:
t=input()
Q=range
for y in Q(24):
line = ""
for x in Q(79):
chars = [] # will hold all characters that should be drawn at (x, y)
for X,H,V,L,D in F: # loop through the fireworks
s = t - D
Z = t > D
K = t - L
# if t < D, i.e. the rocket hasn't exploded yet, this is just [(0, 0)];
# otherwise it's all combinations of (-20, 0, 20) for x and (-10, 0, 10)
speed_deltas = [(G % 3 * 20 - 20, G / 3 * 10 -10) for G in [Q(9), [4]][t < D]]
for P, u in speed_deltas:
if x == (X + H*K + P*s)/10 and y == 23 - (V*K - s*(Z*s - Z - u))/10:
# the current horizontal and vertical speed of the particle
h = P + H
v = u + V - 2*s*Z
# this is identical to (but shorter than) abs(h) >= 3 * abs(v)
is_horizontal = h*h >= 9*v*v
is_vertical = v*v >= 9*h*h
is_northeast_southwest = h*v > 0
# a shorter way of saying
# char_index = (3 if is_horizontal else 2 if is_vertical else 1
# if is_northeast_southwest else 0)
char_index = 3 * is_horizontal or 2 * is_vertical or is_northeast_southwest
chars.append("\\/|-"[char_index])
# chars now contains all characters to be drawn to this point. So we have
# three possibilities: If chars is empty, we draw a space. If chars has
# one element, that's what we draw. And if chars has more than one element,
# we draw an "X".
actual_char = (chars[:2] + [" ", "X"])[::3][-1] # Yes, this does the trick.
line += actual_char
print line
Python:
fireworks = [(628, 6, 6, 3, 33),
(586, 7, 11, 11, 23),
(185, -1, 17, 24, 28),
(189, 14, 10, 50, 83),
(180, 7, 5, 70, 77),
(538, -7, 7, 70, 105),
(510, -11, 19, 71, 106),
(220, -9, 7, 77, 100),
(136, 4, 14, 80, 91),
(337, -13, 20, 106, 128)]
import sys
t = int(sys.argv[1])
particles = []
for x, speed_x, speed_y, launch_time, detonation_time in fireworks:
if t < launch_time:
pass
elif t < detonation_time:
x += speed_x * (t - launch_time)
y = speed_y * (t - launch_time)
particles.append((x, y, speed_x, speed_y))
else:
travel_time = t - detonation_time
x += (t - launch_time) * speed_x
y = (t - launch_time) * speed_y - travel_time * (travel_time - 1)
for dx in (-20, 0, 20):
for dy in (-10, 0, 10):
x1 = x + dx * travel_time
y1 = y + dy * travel_time
speed_x_1 = speed_x + dx
speed_y_1 = speed_y + dy - 2 * travel_time
particles.append((x1, y1, speed_x_1, speed_y_1))
rows = [[' '] * 79 for y in xrange(24)]
for x, y, speed_x, speed_y in particles:
x, y = x // 10, y // 10
if 0 <= x < 79 and 0 <= y < 24:
row = rows[23 - y]
if row[x] != ' ': row[x] = 'X'
elif speed_y == 0 or abs(speed_x) // abs(speed_y) > 2: row[x] = '-'
elif speed_x == 0 or abs(speed_y) // abs(speed_x) > 2: row[x] = '|'
elif speed_x * speed_y < 0: row[x] = '\\'
else: row[x] = '/'
print '\n'.join(''.join(row) for row in rows)
If you remove the initial fireworks declaration, compress variable-names to single characters, and whitespace to a minimum, you can get 590 characters.
C:
With all unnecessary whitespace removed (632 bytes excluding the fireworks declaration):
#define N 10
int F[][5]={628,6,6,3,33,586,7,11,11,23,185,-1,17,24,28,189,14,10,50,83,180,7,5,70,77,538,-7,7,70,105,510,-11,19,71,106,220,-9,7,77,100,136,4,14,80,91,337,-13,20,106,128};
#define G F[i]
#define R P[p]
g(x,y){if(y==0||abs(x)/abs(y)>2)return 45;if(x==0||abs(y)/abs(x)>2)return'|';if(x*y<0)return 92;return 47;}main(int A,char**B){int a,b,c,C[24][79]={},d,i,j,p=0,P[N*9][3],Q,t=atoi(B[1]),x,y;for(i=0;i<N;i++){if(t>=G[3]){a=t-G[3];x=G[0]+G[1]*a;y=G[2]*a;if(t<G[4]){R[0]=x;R[1]=y;R[2]=g(G[1],G[2]);p++;}else{b=t-G[4];y-=b*(b-1);for(c=-20;c<=20;c+=20){for(d=-10;d<=10;d+=10){R[0]=x+c*b;R[1]=y+d*b;R[2]=g(G[1]+c,G[2]+d-2*b);p++;}}}}}Q=p;for(p=0;p<Q;p++){x=R[0]/10;y=R[1]/10;if(R[0]>=0&&x<79&&R[1]>=0&&y<24)C[y][x]=C[y][x]?88:R[2];}for(i=23;i>=0;i--){for(j=0;j<79;j++)putchar(C[i][j]?C[i][j]:32);putchar(10);}}
And here's the exact same code with whitespace added for readability:
#define N 10
int F[][5] = {
628, 6, 6, 3, 33,
586, 7, 11, 11, 23,
185, -1, 17, 24, 28,
189, 14, 10, 50, 83,
180, 7, 5, 70, 77,
538, -7, 7, 70, 105,
510, -11, 19, 71, 106,
220, -9, 7, 77, 100,
136, 4, 14, 80, 91,
337, -13, 20, 106, 128
};
#define G F[i]
#define R P[p]
g(x, y) {
if(y == 0 || abs(x)/abs(y) > 2)
return 45;
if(x == 0 || abs(y)/abs(x) > 2)
return '|';
if(x*y < 0)
return 92;
return 47;
}
main(int A, char**B){
int a, b, c, C[24][79] = {}, d, i, j, p = 0, P[N*9][3], Q, t = atoi(B[1]), x, y;
for(i = 0; i < N; i++) {
if(t >= G[3]) {
a = t - G[3];
x = G[0] + G[1]*a;
y = G[2]*a;
if(t < G[4]) {
R[0] = x;
R[1] = y;
R[2] = g(G[1], G[2]);
p++;
} else {
b = t - G[4];
y -= b*(b-1);
for(c = -20; c <= 20; c += 20) {
for(d =- 10; d <= 10; d += 10) {
R[0] = x + c*b;
R[1] = y + d*b;
R[2] = g(G[1] + c, G[2] + d - 2*b);
p++;
}
}
}
}
}
Q = p;
for(p = 0; p < Q; p++) {
x = R[0]/10;
y = R[1]/10;
if(R[0] >= 0 && x < 79 && R[1] >= 0 && y < 24)
C[y][x] = C[y][x] ? 88 : R[2];
}
for(i = 23; i >= 0; i--) {
for(j = 0; j < 79; j++)
putchar(C[i][j] ? C[i][j] : 32);
putchar(10);
}
}
For Python, #MizardX's solution is nice, but clearly not codegolf-optimized -- besides the "don't really count" 333 characters of the prefix, namely:
fireworks = [(628, 6, 6, 3, 33),
(586, 7, 11, 11, 23),
(185, -1, 17, 24, 28),
(189, 14, 10, 50, 83),
(180, 7, 5, 70, 77),
(538, -7, 7, 70, 105),
(510, -11, 19, 71, 106),
(220, -9, 7, 77, 100),
(136, 4, 14, 80, 91),
(337, -13, 20, 106, 128)]
f = fireworks
### int sys argv append abs join f xrange
(the last comment is a helper for a little codegolf-aux script of mine that makes all feasible names 1-char mechanically -- it needs to be told what names NOT to minify;-), the shortest I can make that solution by squeezing whitespace is 592 characters (close enough to the 590 #MizardX claims).
Pulling out all the stops ("refactoring" the code in a codegolf mood), I get, after the prefix (I've used lowercase for single-character names I'm manually introducing or substituting, uppercase for those my codegolf-aux script substituted automatically):
import sys
Z=int(sys.argv[1])
Y=[]
e=Y.extend
for X,W,V,U,T in f:
if Z>=U:
z=Z-U;X+=W*z
if Z<T:e(((X,V*z,W,V),))
else:R=Z-T;e((X+Q*R,z*V-R*(R-1)+P*R,W+Q,V+P-2*R)for Q in(-20,0,20)for P in(-10,0,10))
K=[79*[' ']for S in range(24)]
for X,S,W,V in Y:
X,S=X/10,S/10
if(0<=X<79)&(0<=S<24):
J=K[23-S];v=abs(V);w=abs(W)
J[X]='X'if J[X]!=' 'else'-'if V==0 or w/v>2 else'|'if W==0 or v/w>2 else '\\'if W*V<0 else'/'
print '\n'.join(''.join(J)for J in K)
which measures in at 460 characters -- that's a reduction of 130, i.e. 130/590 = 22%.
Beyond 1-character names and obvious ways to minimize spacing, the key ideas include: single / for division (same as the nicer // for ints in Python 2.*), an if/else expression in lieu of an if/elif/else statement, extend with a genexp rather than a nested loop with append (allows the removal of some spaces and punctuation), not binding to a name subexpressions that occur just once, binding to a name subexpressions that would otherwise get repeated (including the .extend attribute lookup), semicolons rather than newlines where feasible (only if the separate lines would have to be indented, otherwise, counting a newline as 1 character, there is no saving).
Yep, readability suffers a bit, but that's hardly surprising in code golf;-).
Edit: after a lot more tightening, I now have a smaller program (same prefix):
Z=input()
K=[79*[' ']for S in range(24)];a=-10,0,10
def g(X,S,W,V):
X/=10;S/=10
if(0<=X<79)&(0<=S<24):J=K[23-S];v=abs(V);w=abs(W);J[X]=[[['/\\'[W*V<0],'|'][v>2.9*w],'-'][w>2.9*v],'X'][J[X]!=' ']
for X,W,V,U,T in f:
if Z>=U:
z=Z-U;X+=W*z
if Z<T:g(X,V*z,W,V)
else:R=Z-T;[g(X+Q*2*R,z*V-R*(R-1)+P*R,W+Q*2,V+P-2*R)for Q in a for P in a]
print'\n'.join(''.join(J)for J in K)
Still the same output, but now 360 characters -- exactly 100 fewer than my previous solution, which i've left as the first part of this answer (still well above the 320 the OP says he has, though!-).
I've taken advantage of the degree of freedom allowing the input-time value to come from stdin (input is much tighter than importing sys and using sys.argv[1]!-), eliminated the intermediate list (w/the extend calls and a final loop of it) in favor of the new function g which gets called directly and updates K as we go, found and removed some commonality, refactored the nested if/else expression into a complicated (but more concise;-) building and indexing of nested lists, used the fact that v>2.9*w is more concise than w==0 or v/w>2 (and always gives the same result in the range of values that are to be considered).
Edit: making K (the "screen image") into a 1-D list saves a further 26 characters, shrinking the following solution to 334 (still 14 above the OP's, but closing up...!-):
Z=input()
K=list(24*(' '*79+'\n'))
a=-10,0,10
def g(X,S,W,V):
if(0<=X<790)&(0<=S<240):j=80*(23-S/10)+X/10;v=abs(V);w=abs(W);K[j]=[[['/\\'[W*V<0],'|'][v>2.9*w],'-'][w>2.9*v],'X'][K[j]!=' ']
for X,W,V,U,T in f:
if Z>=U:
z=Z-U;X+=W*z
if Z<T:g(X,V*z,W,V)
else:R=Z-T;[g(X+Q*2*R,z*V-R*(R-1)+P*R,W+Q*2,V+P-2*R)for Q in a for P in a]
print ''.join(K),
Done in F# in 957* characters, and it's ugly as sin:
Array of fireworks:
let F = [(628,6,6,3,33);(586,7,11,11,23);(185,-1,17,24,28);(189,14,10,50,83);(180,7,5,70,77);(538,-7,7,70,105);(510,-11,19,71,106);(220,-9,7,77,100);(136,4,14,80,91);(337,-13,20,106,128)]
Remaining code
let M=List.map
let C=List.concat
let P=List.partition
let L t f r=(let s=P(fun(_,_,_,u,_)->not(t=u))f
(fst s, r#(M(fun(x,v,w,_,t)->x,0,v,w,t)(snd s))))
let X d e (x,y,v,w)=C(M(fun(x,y,v,w)->[x,y,v-d,w;x,y,v,w;x,y,v+d,w])[x,y,v,w-e;x,y,v,w;x,y,v,w+e])
let D t r s=(let P=P(fun(_,_,_,_,u)->not(t=u))r
(fst P,s#C(M(fun(x,y,v,w,_)->(X 20 10(x,y,v,w)))(snd P))))
let rec E t l f r s=(
let(a,m)=L t f (M(fun(x,y,v,w,t)->x+v,y+w,v,w,t)r)
let(b,c)=D t m (M(fun(x,y,v,w)->x+v,y+w,v,w-2)s)
if(t=l)then(a,b,c)else E(t+1)l a b c)
let N=printf
let G t=(
let(f,r,s)=E 0 t F [] []
let os=s#(M(fun(x,y,v,w,_)->(x,y,v,w))r)
for y=23 downto 0 do (
for x=0 to 79 do (
let o=List.filter(fun(v,w,_,_)->((v/10)=x)&&((w/10)=y))os
let l=o.Length
if l=0 then N" "
elif l=1 then
let(_,_,x,y)=o.Head
N(
if y=0||abs(x)/abs(y)>2 then"-"
elif x=0||abs(y)/abs(x)>2 then"|"
elif y*x>0 then"/"
else"\\")
elif o.Length>1 then N"X")
N"\n"))
[<EntryPointAttribute>]
let Z a=
G (int(a.[0]))
0
"Pretty" code:
let fxs = [(628,6,6,3,33);(586,7,11,11,23);(185,-1,17,24,28);(189,14,10,50,83);(180,7,5,70,77);(538,-7,7,70,105);(510,-11,19,71,106);(220,-9,7,77,100);(136,4,14,80,91);(337,-13,20,106,128)]
let movs xs =
List.map (fun (x, y, vx, vy) -> (x + vx, y + vy, vx, vy-2)) xs
let movr xs =
List.map (fun (x, y, vx, vy, dt) -> (x + vx, y + vy, vx, vy, dt)) xs
let launch t fs rs =
let split = List.partition(fun (lx, sx, sy, lt, dt) -> not (t = lt)) fs
(fst split, rs # (List.map(fun (lx, sx, sy, lt, dt) -> (lx, 0, sx, sy, dt)) (snd split)))
let split dx dy (x,y,sx,sy) =
List.concat (List.map (fun (x,y,sx,sy)->[(x,y,sx-dx,sy);(x,y,sx,sy);(x,y,sx+dx,sy)]) [(x,y,sx,sy-dy);(x,y,sx,sy);(x,y,sx,sy+dy)])
let detonate t rs ss =
let tmp = List.partition (fun (x, y, sx, sy, dt) -> not (t = dt)) rs
(fst tmp, ss # List.concat (List.map(fun (x, y, sx, sy, dt) -> (split 20 10 (x, y, sx, sy))) (snd tmp)))
let rec simulate t l fs rs ss =
let (nfs, trs) = launch t fs (movr rs)
let (nrs, nss) = detonate t trs (movs ss)
if (t = l) then (nfs,nrs,nss)
else
simulate (t+1) l nfs nrs nss
let screen t =
let (fs, rs, ss) = simulate 0 t fxs [] []
let os = ss # (List.map(fun (x, y, sx, sy,_) -> (x, y, sx, sy)) rs)
for y = 23 downto 0 do
for x = 0 to 79 do
let o = List.filter(fun (px,py,_,_)->((px/10)=x) && ((py/10)=y)) os
if o.Length = 0 then printf " "
elif o.Length = 1 then
let (_,_,sx,sy) = o.Head
printf (
if sy = 0 || abs(sx) / abs(sy) > 2 then "-"
elif sx = 0 || abs(sy) / abs(sx) > 2 then "|"
elif sy * sx > 0 then "/"
else"\\"
)
elif o.Length > 1 then printf "X"
printfn ""
[<EntryPointAttribute>]
let main args =
screen (int(args.[0]))
0
Completely stolenrewritten with new and improved logic. This is as close as I could get to Python. You can see the weakness of F# not being geared toward ad hoc scripting here, where I have to explicitly convert V and W to a float, declare a main function with an ugly attribute to get the command line args, and I have to reference the .NET System.Console.Write to get a pretty output.
Oh well, good exercise to learn a language with.
Here's the new code, at 544 bytes:
let Q p t f=if p then t else f
let K=[|for i in 1..1920->Q(i%80>0)' ''\n'|]
let g(X,S,W,V)=
if(X>=0&&X<790&&S>=0&&S<240)then(
let (j,v,w)=(80*(23-S/10)+X/10,abs(float V),abs(float W))
Array.set K j (Q(K.[j]=' ')(Q(w>2.9*v)'-'(Q(v>2.9*w)'|'(Q(W*V>0)'/''\\')))'X'))
let a=[-10;0;10]
[<EntryPointAttribute>]
let m s=
let Z=int s.[0]
for (X,W,V,U,T) in F do(
if Z>=U then
let z,R=Z-U,Z-T
let x=X+W*z
if(Z<T)then(g(x,V*z,W,V))else(for e in[|for i in a do for j in a->(x+j*2*R,z*V-R*(R-1)+i*R,W+j*2,V+i-2*R)|]do g e))
System.Console.Write K
0
Haskell
import Data.List
f=[(628,6,6,3,33),(586,7,11,11,23),(185,-1,17,24,28),(189,14,10,50,83),(180,7,5,70,77),(538,-7,7,70,105),(510,-11,19,71,106),(220,-9,7,77,100),(136,4,14,80,91),(337,-13,20,106,128)]
c=filter
d=True
e=map
a(_,_,_,t,_)=t
b(_,_,_,_,t)=t
aa(_,y,_,_)=y
ab(x,t,y,_,u)=(x,0,t,y,u)
ac(x,y,t,u,_)=[(x,y,t+20,u+10),(x,y,t,u+10),(x,y,t-20,u+10),(x,y,t+20,u),(x,y,t,u),(x,y,t-20,u),(x,y,t+20,u-10),(x,y,t,u-10),(x,y,t-20,u-10)]
g(x,y,t,u,v)=(x+t,y+u,t,u,v)
h(x,y,t,u)=(x+t,y+u,t,u-2)
i=(1,f,[],[])
j s 0=s
j(t,u,v,w)i=j(t+1,c((/=t).a)u,c((> t).b)x++(e ab.c((==t).a))u,c((>0).aa)(e h w)++(concat.e ac.c((==t).b))x)(i-1)
where x=e g v
k x y
|x==0='|'
|3*abs y<=abs x='-'
|3*abs x<=abs y='|'
|(y<0&&x>0)||(y>0&&x<0)='\\'
|d='/'
l(x,y,t,u,_)=m(x,y,t,u)
m(x,y,t,u)=(div x 10,23-div y 10,k t u)
n(x,y,_)(u,v,_)
|z==EQ=compare x u
|d=z
where z=compare y v
o((x,y,t):(u,v,w):z)
|x==u&&y==v=o((x,y,'X'):z)
|d=(x,y,t):(o((u,v,w):z))
o x=x
q _ y []
|y==23=""
|d='\n':(q 0(y+1)[])
q v u((x,y,z):t)
|u>22=""
|v>78='\n':(q 0(u+1)((x,y,z):t))
|u/=y='\n':(q 0(u+1)((x,y,z):t))
|v/=x=' ':(q(v+1)u((x,y,z):t))
|d = z:(q(v+1)u t)
p(_,_,v,w)=q 0 0((c z.o.sortBy n)((e l v)++(e m w)))
where z(x,y,_)=x>=0&&x<79&&y>=0
r x=do{z <- getChar;(putStr.p)x}
s=e(r.j i)[1..]
main=foldr(>>)(return())s
Not nearly as impressive as MizardX's, coming in at 1068 characters if you remove the f=… declaration, but hell, it was fun. It's been a while since I've had a chance to play with Haskell.
The (slightly) prettier version is also available.
Edit: Ack. Rereading, I don't quite meet the spec.: this version prints a new screen of firework display every time you press a key, and requires ^C to quit; it doesn't take a command line argument and print out the relevant screen.
Perl
Assuming firework data is defined as:
#f = (
[628, 6, 6, 3, 33],
[586, 7, 11, 11, 23],
[185, -1, 17, 24, 28],
[189, 14, 10, 50, 83],
[180, 7, 5, 70, 77],
[538, -7, 7, 70, 105],
[510, -11, 19, 71, 106],
[220, -9, 7, 77, 100],
[136, 4, 14, 80, 91],
[337, -13, 20, 106, 128]
);
$t=shift;
for(#f){
($x,$c,$d,$l,$e)=#$_;
$u=$t-$l;
next if$u<0;
$x+=$c*$u;
$h=$t-$e;
push#p,$t<$e?[$x,$d*$u,$c,$d]:map{$f=$_;map{[$x+$f*$h,($u*$d-$h*($h-1))+$_*$h,$c+$f,$d+$_-2*$h]}(-10,0,10)}(-20,0,20)
}
push#r,[($")x79]for(1..24);
for(#p){
($x,$y,$c,$d)=#$_;
if (0 <= $x && ($x=int$x/10) < 79 && 0 <= $y && ($y=int$y/10) < 24) {
#$_[$x]=#$_[$x]ne$"?'X':!$d||abs int$c/$d>2?'-':!$c||abs int$d/$c>2?'|':$c*$d<0?'\\':'/'for$r[23 - $y]
}
}
$"='';
print$.,map{"#$_\n"}#r
Compressed, it comes in at 433 characters. (see edits for history)
This is based off of pieces of multiple previous answers (mostly MizardX's) and can definitely be improved upon. The guilt of procrastinating other, job-related tasks means i have to give up for now.
Forgive the edit -- pulling out all of the tricks I know, this can be compressed to 356 char:
sub p{
($X,$=,$C,$D)=#_;
if(0<=$X&($X/=10)<79&0<=$=&($=/=10)<24){
#$_[$X]=#$_[$X]ne$"?X:$D&&abs$C/$D<3?$C&&abs$D/$C<3?
$C*$D<0?'\\':'/':'|':'-'for$r[23-$=]
}
}
#r=map[($")x79],1..24;
$t=pop;
for(#f){
($x,$c,$d,$u,$e)=#$_;
$x-=$c*($u-=$t);
$u>0?1:($h=$t-$e)<0
?p$x,-$d*$u,$c,$d
:map{for$g(-10,0,10){p$x+$_*$h,$h*(1-$h+$g)-$u*$d,$c+$_,$d+$g-2*$h}}-20,0,20
}
print#$_,$/for#r
$= is a special Perl variable (along with $%, $-, and $?) that can only take on integer values. Using it eliminates the need to use the int function.
FORTRAN 77
From the prehistoric languages department, here's my entry – in FORTRAN 77.
2570 chars including the initialization, a handful of spaces and some unnecessary whitespace, but I don't think it's likely to win for brevity. Especially since e.g. 6 leading spaces in each line are mandatory.
I called this file fireworks.ftn and compiled it with gfortran on a Linux system.
implicit integer(a-z)
parameter (n=10)
integer fw(5,n) /
+ 628, 6, 6, 3, 33,
+ 586, 7, 11, 11, 23,
+ 185, -1, 17, 24, 28,
+ 189, 14, 10, 50, 83,
+ 180, 7, 5, 70, 77,
+ 538, -7, 7, 70, 105,
+ 510, -11, 19, 71, 106,
+ 220, -9, 7, 77, 100,
+ 136, 4, 14, 80, 91,
+ 337, -13, 20, 106, 128
+ /
integer p(6, 1000) / 6000 * -1 /
character*79 s(0:23)
character z
c Transform input
do 10 r=1,n
p(1, r) = 0
do 10 c=1,5
10 p(c+1, r) = fw(c, r)
c Input end time
read *, t9
c Iterate from 1 to end time
do 62 t=1,t9
do 61 q=1,1000
if (p(1,q) .lt. 0 .or. t .lt. p(5,q)) goto 61
if (p(6,q).gt.0.and.t.gt.p(5,q) .or. t.gt.abs(p(6,q))) then
p(1,q) = p(1,q) + p(4,q)
p(2,q) = p(2,q) + p(3,q)
endif
if (t .lt. abs(p(6,q))) goto 61
if (t .gt. abs(p(6,q))) then
p(4,q) = p(4,q) - 2
elseif (t .eq. p(6,q)) then
c Detonation: Build 9 sparks
do 52 m=-1,1
do 51 k=-1,1
c Find a free entry in p and fill it with a spark
do 40 f=1,1000
if (p(1,f) .lt. 0) then
do 20 j=1,6
20 p(j,f) = p(j,q)
p(3,f) = p(3,q) + 20 * m
p(4,f) = p(4,q) + 10 * k
p(6,f) = -p(6,q)
goto 51
endif
40 continue
51 continue
52 continue
c Delete the original firework
p(1,q) = -1
endif
61 continue
62 continue
c Prepare output
do 70 r=0,23
70 s(r) = ' '
do 80 q=1,1000
if (p(1,q) .lt. 0) goto 80
if (p(5,q) .gt. t9) goto 80
y = p(1,q) / 10
if (y .lt. 0 .or. y .gt. 23) goto 80
x = p(2,q) / 10
if (x .lt. 0 .or. x .gt. 79) goto 80
if (s(y)(x+1:x+1) .ne. ' ') then
z = 'X'
elseif ((p(4,q) .eq. 0) .or. abs(p(3,q) / p(4,q)) .gt. 2) then
z = '-'
elseif ((p(3,q) .eq. 0) .or. abs(p(4,q) / p(3,q)) .gt. 2) then
z = '|'
elseif (sign(1, p(3,q)) .eq. sign(1, p(4,q))) then
z = '/'
else
z = '\'
endif
s(y)(x+1:x+1) = z
80 continue
c Output
do 90 r=23,0,-1
90 print *, s(r)
end
Here's a smaller Haskell implementation. It's 911 characters; minus the fireworks definition, it's 732 characters:
import System
z=789
w=239
r=replicate
i=foldl
main=do{a<-getArgs;p(f[(628,6,6,3,33),(586,7,11,11,23),(185,-1,17,24,28),(189,14,10,50,83),(180,7,5,70,77),(538,-7,7,70,105),(510,-11,19,71,106),(220,-9,7,77,100),(136,4,14,80,91),(337,-13,20,106,128)](read(a!!0)::Int));}
p[]=return()
p(f:g)=do{putStrLn f;p g}
f s t=i(a t)(r 24(r 79' '))s
a t f(x,s,y,l,d)=if t<l then f else if t<d then c f((x+s*u,y*u),(s,y))else i c f(map(v(t-d)(o(d-l)(x,0)(s,y)))[(g s,h y)|g<-[id,(subtract 20),(+20)],h<-[id,(subtract 10),(+10)]])where u=t-l
v 0(x,y)(vx,vy)=((x,y),(vx,vy))
v t(x,y)(vx,vy)=v(t-1)(x+vx,y+vy)(vx,vy-2)
o t(x,y)(vx,vy)=(x+(vx*t),y+(vy*t))
c f((x,y),(vx,vy))=if x<0||x>=z||y<0||y>=w then f else(take m f)++[(take n r)++[if d/=' 'then 'x'else if vy==0||abs(vx`div`vy)>2 then '-'else if vx==0||abs(vy`div`vx)>2 then '|'else if vx*vy>=0 then '/'else '\\']++(drop(n+1)r)]++(drop(m+1)f)where{s=w-y;n=x`div`10;m=s`div`10;r=f!!m;d=r!!n}
Here's the non-compressed version for the curious:
import System
sizeX = 789
sizeY = 239
main = do
args <- getArgs
printFrame (frame fireworks (read (args !! 0) :: Int))
where
fireworks = [
(628, 6, 6, 3, 33),
(586, 7, 11, 11, 23),
(185, -1, 17, 24, 28),
(189, 14, 10, 50, 83),
(180, 7, 5, 70, 77),
(538, -7, 7, 70, 105),
(510, -11, 19, 71, 106),
(220, -9, 7, 77, 100),
(136, 4, 14, 80, 91),
(337, -13, 20, 106, 128)]
printFrame :: [String] -> IO ()
printFrame [] = return ()
printFrame (f:fs) = do
putStrLn f
printFrame fs
frame :: [(Int,Int,Int,Int,Int)] -> Int -> [String]
frame specs time =
foldl (applyFirework time)
(replicate 24 (replicate 79 ' ')) specs
applyFirework :: Int -> [String] -> (Int,Int,Int,Int,Int) -> [String]
applyFirework time frame (x,sx,sy,lt,dt) =
if time < lt then frame
else if time < dt then
drawChar frame
((x + sx * timeSinceLaunch, sy * timeSinceLaunch), (sx,sy))
else
foldl drawChar frame
(
map
(
posVelOverTime (time - dt)
(posOverTime (dt - lt) (x,0) (sx, sy))
)
[
(fx sx, fy sy) |
fx <- [id,(subtract 20),(+20)],
fy <- [id,(subtract 10),(+10)]
]
)
where timeSinceLaunch = time - lt
posVelOverTime :: Int -> (Int,Int) -> (Int,Int) -> ((Int,Int),(Int,Int))
posVelOverTime 0 (x,y) (vx,vy) = ((x,y),(vx,vy))
posVelOverTime time (x,y) (vx,vy) =
posVelOverTime (time - 1) (x+vx, y+vy) (vx, vy - 2)
posOverTime :: Int -> (Int,Int) -> (Int,Int) -> (Int,Int)
posOverTime time (x,y) (vx, vy) = (x + (vx * time), y + (vy * time))
drawChar :: [String] -> ((Int,Int),(Int,Int)) -> [String]
drawChar frame ((x,y),(vx,vy)) =
if x < 0 || x >= sizeX || y < 0 || y >= sizeY then frame
else
(take mappedY frame)
++
[
(take mappedX row)
++
[
if char /= ' ' then 'x'
else if vy == 0 || abs (vx `div` vy) > 2 then '-'
else if vx == 0 || abs (vy `div` vx) > 2 then '|'
else if vx * vy >= 0 then '/'
else '\\'
]
++ (drop (mappedX + 1) row)
]
++ (drop (mappedY + 1) frame)
where
reversedY = sizeY - y
mappedX = x `div` 10
mappedY = reversedY `div` 10
row = frame !! mappedY
char = row !! mappedX
First draft in Tcl8.5 913 bytes excluding fireworks definition:
set F {
628 6 6 3 33
586 7 11 11 23
185 -1 17 24 28
189 14 10 50 83
180 7 5 70 77
538 -7 7 70 105
510 -11 19 71 106
220 -9 7 77 100
136 4 14 80 91
337 -13 20 106 128
}
namespace import tcl::mathop::*
proc # {a args} {interp alias {} $a {} {*}$args}
# : proc
# = set
# D d p
# up upvar 1
# < append out
# _ foreach
# e info exists
# ? if
: P {s d t l} {+ $s [* $d [- $t $l]]}
: > x {= x}
: d {P x X y Y} {up $P p
= x [/ $x 10]
= y [/ $y 10]
= p($x,$y) [? [e p($x,$y)] {> X} elseif {
$Y==0||abs($X)/abs($Y)>2} {> -} elseif {
$X==0||abs($Y)/abs($X)>2} {> |} elseif {
$X*$Y<0} {> \\} {> /}]}
: r {P} {up $P p
= out ""
for {= y 23} {$y >= 0} {incr y -1} {
for {= x 0} {$x < 79} {incr x} {? {[e p($x,$y)]} {< $p($x,$y)} {< " "}}
< "\n"}
puts $out}
: s {F t} {array set p {}
_ {x X Y l d} $F {? {$t >= $l} {? {$t < $d} {= x [P $x $X $t $l]
= y [P 0 $Y $t $l]
D $x $X $y $Y} {= x [P $x $X $d $l]
= y [P 0 $Y $d $l]
= v [- $t $d]
_ dx {-20 0 20} {_ dy {-10 0 10} {= A [+ $X $dx]
= B [- [+ $Y $dy] [* 2 $v]]
= xx [P $x $A $v 0]
= yy [P $y $B $v 0]
D $xx $A $yy $B}}}}}
r p}
s $F [lindex $argv 0]
Optimized to the point of unreadability. Still looking for room to improve. Most of the compression basically uses command aliasing substituting single characters for command names. For example, function definitions are done using Forth-like : syntax.
Here's the uncompressed version:
namespace import tcl::mathop::*
set fireworks {
628 6 6 3 33
586 7 11 11 23
185 -1 17 24 28
189 14 10 50 83
180 7 5 70 77
538 -7 7 70 105
510 -11 19 71 106
220 -9 7 77 100
136 4 14 80 91
337 -13 20 106 128
}
proc position {start speed time launch} {
+ $start [* $speed [- $time $launch]]
}
proc give {x} {return $x}
proc draw {particles x speedX y speedY} {
upvar 1 $particles p
set x [/ $x 10]
set y [/ $y 10]
set p($x,$y) [if [info exists p($x,$y)] {
give X
} elseif {$speedY == 0 || abs(double($speedX))/abs($speedY) > 2} {
give -
} elseif {$speedX == 0 || abs(double($speedY))/abs($speedX) > 2} {
give |
} elseif {$speedX * $speedY < 0} {
give \\
} else {
give /
}
]
}
proc render {particles} {
upvar 1 $particles p
set out ""
for {set y 23} {$y >= 0} {incr y -1} {
for {set x 0} {$x < 79} {incr x} {
if {[info exists p($x,$y)]} {
append out $p($x,$y)
} else {
append out " "
}
}
append out "\n"
}
puts $out
}
proc show {fireworks time} {
array set particles {}
foreach {x speedX speedY launch detonate} $fireworks {
if {$time >= $launch} {
if {$time < $detonate} {
set x [position $x $speedX $time $launch]
set y [position 0 $speedY $time $launch]
draw particles $x $speedX $y $speedY
} else {
set x [position $x $speedX $detonate $launch]
set y [position 0 $speedY $detonate $launch]
set travel [- $time $detonate]
foreach dx {-20 0 20} {
foreach dy {-10 0 10} {
set speedXX [+ $speedX $dx]
set speedYY [- [+ $speedY $dy] [* 2 $travel]]
set xx [position $x $speedXX $travel 0]
set yy [position $y $speedYY $travel 0]
draw particles $xx $speedXX $yy $speedYY
}
}
}
}
}
render particles
}
show $fireworks [lindex $argv 0]
First Post hahaha
http://zipts.com/position.php?s=0
not my final submission but could not resist
Btw: Characters 937 not counting spaces (do we count spaces? )
My answer is at http://www.starenterprise.se/fireworks.html
all done in javascript.
and no I didn't bother to make it ashortap, I just wanted to see if I could.
Clojure
Unindented, without input output and unnecessary whitespace, it comes to 640 characters - exactly double the best value :( Thus, I'm not providing a "blank optimized" version in an attempt to win at brevity.
(def fw [
[628 6 6 3 33]
[586 7 11 11 23]
[185 -1 17 24 28]
[189 14 10 50 83]
[180 7 5 70 77]
[538 -7 7 70 105]
[510 -11 19 71 106]
[220 -9 7 77 100]
[136 4 14 80 91]
[337 -13 20 106 128]
])
(defn rr [x y u v dt g] (if (<= dt 0) [x y u v] (recur (+ x u) (+ y v) u (+ v g) (dec dt) g)))
(defn pp [t f]
(let [y 0 [x u v a d] f r1 (rr x y u v (- (min t d) a) 0)]
(if (< t a)
'()
(if (< t d)
(list r1)
(for [m '(-20 0 20) n '(-10 0 10)]
(let [[x y u v] r1]
(rr x y (+ u m) (+ v n) (- t d) -2)))))))
(defn at [x y t]
(filter #(and (= x (quot (first %) 10)) (= y (quot (second %) 10))) (apply concat (map #(pp t %) fw))))
(defn g [h]
(if (empty? h) \space
(if (next h) \X
(let [[x y u v] (first h)]
(cond
(or (zero? v) (> (* (/ u v) (/ u v)) 4)) \-
(or (zero? u) (> (* (/ v u) (/ v u)) 4)) \|
(= (neg? u) (neg? v)) \/
:else \\
)))))
(defn q [t]
(doseq [r (range 23 -1 -1)]
(doseq [c (range 0 80)]
(print (g (at c r t))))
(println)))
(q 93)