Since my former attempt at proposing a Golf was a
dismal failure, for a refereshing change, how about something
that isn't NP-Complete?
This particular function, as with any Perl Golf, should allow for suitable
creative expression. TMTOWTDI as always.
The Goal
Create a function which when given a numeric string, returns
a multi-line string which is the equivalent 7-segment display
output, as one might find on a cash register or digital watch.
No external modules should be used. No requirement for
compatibility with 'strict' or '-w', but the function must
operate properly if called more than one time from within
the same program.
An example is:
print f("19.2");
Which would display:
X XXXX XXXX
X X X X
X X X X
X XXXX XXXX
X X X
X X X
X X X XXXX
Any combination of the characters 0-9, '-', or '.' are valid.
Any other characters are ignored. 7 lines of text are always
returned by the function, though these lines may be blank if
no input was provided that was valid.
For reference, here is the complete character set, a 5x7
bitmap, with a ruler provided for reference purposes only:
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
| XXXX X XXXX XXXX X X XXXX XXXX XXXX XXXX XXXX
| X X X X X X X X X X X X X X
| X X X X X X X X X X X X X X
| X X X XXXX XXXX XXXX XXXX XXXX X XXXX XXXX XXXX
| X X X X X X X X X X X X X
| X X X X X X X X X X X X X
| XXXX X XXXX XXXX X XXXX XXXX X XXXX XXXX X
Sample Code
My first take, a straight up approach, which
is 272 characters without line breaks required
here for readability.
sub f{
my@c=qw[00700 00001 00000 75557 11111 71747
71717 55711 74717 74757 71111 75757 75717];
my@l,$i;map{$l[$i++%5].=join'',(unpack("B8"
,chr)=~/(.)(.)(.)$/)[0,1,1,2],' '}map{split
//,$c[ord($_)-45]}grep{/[0-9\.\-]/}split//,
pop;$_=join'',map{"$_\n"}@l[0,1,1,2,3,3,4];
tr/01/ X/;$_
}
As you can see, there is substantial room for improvement.
Re: (Golf) LED Sign
by srawls (Friar) on Jun 08, 2001 at 05:59 UTC
|
Well, I sure wish I could beat that by my own code, but I couldn't even come close. I can improve on yours though. First of all: in a golf, you needn't use my and pre-declare variables. Second, I don't understand the need for this statement:
$_=join'',map{"$_\n"}@l[0,1,1,2,3,3,4];
Why not just use this
$_=join$/,@l[0,1,1,2,3,3,4];
Well, here's your improved code, it checks in at 223 chars:
sub f{
@c=qw[00700 00001 00000 75557 11111 71747
71717 55711 74717 74757 71111 75757 75717];
map{$l[$i++%5].=join'',(unpack("B8",chr)=~/(...)$/)[0,1,1,2],$"}
map{split//,$c[ord($_)-45]}split//,pop;
$_=join$/,@l[0,1,1..4];
tr/01/ X/;$_
}
The 15 year old, freshman programmer,
Stephen Rawls | [reply] [Watch: Dir/Any] [d/l] [select] |
|
To clarify: In one case, you have something which is, to abbreviate,
XnXnXnXn versus XnXnXnX, where the former has a newline
at the end, and the second does not. It's a minor thing,
I know, and mostly cosmetic.
As a result, it doesn't wrap the last line around, leaving
something like:
shell% perl srawls
X XXX XXX XXX
X X X X X X
X X X X X X
X XXX XXX X X
X X X X X
X XXX XXX XXX shell%
I like your art deco twist on the "font". Very retro. | [reply] [Watch: Dir/Any] [d/l] |
|
As a result, it doesn't wrap the last line around, leaving something like:
...
X XXX XXX XXX shell%
Configure your shell prompt to be "X", and you get free punctuation.
| [reply] [Watch: Dir/Any] [d/l] |
|
As a result, it doesn't wrap the last line around, leaving something like:
Yep, it's a golf, so I was trying to shave off as many chars as possible; good observation though.
I like your art deco twist on the "font". Very retro.
Funny you mention that, It happened completely by accident, when I was trying to shorten the code : )
The 15 year old, freshman programmer,
Stephen Rawls
| [reply] [Watch: Dir/Any] |
|
|
  As a result, it doesn't wrap the last line around...
$_=join$/,@l[0,1,1..4],'';
fixes that.
  p
| [reply] [Watch: Dir/Any] [d/l] |
(tye)Re: 186- (Golf) LED Sign
by tye (Sage) on Jun 08, 2001 at 11:42 UTC
|
#!/usr/bin/perl
open SEG, ">segment.pl" or die "Can't write seg.pl: $!\n";
binmode SEG;
while(<DATA>){
s/::::::::/pack"H*",'1f10001100100111'/e;
s/!!!!!!!!!!!!!!!/pack"H*",'fca88a04228f12420caacc30125084'/e;
print SEG $_;
}
__END__
#!/usr/bin/perl
sub d{
y/01/ #/for@p=unpack"b5"x8,"::::::::";
y/-./ab/for@n=split//,pop;
@s=grep$_,split/(..)/,unpack"b*",'!!!!!!!!!!!!!!!';
map{$l=$_;join" ",map($p[$l<<2&4|3&$s[$l+5*hex$_]],@n),$/}
0,1,1,2,3,3,4
}
print d("123-45");
print d("67.890");
So if you download this code into a file called, for example,
"seg1.pl", then you could do the following:
$ perl seg1.pl
$ perl segment.pl
# ##### ##### # # #####
# # # # # #
# # # # # #
# ##### ##### ##### ##### #####
# # # # #
# # # # #
# ##### ##### # #####
##### ##### ##### ##### #####
# # # # # # # #
# # # # # # # #
##### # ##### ##### # #
# # # # # # # #
# # # # # # # #
##### # # ##### ##### #####
$
The reason for the extra step is that I have two binary strings as part of my subroutine.
I suspect the sub can be golfed quite a bit still... Have fun. (:
-
tye
(but my friends call me "Tye") | [reply] [Watch: Dir/Any] [d/l] |
|
I figured out a way to drop the 8-char binary string
to a 5-char binary string and simplify some of the
math. Unfortunately, the simpler math uses + instead
of | so the precedence is wrong so I'd need two sets
of parens, which makes the math expression 2 characters
longer (despite the calculation being simpler). That
would still be an over-all net reduction by
one character. But that involves recomputing all of
the bits, so I'm not including that trick.
But some standard golfing on the rest did get me down to
177 (updated from 179) chars:
#!/usr/bin/perl
open SEG, ">segment.pl" or die "Can't write seg.pl: $!\n";
binmode SEG;
while(<DATA>){
s/::::::::/pack"H*",'1f10001100100111'/e;
s/!!!!!!!!!!!!!!!/pack"H*",'fca88a04228f12420caacc30125084'/e;
print SEG $_;
}
__END__
#!/usr/bin/perl
sub d{
y/01/ #/for@p=unpack"b5"x8,"::::::::";@s=grep$_,split/(..)/,
unpack"b*",'!!!!!!!!!!!!!!!';map{$l=$_;join($",map{y/-./ab/;
$p[4&$l*4|3&$s[$l+5*hex]]}split//,$_[0]).$/}0,1,1,2,3,3,4
}
print d("123-45");
print d("67.890");
-
tye
(but my friends call me "Tye") | [reply] [Watch: Dir/Any] [d/l] |
Ah, but what about correct display of the decimal point?
by mugwumpjism (Hermit) on Jun 08, 2001 at 19:35 UTC
|
Whilst my answer is longer, I think you will find it simulates a 7 segment display a little closer, and it has a larger, more readable font.
This one weighs in at 299 characters, excluding line breaks.
sub f{
$i=$_[0];$i=~s/(\d)\./$1|'@'/eg;@c=split//,"\brew\$]m.k{%\177o";
for$a(0..8){for$l(split//,$i){$x=ord$c[ord($l&"?")-45];print do{
if($a%4){$q=($x>>($a>4)*3)&6;($q&2?"|":" ")." ".($q&4?"|":" ")
." ";}else{($x>>($a>>2)*3&1?" ----- ":" "x7).
($a==8&&(($l&"@")eq"@")?" X ":" ");}}}print"\n";}}
f(-123.04);
f(56789);
And the output is:
----- -----
| | | | |
| | | | |
| | | | |
----- ----- ----- -----
| | | |
| | | |
| | | |
----- ----- X
----- ----- ----- ----- ----- -----
| | | | | | | | |
| | | | | | | | |
| | | | | | | | |
----- ----- ----- -----
| | | | | | | | |
| | | | | | | | |
| | | | | | | | |
----- ----- ----- ----- -----
Not bad for a first golf attempt? :-) | [reply] [Watch: Dir/Any] [d/l] |
|
I really really like it! VERY NEAT! That's not much code for a VERY cool output.
| [reply] [Watch: Dir/Any] |
Re: (Golf) LED Sign
by petral (Curate) on Jun 10, 2001 at 05:49 UTC
|
sub led{
($b=pop)=~y/0-9.\-\0-~/\0-\cK/d;
join$/,
map{join$",
($"x4,'X ',' X','X X','X'x4)[(/./g)[unpack'C*',$b]]
}424434444400,
(322231123300)x2,
324444424404,
(321222323200)x2,
(424x4)-4,""
}
print led @ARGV ? shift : "19QQ86\t-- \@0134.72x-0(?)";
(Using hex conversion for the string (and to delete unwanted characters! ) and an array slice of an array slice to generate the lines.)
(Change the trailing ' ~ ' to a ' ÿ '(" ÿaut "?) to reject 8-bit chars too -- I wasn't sure how it would travel inside code tags.)
update:  or 172 chars w/o argument checking and putting the '-' first:($b=pop)=~y/-0-9./\0-\cK/;join$/,
map{join$",('X ',$"x4,' X','X X','X'x4)[(/./g)[unpack'C*',$b]]}
142443444441,(132223002331)x2,432444442441,(132022232321)x2,1 .424x4
,""
  p
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
The conversion to low-ASCII for index uses was something that
I had considered while writing my first take. I would've used
ord instead of unpack. However, using unpack to double
as both ord and split is truly devious.
| [reply] [Watch: Dir/Any] |
|
|