Twenty years ago, during my first year in academia, my Pascal tutor set us some top-notch assignments.
Your mission:
Write a program which draws a diamond of the form illustrated below. The letter which is to appear at the widest point of the figure (E in the example) is to be specified as input data.
Here’s a scan of the original hand-out:
My original Pascal solution, which I prototyped using BBC Basic V, took less than a page of fan-fold listing paper and was implemented as a console application. 50% of the listing dealt with input validation and “do you want to run the program again?” code! I will convert the example line-by-line into C# for later publication here! Of course, were I to write it today, it should look very different!
I’d be keen to see your solutions, written in your choice of programming language. Novelty value for uniqueness in your choice of programming language may well be rewarded! Procedural, object-oriented, functional, dynamic, verbose, terse…the choice is yours!
“What’s in it for me?” you might ask?
Well, nothing really, a bit of kudos and the feeling of a job well done! However, I will offer the two best/novel UK-based solutions a much-coveted DDD polo shirt (modelled here!). My decision is final, colour may vary, size might not be the same size as you, yada yada, other legalese applies, etc.
Submission by comments here on this post, by e-mail (top right About Me), or via Twitter @camurphy please!
Over to you!
UPDATE: Comments seem to mangle the code formatting, it has been suggested that code is submitted either via e-mail or via http://pastebin.com/
RSS 2.0
3:37 pm on April 13th, 2009 1
This is what I came up with… sure there must be a more elegant way!
static void Main(string[] args)
{
char c = Console.ReadKey().KeyChar;
Console.WriteLine();
const int numberOfRows = 5;
int rowNumber = 0;
List rows = new List();
int numberOfColumns = (numberOfRows * 2) – 1;
while (rowNumber Console.WriteLine(x));
rows.Reverse();
rows.RemoveAt(0); //we only want one “middle” row
rows.ForEach(x => Console.WriteLine(x));
}
3:41 pm on April 13th, 2009 2
Doh! Html cleaner mangled my code. Here tis:
http://pastebin.com/f46f98432
3:54 pm on April 13th, 2009 3
@mike – good solution; however I should perhaps have made it clear in the “spec” that the diamond must start at ‘A’ and roll on to the letter entered, i.e. it’s not limited to 5 rows!
4:26 pm on April 13th, 2009 4
Ahh I see! Well replacing the line
const int numberOfRows = 5;
with
int numberOfRows = (int)c – (int)’A’ + 1;
should sort that…
12:36 pm on April 14th, 2009 5
Something like this?
class Program
{
private const string alphabet = “abcdefghijklmnopqrstuvwxyz”;
static void Main(string[] args)
{
char c = Console.ReadKey().KeyChar;
var myChars = from character in alphabet
where character <= c
select character;
var fullRow = myChars.Skip(1).Reverse().Concat(myChars);
var myRows = (from character in myChars
select ConvertToSpaces(character, fullRow));
IEnumerable reverseRows = myRows.Reverse().Skip(1);
myRows = myRows.Concat(reverseRows);
Console.WriteLine(Environment.NewLine);//Skip the ReadKey line
foreach (string line in myRows)
Console.WriteLine(line);
Console.ReadKey();
}
private static string ConvertToSpaces(char wanted, IEnumerable characters)
{
return new string(
(from character in characters
select character == wanted ? character : ‘ ‘).ToArray());
}
}
1:15 pm on April 14th, 2009 6
Here is your T-SQL version, not a proper DB optimised version, most definitely a programmer wrangling T-SQL to his will. Works though.
—– —– —– —– —– —– —– —– —–
– Test on SQL Server 2000 using SQL 2005 Management Studio
DECLARE @OutmostChar AS CHAR(1)
SET @OutmostChar = ‘Z’
DECLARE @Result VARCHAR(2100)
SET @Result = ”
DECLARE @OutmostCharAscii INT
SET @OutmostCharAscii = ASCII(@OutmostChar)
IF (@OutmostCharAscii ASCII(‘Z’))
BEGIN
RAISERROR (N’Outmost character must be in range A-Z’, 10, 1);
END
DECLARE @NumberOfRowsToMiddle INT
SET @NumberOfRowsToMiddle = @OutmostCharAscii – ASCII(‘A’);
DECLARE @LoopVar INT
SET @LoopVar = 0
WHILE @LoopVar 0)
BEGIN
SET @Result = @Result + SPACE((@LoopVar * 2) – 1) +
CHAR(ASCII(‘A’) + @LoopVar)
END
SET @Result = @Result + CHAR(13) + CHAR(10)
SET @LoopVar = @LoopVar + 1
END
SET @LoopVar = @NumberOfRowsToMiddle
WHILE @LoopVar >= 0
BEGIN
SET @Result = @Result + SPACE(@NumberOfRowsToMiddle – @LoopVar) +
CHAR(ASCII(‘A’) + @LoopVar)
IF (@LoopVar > 0)
BEGIN
SET @Result = @Result + SPACE((@LoopVar * 2) – 1) +
CHAR(ASCII(‘A’) + @LoopVar)
END
SET @Result = @Result + CHAR(13) + CHAR(10)
SET @LoopVar = @LoopVar – 1
END
SELECT @Result
– In Results pane, right click single result and select “Save Results As ..” to save as CSV file to view in Notepad
1:24 pm on April 14th, 2009 7
And here is your T-SQL version with a link to the T-SQL code so it isn’t altered by Mr Murphy’s blogging engine.
Again, it’s not a proper DB optimised version, most definitely a programmer wrangling T-SQL to his will. Works though.
—– —– —– —– —– —– —– —– —–
http://www.tigernews.co.uk/blog-twickers/TSql-Diamond.txt
2:49 pm on April 14th, 2009 8
Since you requested it via twitter, here’s a LINQ sample. I cheated on the top and bottom lines with the ALine variable. Also, the For Each enumerations would be simplified in VB 10 using Statement Lambdas which are not available in VB 9 yet. I didn’t include validation on the input (but that would be trivial with a regular expression).
Sub Main()
Console.WriteLine(“Input the hightest letter to display. Leave blank to exit.”)
Dim HighestLetter = Console.ReadKey
If HighestLetter.Key = ConsoleKey.Enter Then Exit Sub
Dim ascLetter = Asc(HighestLetter.KeyChar)
Console.WriteLine()
Dim ALine = New String(” “c, ascLetter – 65) & “A”
Dim lines = (From c In Enumerable.Range(66, ascLetter – 65) _
Select line = New String(” “c, ascLetter – c) & Chr(c) & New String(” “c, (c – 66) * 2 + 1) & Chr(c), _
currentChar = c).ToArray
Console.WriteLine(ALine)
For Each line In lines
Console.WriteLine(line.line)
Next
For Each line In lines.OrderByDescending(Function(l) l.currentChar).Skip(1)
Console.WriteLine(line.line)
Next
Console.WriteLine(ALine)
Main() ‘ Loop for more tries
End Sub
3:44 pm on April 14th, 2009 9
I have the permission of one of the lads in work to post this.
Tom Vanhoutte he did it in about 20 minutes.
Dim res()
IDList=”ABCDEFGHIJKLMNOP”
Index1= Instr(IDList,”F”)
For i=1 to (Index1*2)-1
ReDim res(60)
res2=”"
pleft = Abs(i-Index1)
Spaces=(Index1-(pleft+1))
pChar= mid(IDList,abs(Spaces)+1,1)
res(pleft)=pchar
res(pleft+(spaces*2))=pchar
for j=0 to 60
if IsEmpty(res(j)) then res(j)=” ”
res2=res2 & res(j)
next
rs=rs& res2 & vbcrlf
next
msgbox rs
4:20 pm on April 14th, 2009 10
Here’s mine – I cheated slightly because I left in the double AA at the top and the bottom but I prefer it that way, it feels more balanced!
ConsoleKeyInfo key = Console.ReadKey();
Console.Clear();
var query =
from i in Enumerable.Range(0, ((key.KeyChar – ‘A’) * 2) + 1)
let characterRange = key.KeyChar – ‘A’
let distanceFromMiddle = Math.Abs(characterRange – i)
let distanceFromEitherEnd = Math.Abs(characterRange – distanceFromMiddle)
let character = (char)(‘A’ + distanceFromEitherEnd)
select new string(‘ ‘, distanceFromMiddle) + character + new string(‘ ‘, distanceFromEitherEnd * 2) + character;
foreach (var item in query)
{
Console.WriteLine(item);
}
5:08 pm on April 14th, 2009 11
C’mon Mr Taulty there is no excuses for cheating – even slightly… This “bug” fix might help you!
ConsoleKeyInfo key = Console.ReadKey();
Console.Clear();
var query =
from i in Enumerable.Range(0, ((key.KeyChar – ‘A’) * 2) + 1)
let characterRange = key.KeyChar – ‘A’
let distanceFromMiddle = Math.Abs(characterRange – i)
let distanceFromEitherEnd = Math.Abs(characterRange – distanceFromMiddle)
let character = (char)(‘A’ + distanceFromEitherEnd)
select new string(‘ ‘, distanceFromMiddle) + character + (distanceFromEitherEnd == 0 ? String.Empty : new string(‘ ‘, (distanceFromEitherEnd * 2) – 1) + character);
foreach (var item in query)
{
Console.WriteLine(item);
}
5:46 pm on April 14th, 2009 12
This is F#. Well, one way of doing it in F#
No, I didn’t choose to do it that way because it’s the easiest to understand.
#light
open System
let endchar = Char.ToUpper (Console.ReadKey(true).KeyChar)
let rec lines c bs ms = seq {
let ss n = new String(‘ ‘, n)
let ts c = string(char(c))
let s = (ss bs) + (ts c) + (if ms = 0 then “” else (ss ms) + (ts c)) + (ss bs)
yield s
if bs > 0 then
yield! (lines (c + 1) (bs – 1)
(if ms = 0 then 1 else ms + 2))
yield s
}
Seq.iter (fun (l:string) -> Console.WriteLine(l))
(lines (int(‘A’)) (int(endchar) – int(‘A’)) 0)
5:49 pm on April 14th, 2009 13
Hm… in F#, indentation does in fact matter. Let me see if the comments can contain HTML here, maybe that will correct the formatting:
#light
open System
let endchar = Char.ToUpper (Console.ReadKey(true).KeyChar)
let rec lines c bs ms = seq {
let ss n = new String(‘ ‘, n)
let ts c = string(char(c))
let s = (ss bs) + (ts c) + (if ms = 0 then "" else (ss ms) + (ts c)) + (ss bs)
yield s
if bs > 0 then
yield! (lines (c + 1) (bs – 1)
(if ms = 0 then 1 else ms + 2))
yield s
}
Seq.iter (fun (l:string) -> Console.WriteLine(l))
(lines (int(‘A’)) (int(endchar) – int(‘A’)) 0)
8:20 am on April 15th, 2009 14
[...] Programming Challenge! – Craig Murphy digs out a 20 year old programming problem from his past, and asks for solutions from his readers in a range of languages. A prize is being offered for the one Craig deems to be the best [...]
1:46 pm on April 15th, 2009 15
Here’s a solution in Smalltalk…
“GS – Assume chars will be ASCII uppercase only”
startNum := 65.
“GS – Set the Character to print up to”
aChar := $E.
“GS – Set the stop number”
stopNum := aChar asUppercase asInteger.
“GS – Fill a collection with arrays representing the lines in half of the diamond”
totalChars := stopNum – startNum.
ctr := 0.
chars := OrderedCollection new.
startNum to: stopNum do: [ : i |
chars addLast:
(Array
"GS - Spaces from the left edge"
with: (totalChars - ctr)
"GS - The char to print"
with: (i asCharacter asUppercase)
"GS - The space between the two printed chars"
with: ((ctr * 2) -1)).
ctr := ctr + 1.
].
“GS – Clear the Transcript window”
Transcript clear.
“GS – Print the top half of the diamond”
chars do: [ : a |
(a at: 1)
timesRepeat:[Transcript show: Character space ].
Transcript show: (a at: 2).
((a at: 3) == -1)
ifTrue:[Transcript cr.]
ifFalse:[
(a at: 3)
timesRepeat:[Transcript show: Character space. ].
Transcript show: (a at: 2); cr.
].
].
“GS – Print the bottom half of the diamond”
ctr := 0.
chars reverseDo: [ : a |
(ctr == 0)
ifFalse:[
(a at: 1)
timesRepeat:[Transcript show: Character space ].
Transcript show: (a at: 2).
((a at: 3) == -1)
ifTrue:[Transcript cr.]
ifFalse:[
(a at: 3)
timesRepeat:[Transcript show: Character space. ].
Transcript show: (a at: 2); cr.
].
].
ctr := ctr + 1.
].
1:51 pm on April 15th, 2009 16
OMG! That formatting is horrible!!!!
2:10 pm on April 15th, 2009 17
Solution in PERL: (not the most elegant way of doing it I’m sure, but it works!)
http://pastebin.com/f459f32ce
print “Input your character: ” . “\r\n”;
$c = getc(STDIN);
$NumberOfRows = ord($c) – ord(“A”);
$rowNumber = 0;
$NumberOfColumns = ($NumberOfRows*2) -1;
$rowNumber = 0;
$bool=0;
$multiple = 1;
while ($rowNumber <= $NumberOfRows*2)
{
if ($rowNumber == $NumberOfRows+1)
{
$bool = 1;
$multiple = -1;
}
$char = chr(ord($c) + ((-$NumberOfRows + $rowNumber) * $multiple));
print ” ” x (($NumberOfRows – $rowNumber)*$multiple) . $char;
if ($char gt “A”){print ” ” x ((($NumberOfRows*4*$bool) + ($rowNumber*2*$multiple))-1). $char;}
print “\r\n”;
$rowNumber++;
}
2:27 pm on April 15th, 2009 18
Bloody hell, that solution sucks, look at the size of it!!! Hmm, the Smalltalk is really rusty. I’ll be back with a better solution later
2:37 pm on April 15th, 2009 19
Eep even some duplicate code in my example ($rowNumber is THAT important that I reset it twice…)
I tried a version in LOLCODE but the lack of multiplication and conversion from char to int means some nasty code would be required and I don’t have the time
2:44 pm on April 15th, 2009 20
Just a thought but doesn’t Craig used the “Google Syntax Highlighter for WordPress” plugin, which should also work for comments? Although as it probably doesn’t support most of these languages, maybe simply wrapping code in pre tags would be a simpler solution?
3:58 pm on April 15th, 2009 21
Here it is in PowerShell…
Param([char]$letter = “E”, [int]$padding=5)
$start = [int][char]“B”
$end = [int]$letter
$outerpadding = ($end – $start) + $padding
$innerpadding = -1
$lines = }
$lines
$lines[$($lines.Length-2)..0]
4:02 pm on April 15th, 2009 22
Ooh, nice, it ate my whole scriptblock looking for an ; Guess doesn’t work. Let’s try that again, shall we? If it’s still horrible, look here http://poshcode.org/1029
$start = [int][char]“B”
$end = [int]$letter
$outerpadding = ($end – $start) + $padding
$innerpadding = -1
# this line ends with an ampersand followed by a {
$lines = &{
“$(” ” * $outerpadding)A”
foreach($char in ([string[]][char[]]($start..$end))) {
$innerpadding += 2; $outerpadding–
“$(” ” * $outerpadding)$char$(” ” * $innerpadding)$char”
}
}
$lines
$lines[$($lines.Length-2)..0]
4:31 pm on April 15th, 2009 23
How about a single Excel formula? (tested in Excel 2007 and OpenOffice Calc 3.0)
To create this solution,
1) Create a new workbook in Excel.
2) Format Columns A to AZ to 2.5 wide.
3) Cell A1 should contain letter A-Z.
4) Copy following formula to all cells in range Row 2 to Row 52, columns B to AZ,
=IF(ROW() – CODE($A$1) + CODE(“A”) – 2 <=0, IF(ABS(COLUMN()-27)+2 = ROW(), CHAR(CODE(“A”) + ABS(COLUMN() – 27)), “”), IF((((CODE($A$1) – CODE(“A”)) * 2) + 2) – ROW() = ABS(COLUMN() – 27), CHAR(CODE(“A”) + ABS(COLUMN() – 27)), “”))
Or just download the spreadsheet as a ZIP from here;
http://www.tigernews.co.uk/blog-twickers/Excel-Diamond.zip
5:43 pm on April 15th, 2009 24
Here’s another perl one, hehe… pass in the final letter, lower-case, on the command line.
#!/usr/bin/perl
$e=ord($ARGV[0]);
$d=$e-ord(“a”);
$_=” ” x $d . “a” . ” ” x $d;$\=”\n”;
sub i { return chr(ord($_[0])+1); }
while($e) {
print;push(@l,$_);
s/( )([a-z])( +)(\2)( )/i($2) . $3 . ” ” . i($2)/e;s/ a /b b/;$e=/^ /;
}
print;
while($_=pop(@l)){print;}
5:45 pm on April 15th, 2009 25
I feel like a sick bastard having posted that Perl solution.
6:00 pm on April 15th, 2009 26
So, here’s hoping the formatting is going to work… if not, please find the well formatted piece of code that this should be at this URL: http://www.sturmnet.org/download/diamond.pl.html
This is the same Perl program as before, but I thought I’d do the occasion justice and make it look nice, too. Yes, it still works!
#!/usr/bin/perl
$e=
ord ($ARGV
[0]); $d=$e-
ord( “a”);
$_=” ” x $d
. “a” . ” ”
x $d; $\=”\n”
;sub i {return
chr( ord(
$_[0] )+1);
}while ($e){
print ;push
(@l, $_);
s/( )([a-z])( +)(\2)( )/i($2) . $3 . ” ” . i($2)/e;
s/ a /b b/;$e=/^ /;}print;while($_=pop(@l)){print;}
6:01 pm on April 15th, 2009 27
Okay, shite. That is very interesting as well, but not what was intended. Follow the link for what it should be like!
7:05 pm on April 15th, 2009 28
Okay so I’ve thought about my Smalltalk code a bit and here’s an improvement. There’s no recursion in Smalltalk but you can fake it with closures. So my improved Smalltalk example goes like this…
| chars aBlock ctr |
aBlock := [ :charToPrint :spacesFromEdge : spacesBetweenChars :printCharTwice |
spacesFromEdge timesRepeat: [Transcript show: Character space ].
Transcript show: charToPrint.
printCharTwice ifTrue: [
spacesBetweenChars timesRepeat: [Transcript show: Character space ].
Transcript show: charToPrint.
].
Transcript cr.
].
Transcript clear.
chars := #($A $B $C $D $E).
ctr := 0.
chars do: [: char |
aBlock value: char value: (chars size) - ctr value: ((ctr * 2)-1) value: (char ~= $A).
ctr := ctr +1.
].
ctr := ctr – 2.
chars reverseDo: [:char |
(char ~= $E) ifTrue:[
aBlock value: char value: (chars size) - ctr value: ((ctr * 2)-1) value: (char ~= $A).
ctr := ctr - 1].
]
7:20 pm on April 15th, 2009 29
Since we have a few very elaborate submissions here I thought I’d just hop off the verbosity (ie. readability) bandwagon and provide an obfuscated solution in the general purpose language Python:
a=”ABCDEFGHIJKLMNOPQRSTUVWXYZ”;b=lambda c=[]:[c.append(raw_input("Which letter? ")),c[-1]if c[-1].isalpha()and len(c[-1])==1 else b()][1].upper();b=a.index(b());a=[b*" "+"A"]+[(b-i)*" "+a[i]+(i*2-1)*” “+a[i] for i in range(1,b+1)];print “\n”.join(a+list(reversed(a))[1:])
Lord forgive me..
8:56 pm on April 15th, 2009 30
Robert – at least when He forgives you, he’ll also forgive me for the Perl version
Anyway, here’s another one, this time in Haskell. Indentation is important in reality, but readability shouldn’t suffer too much. And yes, I went for readability this time!
import Char
calcLine :: Int -> Int -> Int -> Int -> String
calcLine ch col line maxp =
let tch = if maxp – line == col then [chr ch] else “.” in
if col == maxp
then tch
else tch ++ (calcLine ch (col+1) line maxp) ++ tch
calcLines :: Int -> Int -> String
calcLines line maxp =
let ch = (ord ‘A’) + line in
let l = (calcLine ch 0 line maxp) ++ “\n” in
if line == maxp
then l
else l ++ (calcLines (line+1) maxp) ++ l
main = do
putStrLn “Enter a single letter”
input <- getLine
let maxp = (ord (head input)) – (ord ‘a’)
putStrLn (calcLines 0 maxp)
10:15 pm on April 15th, 2009 31
Overlly verbose version using iterators (sure that spacing logic could be reduced down!)
static char input;
const int AsciiA=65;
static void Main(string[] args)
{
Console.WriteLine(“Please enter a character”);
input = Console.ReadKey().KeyChar;
Console.WriteLine(“”);
int MaxWidth = Convert.ToInt32(input) – AsciiA;
int LeftSpace = MaxWidth + 1;
int Line = -1;
//forward rows
foreach (char c in GetCharForward())
{
PrintSpaces(LeftSpace);
LeftSpace -= 1;
if(c!=’A')
{
Console.Write(c);
PrintSpaces((2 * Line));
Console.Write(c + “\n”);
}
else
{
Console.WriteLine(c);
}
Line += 1;
}
MaxWidth = MaxWidth * 2;
Line = 2;
//Back rows
foreach (char c in GetCharBackward())
{
MaxWidth -= 2;
PrintSpaces(Line);
Console.Write(c);
if (c == ‘A’) break;
PrintSpaces(MaxWidth – 2);
Console.Write(c + “\n”);
Line += 1;
}
Console.ReadKey();
}
public static void PrintSpaces(int NumSpaces)
{
string space = ” “;
for (int x = 0; x != NumSpaces; x++)
{
space += ” “;
}
Console.Write(space);
}
public static IEnumerable GetCharForward()
{
int current = AsciiA;
while (Convert.ToChar(current-1) != input)
{
yield return Convert.ToChar(current);
current += 1;
}
}
public static IEnumerable GetCharBackward()
{
int current = Convert.ToInt32(input-1);
while (Convert.ToChar(current + 1) != 65)
{
yield return Convert.ToChar(current);
current -= 1;
}
}
11:08 pm on April 15th, 2009 32
Okay, I guess this is my final one… same algorithm as I did in Haskell, re-implemented in Lisp. I was lazy and skipped the part with asking for input and all that – just run something like (output (calcLines 0 4)). The 4 is the maximum depth, i.e. E in this case.
(defun calcLine (ch col line maxp)
(let
((tch (if (= col (- maxp line)) (cons ch nil) (cons 46 nil))))
(if (= col maxp) tch (append (append tch (calcLine ch (+ col 1) line maxp)) tch))
)
)
(defun calcLines (line maxp)
(let*
((ch (+ line (char-int #\A)))
(l (append (calcLine ch 0 line maxp) (cons 10 nil)))
)
(if (= line maxp) l (append (append l (calcLines (+ line 1) maxp)) l))
)
)
(defun output (l)
(dolist (x l)
(format t “~A” (int-char x)))
)
11:18 pm on April 15th, 2009 33
With C# and recursion
public void CodeChallenge(char currentChar, char startChar, char endChar)
{
const int maxPad = 30;
string currentLine;
if( currentChar == startChar )
{
currentLine = currentChar.ToString().PadLeft( maxPad );
}
else
{
currentLine =
currentChar.ToString().PadLeft( maxPad – currentChar + startChar ) +
currentChar.ToString().PadLeft( 2 * (currentChar – startChar) );
}
Console.WriteLine(currentLine);
if(currentChar != endChar)
{
CodeChallenge( (char)(currentChar + 1), startChar, endChar );
Console.WriteLine( currentLine );
}
}
11:31 pm on April 15th, 2009 34
Here is my solution in Scala:
import java.text.Format
import Math.abs
object Diamond {
val A = ‘A’
private def printDiamond( ch: Char ) {
def spacingFuncFactory(maxDifference: Int, padding: Int): Int = (2 * (maxDifference – padding)) – 1
val maxDiff = (ch – A) + 1
val spacing = spacingFuncFactory(maxDiff, _: Int)
def outputLine( padding: Int, ch: Int, spaces: Int) {
def padLeft( count: Int ): String = if( count == 0 ) “” else String.format(“%1$#” + count + “s”, Array(“”))
val c = ch.asInstanceOf[Char]
println( padLeft(padding) + c + padLeft(spaces) + (if( spaces > 0 ) c else “”) );
}
def print( terminatingValue: Int, diff: Int, diffIncrement: Int, c: Int, cIncrement: Int) {
if( diff != terminatingValue ) {
val absoluteDiff = Math.abs(diff)
outputLine( absoluteDiff, c, spacing(absoluteDiff) )
print( terminatingValue, diff + diffIncrement, diffIncrement, c + cIncrement, cIncrement )
}
}
print( 0, maxDiff, -1, A, 1)
print( maxDiff + 1, 2, 1, (ch – 1), -1)
}
def main( args: Array[String] ) {
if (args.length == 0 || args(0).length == 0 ) {
println(“Diamond: No argument supplied”)
return
}
val firstChar = args(0)(0)
if( firstChar ‘Z’) {
println(“Diamond: The first character of the argument supplied is outside of the range of A to Z”)
return
}
printDiamond( firstChar )
}
}
11:34 pm on April 15th, 2009 35
Dammit! looks like the blog engine has stripped out some stuff. The last “if” statement is checking to make sure the first char is between “A” and “Z”.
Cheers
Barry
11:36 am on April 16th, 2009 36
Did a SQL 2008 one that can take any char string
DECLARE @Input AS VARCHAR(MAX)
DECLARE @Result AS VARCHAR(MAX)
DECLARE @Length AS INT
DECLARE @x AS INT
SET @Input = ‘ABCDE’
SET @Length = LEN(@Input)
SET @Result = ”
SET @x = 0
WHILE ( @x 0 )
SELECT @Result = @Result + SPACE(( @x * 2 ) – 1) + SUBSTRING(@Input, @x + 1, 1)
SELECT @Result = @Result + CHAR(13) + CHAR(10)
SET @x = @x + 1
END
SET @x = @x – 1
WHILE ( @x >= 0 )
BEGIN
SET @x = @x – 1
SELECT @Result = @Result + SPACE(@Length – @x) + SUBSTRING(@Input, @x + 1, 1)
IF ( @x > 0 )
SELECT @Result = @Result + SPACE(( @x * 2 ) – 1) + SUBSTRING(@Input, @x + 1, 1)
SELECT @Result = @Result + CHAR(13) + CHAR(10)
END
PRINT @Result
11:48 am on April 16th, 2009 37
Better format and working copy/paste SQL2008 solution
http://pastebin.com/f794d1456
12:40 pm on April 16th, 2009 38
A clojure version implemented here. Unlike some of you, I went for legibility over terseness. Despite this it’s still only 44 lines of code (including function docs) of clear concise clojure:
http://paste.lisp.org/display/78674
It’s also 100% thread safe, easily parallelisable (though to do so would doubtless incure more overhead than it’s worth). The program has no mutable state and has been written in a purely functional style, with only the function to print having a side effect.
1:46 pm on April 16th, 2009 39
I’m afraid my APL-Solution may not display right (although Unicode, so it should)
(Using Dyalog APL with IO=1 and ML=0):
{{{⍵⍪1 0↓⊖⍵}⍵,0 ¯1↓1⌽⌽⍵}↑(⎕a⍳⍵){(⍳⍺)⌽(⍺,⍺)↑(⍺,1)⍴⍵}⎕a}’E’
see screenshot here: http://twitpic.com/3ecda
BTW: should I win, I have a friend in UK whose postal address you could use to mail the shirt
2:12 pm on April 16th, 2009 40
Oh, and to have it loop over a set of characters, we just use the “each”-operator:
{{{⍵⍪1 0↓⊖⍵}⍵,0 ¯1↓1⌽⌽⍵}↑(⎕a⍳⍵){(⍳⍺)⌽(⍺,⍺)↑(⍺,1)⍴⍵}⎕a}¨’BAAS’
Oh no, that last bit was no APL!
2:14 pm on April 16th, 2009 41
To clarify: with “that last bit” I was referring to the chars : – ) which were replaced with the smiley!
2:25 pm on April 16th, 2009 42
Ok I have to represent the Sybase SQL users out there…
CREATE PROCEDURE DBA."sp_generate_diamond" ( IN apex_char CHAR(1) )
BEGIN
DECLARE OFFSET INTEGER;
DECLARE DISTANCE INTEGER;
DECLARE DIRECTION INTEGER;
DECLARE CURRENTLINE CHAR(150);
SET OFFSET = ASCII(apex_char)-ASCII(‘A’);
SET DISTANCE = 0;
SET DIRECTION = 1;
WHILE ( DISTANCE >= 0 ) LOOP
SET CURRENTLINE = REPEAT( ‘ ‘, OFFSET-DISTANCE ) || CHAR(ASCII(‘A’)+DISTANCE);
IF( DISTANCE > 0 ) THEN
SET CURRENTLINE = CURRENTLINE || REPEAT( ‘ ‘, (DISTANCE*2)-1 ) || CHAR(ASCII(‘A’)+DISTANCE);
END IF;
MESSAGE CURRENTLINE TO CLIENT;
IF( DISTANCE = OFFSET ) THEN
SET DIRECTION = -1;
END IF;
SET DISTANCE = DISTANCE + DIRECTION;
END LOOP
END
Call it using the following statement:-
CALL dba.sp_generate_diamond( ‘E’ );
And the code is displayed in the “Statistics” window in Interactive SQL
Incase of formatting mess see this… http://pastebin.com/m41d6ea23
3:00 pm on April 16th, 2009 43
I was amazed by how many lines of code some languages require to solve this. The whole problem can be done in a single line of APL. I decided to document one solution on the APL Wiki web site:
http://aplwiki.com/Studio/LetterDiamonds
(This solution would only need 42 characters if you choose single-letter variable names)
3:36 pm on April 16th, 2009 44
Diamond in Scala http://pastebin.com/f56cf1a54
5:56 pm on April 16th, 2009 45
Wot no Ruby?
[(0..diff),(0...diff).to_a.reverse].each do |range|
range.each do |i|
s = (” “*(diff-i)) + (?A+i).chr + (” “*i)
puts s + s[0..-2].reverse
end
end
Not elegant in any sense, but it works.
7:14 pm on April 16th, 2009 46
Wimps here it is for the Apple II lovingly assembled with the miniassembler if you paste this into the applewin emulator:
CALL -151
4 C5 D2 A0 D3 C9 DA C5
300:A0 0E B9 00 03 F0 17 20
:ED FD C8 4C 02 03 C5 CE
:A0 C1 AD DA BF 00 20 0C
:FD C9 C1 30 04 C9 DA B0
:09 20 2D FF 20 8E FD 4C
:00 03 29 1F AA CA 86 08
:A2 FF 86 07 E8 E8 86 09
:A9 C1 85 06 20 8E FD A6
:08 D0 06 C6 09 C6 09 D0
:03 20 4A F9 A5 06 20 ED
:FD C9 C1 F0 0A A6 07 20
:4A F9 A5 06 20 ED FD 20
:8E FD 38 A5 08 E5 09 85
:08 18 A5 07 65 09 18 65
:09 85 07 18 A5 06 65 09
:85 06 C9 C0 D0 C1 60
300g
You’ll get a loverly prompting diamond printer.
8:45 pm on April 16th, 2009 47
I’m officially not feeling like a sick bastard anymore now.
2:32 am on April 17th, 2009 48
Here is a version in J: (see http://www.jsoftware.com)
firstletters=: (65}.a.)&(>:@i. {. [)
shape=: {.&>~ # {. i:@# NB. shape letters
hflipcat=: ,. |.@}:”1 NB. flip horizontally & catenate
vflipapp=: , |.@}: NB. flip vertically & append
vflipapp hflipcat shape firstletters ‘E’
Or as one function (verb):
diamond=: vflipapp@hflipcat@shape@firstletters
diamond ‘E’
If anyone wanted it as one line of code:
(,|.@}:)(,.|.@}:”1)({.&>~#{.i:@#)(65}.a.)(>:@i.{.[)’E’
2:44 am on April 17th, 2009 49
Note that the blog is “smart” and converts single and double quotes into “pretty” quotes.
As a result if you copy the code back to a J session you will need to replace the “pretty” versions with their simple counterparts for the code to work.
3:54 am on April 17th, 2009 50
Here’s an APL2 solution that is not a one-liner.
(I like comments better than brevity.)
∇LETTERDIAMOND[⎕]∇
∇
[0] MAT←LETTERDIAMOND ARG;LIST;⎕IO
[1] ⎕IO←0 ⍝ Set the index origin
[2] LIST←⎕AF(⎕AF ‘A’)+0,⍳-/⎕AV⍳ARG,’A’ ⍝ Build list of letters
[3] MAT←⊃(-⍳⍴LIST)↑¨LIST ⍝ Build upper right part
[4] MAT←(⌽MAT),1↓[1]MAT ⍝ Add upper left part
[5] MAT←MAT,[0]1↓[0]⊖MAT ⍝ Add lower half
∇ 2009-04-16 22.50.50 (GMT-4)
LETTERDIAMOND ‘E’
A
B B
C C
D D
C C
B B
A
BTW This sample is encoded using Unicode codepoints for the APL characters. If you can not read it here, I suggest you copy and
paste it into an editor and use Adrian Smith’s APL385 Unicode
font which is available here: http://www.vector.org.uk/?area=fonts.
David Liebtag
IBM APL Products and Services
3:57 am on April 17th, 2009 51
FYI
The APL2 result was a diamond when I posted it.
I suppose the browser removed the duplicate blanks.
Terrific.
5:30 am on April 17th, 2009 52
[...] hours ago APL,A+,J,K-ppl: @camurphy needs your input! http://www.craigmurphy.com/blog/?p=1417 (via @annwitbrock: http://twitter.com/annwitbrock/statuses/...) [...]
5:40 am on April 17th, 2009 53
Wow, thanks Simon & David for joining the APL-Club here
Compliments, Simon, for the well documented solution. (While shaving this morning I thought I could spare a few chars, but didn’t get it as compact as yours, nice
Especially the unneccessary “mix” is embarrassing, whish I could edit my post
Well, here’s the updated version (54 chars):
{{{⍵⍪1 0↓⊖⍵}⍵,0 ¯1↓1⌽⌽⍵}{(⍳⍵)⌽(⍵,⍵)↑(⍵,1)⍴⎕a}⎕a⍳⍵}’E’
Looking at Simon’s version, I realize my use of dynamic fns made the whole thing more verbose than required – I’ll keep that mind next time!
10:06 am on April 17th, 2009 54
Just wanted to whole-heartedly endorse what David Liebtag said: The whole thing can be done in a single line of APL code, but a commented function is much better. In my original post I was trying to draw attention to how well APL handles the problem compared to many other languages.
Here’s my solution:
∇R←LetterDiamond A;letters
[1] letters←(⎕A⍳A)↑⎕A ⍝ Get letters, e.g. A-E
[2] R←⊃(-⍳⍴letters)↑¨letters ⍝ Form upper-right side
[3] R←R⍪1 0↓⊖R←(⌽R),0 1↓R ⍝ Reflect to get whole diamond
∇
Again, you may need a Unicode APL font installed in order to view it.
For anyone interested, I documented how the code works on the APL Wiki:
http://aplwiki.com/Studio/LetterDiamonds
I’d encourage people to find out more about APL. It’s not as widely known as it deserves. For some types of problem it’s a superb language to use.
10:48 am on April 17th, 2009 55
Well, as there are a few APLers here, I have an A+ solution here: http://twitpic.com/3g4mi – it is written as a single function (yes, it could be a single ugly line as well). The results are shown here: http://twitpic.com/3g4n0
Unfortunately I have not yet figured out how to translate to Unicode (the results were pretty far off when I tried) so no code here
12:09 pm on April 17th, 2009 56
It seems the APL community is alive and kicking. Here is my version in Dyalog with quad IO = 1 and quad ML = 3
z,0 1↓⌽z←z⌽⊃n↑¨⎕A[z←(⍳n),1↓⌽⍳n←⎕A⍳'E']
and just for fun its cousin
(⌽z),0 1↓z←z⌽⊃n↑¨⎕a[z←(⍳n),1↓⌽⍳n←⎕a⍳'F']
Graham.
3:50 pm on April 17th, 2009 57
Here’s my SQL version for Informix 7.20!
CREATE TEMP TABLE t_diamond(
t_aRow CHAR (40))
WITH NO LOG;
CREATE PROCEDURE diamond (userInput CHAR (1))
DEFINE p_alphabet CHAR (26);
DEFINE p_aLetter CHAR (1);
DEFINE i, p_noOfLetters, p_rowNumber, p_direction INT;
DEFINE p_line CHAR (40);
LET p_alphabet = “ABCDEFGHIJKLMNOPQRSTUVWXYZ”;
LET p_aLetter = “A”;
LET i = 1;
– Work out which letter has been entered
WHILE userInput != p_aLetter
LET p_aLetter = substr(p_alphabet,i, i + 1);
LET i = i + 1;
END WHILE
LET p_noOfLetters = i – 1;
LET p_rowNumber = 0;
LET p_direction = 1;
LET p_line = “”;
– First and last line
WHILE p_rowNumber >= 0
LET p_line = substr(p_line,0 , p_noOfLetters – p_rowNumber) || substr(p_alphabet, p_rowNumber, 1);
— Top half of diamond
IF p_rowNumber > 0 THEN
LET p_line = substr(p_line,0 , p_noOfLetters – p_rowNumber) || substr(p_alphabet, p_rowNumber + 1, 1);
LET p_line = substr(p_line,0, p_noOfLetters + p_rowNumber) || substr(p_alphabet, p_rowNumber + 1, 1);
END IF
— Bottom half of diamond
IF p_rowNumber = p_noOfLetters – 1 THEN
LET p_line = substr(p_line,0 , p_noOfLetters – p_rowNumber) || substr(p_alphabet, p_rowNumber + 1, 1);
LET p_line = substr(p_line,0, p_noOfLetters + p_rowNumber) || substr(p_alphabet, p_rowNumber + 1, 1);
LET p_direction = -1;
END IF
INSERT INTO t_diamond VALUES (p_line);
LET p_line = “”;
LET p_rowNumber = p_rowNumber + p_direction;
END WHILE
END PROCEDURE;
EXECUTE PROCEDURE diamond(“E”);
UNLOAD TO ‘diamond.txt’ DELIMITER ‘ ‘
SELECT * FROM t_diamond;
DROP TABLE t_diamond;
4:48 pm on April 17th, 2009 58
Here’s another J entry implementation.
seq=: i.&.(-&65)@>:&.(a.&i.)
diam=: [: (,~ |.@}.)"1 [: ]/. (, ,.@}.)&.|.@seq
example use (but remember to convert quotes back to single quotes).
diam’B’
note also, seq’E’ would produce the result
ABCDE
note that much the complexity of seq has to do with the structure of ascii — this would be somewhat simpler if the domain were numbers, with 0 being used for padding, instead of spaces.
5:10 pm on April 17th, 2009 59
Alternatively the problem would be simpler (and the result more generic) if the entire sequence of letters were specified as input.
I did not post any documentation, because this problem seems fairly simple and for the most part a person just needs to understand J’s primitives (http://www.jsoftware.com/help/dictionary/vocabul.htm) and grammar.
However for people struggling with the language: (, ,.@}.)&.|.@seq ‘E’ produces an L shaped arrangement of letters, and ]/. rotates it 45 degrees, and (,~ |.@}.)”1 mirrors this half diamond to make a full diamond. The [: are, in essence, punctuation.
6:44 pm on April 17th, 2009 60
Actually… ]/. mirrors and rotates in 45 degrees. Using . for some spaces to defeat html’s suppression of extraneous white space,
(, ,.@}.)&.|.@seq ‘E’
A
B
C
D
EDCBA
]/.(, ,.@}.)&.|.@seq ‘E’
A
.B
..C
…D
….E
…D
..C
.B
A
To get an idea of the mirroring involved, here’s some incremental representations of the intermediate result:
(, ,.@}.)seq ‘E’
ABCDE
B
C
D
E
(, ,.@}.)|.seq ‘E’
EDCBA
D
C
B
A
|.(, ,.@}.)|.seq ‘E’
A
B
C
D
EDCBA
But I use F&.|. instead |.F|. because the former is a single verb phrase while the latter is merely a run-on sequence of verbs.
(Sorry, I should probably stop explaining, but I keep noticing areas where my initial treatment was inadequate.)
7:50 pm on April 17th, 2009 61
@RDM – I am very grateful for your explanations as are other readers too I would imagine!
Tracy Harms sent in the other J version that arrived via e-mail: (Iverson’s J programming language):
3 :’(],|.@}:)(|.@}.”_1,.])(AB{~i.Y)(_2< \2#i.Y)}'' ''$~2#Y=.>:y(=i.1:)AB=.a.{~65+i.26′”0
Stunning stuff!
9:47 pm on April 17th, 2009 62
Another J solution:
(,}.@|.)|:(|.,}.)(={“1′ ‘,.])’A'([+i.@-.@-)&.(a.&i.) ‘E’
As RDM says, the majority of the complexity (i.e. code) results from the specification requiring textual (rather than numeric) i/o.
If numeric i/o were permissible, this could be reduced to:
(,}.@|.)|:(|.,}.)(*=)1+i. 5
Whether this improvement is due to the spec’s bias towards text or J’s bias towards numbers is subjective, but I expect the textual and numeric solutions will be substantially equivalent in most languages, with the textual version carrying a slight overhead (in terms of code length).
BTW, J is an array-oriented language, so it’s particularly suited for “these kind” of challenges. There are many ways to solve this puzzle in J, from the structural/descriptive, like above, to the imperative/instructive, which would explore the mathematical relationships hidden in the pattern.
My preference is for the code to be descriptive: i.e. for the code to describe the pattern (as a human would), rather than imperative, instructing the computer to build the pattern using relationships among the indices.
11:29 pm on April 17th, 2009 63
How strange,
as well as losing indents, submitting here cut out the middle of the line around the OR in the middle of is_letter() so do not try to run the above!!! Can I delete it if I find a safer formatter?
11:35 pm on April 17th, 2009 64
[...] new here, you may want to subscribe to my RSS feed. Thanks for visiting!Earlier this week I set a Programming Challenge using an example from my first year in academia. So far it has attracted 60 or so comments and [...]
12:26 am on April 18th, 2009 65
A very slightly shorter solution is possible in APL dialects which support the “power” operator and “direct definition”: An anonymous function (the thing in curly braces on the left) which combines the “two halves” and transposes&reverses the result can be applied twice to the array containing letters along the diagonal to produce the final result:
{⌽⍉⍵,0 1↓⌽⍵}⍣2⊃(-⍳⍴l)↑¨⌽l←(⎕A⍳′F’)↑⎕A
This solution has the “cute” feature that if you replace the 2 by a 4 you get:
_____A_________A_____
____B_B_______B_B____
___C___C_____C___C___
__D_____D___D_____D__
_E_______E_E_______E_
F_________F_________F
_E_______E_E_______E_
__D_____D___D_____D__
___C___C_____C___C___
____B_B_______B_B____
_____A_________A_____
____B_B_______B_B____
___C___C_____C___C___
__D_____D___D_____D__
_E_______E_E_______E_
F_________F_________F
_E_______E_E_______E_
__D_____D___D_____D__
___C___C_____C___C___
____B_B_______B_B____
_____A_________A_____
(spaces replaced by underbars) I’ll spare y’all the results of using higher numbers than 4
12:30 am on April 18th, 2009 66
P.S. The APL symbols seem to be readable using Firefox, but unfortunately not with (my version of) IE…
12:50 am on April 18th, 2009 67
Diamond in Ruby, REXX, Icon, SETL, REBOL, PostScript & Haskell:
http://pastebin.com/fbca102d
10:51 am on April 18th, 2009 68
foo=: 3 : 0
NB. Software courtesy of http://www.jsoftware.com
NB. assignment to global facilitates analysis
ALF =: ‘ABCDEFGHIJKLMNOPQRSTUVWXYZ’
a =: ALF i. y NB. position in ALF (‘E’ returns 4)
b =: |i:a NB. 4 3 2 1 0 1 2 3 4
c =: a-b NB. 0 1 2 3 4 3 2 1 0
d =: c=/b NB. truth table
e =: 1+2*a NB. arithmetic (value is 9)
f =: ‘ ‘,:(e,e)$e#c{ALF NB. dyadic ,: is an interesting structural primitive
d}f NB. This form of } is a marvelous KEI jewel.
)
foo’E’
3:54 pm on April 18th, 2009 69
Ha ha ha … So many people have posted revolting code, I may as well do the same. At http://twitpic.com/3iuke you can see my A+ function rewritten into a single line. Horrible – variable assignment inside an indexing of the variable that’s just been assigned. I promise my production code would never do that! However, I have changed it to take case into account, so:
dia¡’bCd’
< a
b b
a
< A
B B
C C
B B
A
< a
b b
c c
d d
c c
b b
a
3:55 pm on April 18th, 2009 70
In Haskell. There is probably a more elegant way to implement the diamond’ function.
import List (transpose)
diamond :: Char -> String
diamond = (unlines . mirror . transpose . mirror . diamond’)
diamond’ :: Char -> [String]
diamond’ c = zipWith pad [0..] chars
where chars = reverse ['A'..c]
pad n m = pre n ++ [m] ++ post n
pre n = replicate (length chars – 1 – n) ‘ ‘
post n = replicate n ‘ ‘
mirror :: [[a]] -> [[a]]
mirror (n:ns) = (n ++ (tail . reverse) n) : zipWith (++) ns (map (tail . reverse) ns)
3:58 pm on April 18th, 2009 71
Well, the pre tags are ignored
The real result image is here: http://twitpic.com/3iv1t
7:41 pm on April 18th, 2009 72
I cannot but mention that some of the proposed implementations differ from the rest in what they do. For example, some produce a rectangular table rather than a ‘diamond’, or do not print their output, or do not read any input. However, a complete program, including all this properly done, might happen to increase 40-50% in volume precisely due to taking care of these details.
Also, certain programs, although extremely small at first look, are only that small if sheer volume is measured, but are of ‘normal’ size – comparable to programs in other languages – if tokens are counted.
11:00 pm on April 20th, 2009 73
I would not spend much time worrying about the handling of details which were not a part of the original problem specification:
In my experience, when minor changes in the specification result in a vastly simplified application, changing the specification is usually a good idea.
(Of course, programs which interface with other programs may have unbending requirements — but in those cases re-implementation is often a bad idea.)
This gets into issues of ownership and responsibility and so on, but if you want your programs to be useful you should never neglect these issues.
(Or, in the context of little contests like this one, I would usually just ignore issues which depend on the operating system and programming environment.)
7:16 am on April 21st, 2009 74
Boyko Bantchev,
Apparently you understand the requirements to involve not printing spaces to the right of any of the output letters. This seems inaccurate and pointless, unless the point were to impose a handicap on languages in which a rectangular table is significantly easier.
I do, however, agree that complete programs should both take any letter as input and print output, and that there are disadvantages to having programs that don’t weighed amidst those that do.
I also agree that the best way to evaluate program size is by counting tokens, not characters.
1:09 pm on April 21st, 2009 75
My previous note was meant to draw attention to the many differences in what the proposed solutions implement, because those differences make comparisons w.r.t., say, terseness, more or less meaningless.
I myself perceive this challenge as an exercise in making apparent different possibilities – languages, algorithmic approaches – rather than a ‘contest’. So, using an interactive programming environment to save the need for explicit reading and printing is o.k., so long as the result is as expected. Similarly, outputting trailing spaces is o.k., so long as the result is seen as a ‘diamond’. (However, this is not always the case: e.g., one of the Haskell programs would print ” A\n B B\n A\n” rather than an A-B diamond; this is easy to get rid of, but would have required the author to submit a longer program.)
Both adhering to a specification and changing it may be used as a means to show the good/bad points of a language and its environment. It’s just that the two kinds of solutions should not, as a rule, be compared to each other.
2:27 pm on April 22nd, 2009 76
@Boyko.
prDiamond = do
cs <- getLine
putStrLn $ diamond (head cs)
Happy?
On a more serious note, I like these programming challenges as they illustrate the differences in approach that one can take to solve a problem. This is particularly evident between the functional and imperative styles. I find the whole “I-can-write-it-in-fewer-characters-than-you” competition somewhat tiresome. I am much more interested in appreciating the underlying algorithm.
2:07 am on April 28th, 2009 77
Here’s q and k (closely related to APL, J, and A+):
k){-1@’f@(f:{x,1_|x})’n$10h${((|x)#’32),’65+x}(!)n:-64+6h$x;}
q){-1@’f(f:{x,1_reverse x})each n$10h${((reverse x)#’32),’65+x}til n:-64+6h$x;}
sample runs:
q){-1@’f(f:{x,1_reverse x})each n$10h${((reverse x)#’32),’65+x}til n:-64+6h$x;}”E”
A
B B
C C
D D
E E
D D
C C
B B
A
q)\
{-1@’f@(f:{x,1_|x})’n$10h${((|x)#’32),’65+x}(!)n:-64+6h$x;}”E”
A
B B
C C
D D
E E
D D
C C
B B
A
(i’m not responsible for wordpress’s probably ruining of this post)
4:46 pm on May 1st, 2009 78
The Following [assuming that your blog software doesn't screw with the formatting
] is a perfect solution to the problem written in “Whitespace”
http://en.wikipedia.org/wiki/Whitespace_(programming_language)
————————————————————-
————————————————————-
Now I think you’ll have to admit …. that ^^^^^^ is a thing of beauty
4:47 pm on May 1st, 2009 79
Looks like the blog software mangled it…oh and …. Damn ….. I didn’t save the original …
10:18 am on May 7th, 2009 80
A solution in Haskell, different from the one I posted before, along with other languages (http://pastebin.com/fbca102d).
The
function produces one (the bottom-left) quarter
of the diamond, which is then reflected horizontally to produce
, and
is reflected vertically to produce the whole figure.
is recursive, building a square by gradually enlarging it from the left and the top.
This solution is attractive by not needing anything explicitly related to the size of the figure or the encoding of characters as numbers (counting, subscripting,
,
etc).
import System(getArgs)
main = do args <- getArgs
let {h = zipWith (++) q (map (tail.reverse) q);
q = d $ head $ head args;
d c = if c==’A’ then ["A"] else (c:’ ‘:t) : map (‘ ‘:) r
where r@((_:t):_) = d $ pred c
} in putStr $ unlines (reverse h ++ tail h)
10:34 am on May 7th, 2009 81
Sorry for the previous post: it made use of the HTML tags CODE and PRE which the blog software does not treat properly, to say the least (although Wordpress docs say otherwise).
Please see a copy of that post here:
http://pastebin.com/f4635515b
10:46 am on May 7th, 2009 82
One solution in k, one in q, and two in J, explained
in some detail:
http://pastebin.com/f7a383c9c
10:58 am on May 7th, 2009 83
A solution in JavaScript (within an HTML page):
http://pastebin.com/d63f6cce4
On loading the page, an A-Z half-diamond is built-up as an array
of which, upon clicking a letter, a portion is being cut off,
corresponding to that letter. The diamond() function – a click
event listener – does the cutting and outputs the result to the page.
Works in a normal browser, such as Firefox, but also in IE
2:53 pm on May 8th, 2009 84
> A solution in JavaScript …
> http://pastebin.com/d63f6cce4
My fault – that was an expiring version.
Here is a non-expiring one:
http://pastebin.com/f1f4a5cf
6:48 am on May 12th, 2009 85
[...] Programming Challenge! [...]
5:26 pm on May 14th, 2009 86
A solution in Object Pascal (Delphi). Things have changed, I’m now a C# guy now.
program challenge;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
inputChar, current : char;
begin
Readln(inputChar);
current := ‘A’;
while current ‘A’ do
begin
current := chr(ord(current) – 1);
if current = ‘A’ then
Writeln(StringOfChar(‘ ‘, abs(ord(current) – ord(inputChar))) + ‘A’)
else
begin
Write(StringOfChar(‘ ‘, abs(ord(current) – ord(inputChar))) + current);
Writeln(StringOfChar(‘ ‘, abs(ord(‘A’) – ord(current)) * 2), current);
end;
end;
Readln;
end.
3:53 pm on May 18th, 2009 87
i have added a QBasic solution. I did adjustments to make it look identical to the expected output. I used Qbasic from http://www.qbcafe.net/qbc/english/download/compiler/qbasic_compiler.shtml
We wrote some games using QBasic. I miss those days.
CLS
PRINT “Enter Letter:”
INPUT l$
l$ = UCASE$(l$)
col = ASC(l$) – ASC(“A”) + 1
row = 0
col2 = col – 1
DO
LOCATE row + 5, col: PRINT CHR$(ASC(“A”) + row)
col2 = col2 + 1
LOCATE row + 5, col2: PRINT CHR$(ASC(“A”) + row)
col = col – 1
row = row + 1
LOOP WHILE col >= 1
col = 1
col2 = (ASC(l$) – ASC(“A”)) * 2 + 1
DO
LOCATE row + 5, col + 1: PRINT CHR$(ASC(l$) – col)
col2 = col2 – 1
LOCATE row + 5, col2: PRINT CHR$(ASC(l$) – col)
col = col + 1
row = row + 1
LOOP WHILE col < ASC(l$) – ASC(“A”) + 1
7:23 am on May 19th, 2009 88
Maybe some cobol will do.
identification division.
program-id. diamond.
environment division.
data division.
working-storage section.
01 options.
02 letter pic X occurs 26 times.
02 inputletter pic X.
77 a pic 99.
77 colval pic 99.
77 rowval pic 99.
77 numitems pic 99.
77 col2 pic 99.
screen section.
01 cls.
02 blank screen.
procedure division.
main-prog section.
para-a.
perform populate;
display cls.
display “Enter Letter:”.
accept inputletter, no beep.
perform varying a from 1 by 1 until letter(a) = inputletter
if not letter(a) = inputletter then
add 1 to colval
end-if
end-perform.
move colval to numitems.
perform varying a from 1 by 1 until letter(a) = inputletter
if not letter(a) = inputletter then
display letter(a), line rowval, col colval
move colval to col2
add a to col2
add a to col2
subtract 2 from col2
display letter(a), line rowval, col col2
subtract 1 from colval
add 1 to rowval
end-if
end-perform.
perform varying a from numitems by -1 until a = 0
display letter(a), line rowval, col colval
move numitems to col2
add a to col2
subtract 1 from col2
display letter(a), line rowval, col col2
add 1 to colval
add 1 to rowval
end-perform.
stop run.
populate.
move “A” to letter(1).
move “B” to letter(2).
move “C” to letter(3).
move “D” to letter(4).
move “E” to letter(5).
move “F” to letter(6).
move “G” to letter(7).
move “H” to letter(8).
move “I” to letter(9).
move “J” to letter(10).
move “K” to letter(11).
move “L” to letter(12).
move “M” to letter(13).
move “N” to letter(14).
move “O” to letter(15).
move “P” to letter(16).
move “Q” to letter(17).
move “R” to letter(18).
move “S” to letter(19).
move “T” to letter(20).
move “U” to letter(21).
move “V” to letter(22).
move “W” to letter(23).
move “X” to letter(24).
move “Y” to letter(25).
move “Z” to letter(26).
move 5 to rowval.
move 1 to colval.
3:05 pm on June 13th, 2009 89
Some plain old C++ that read the ending character from standard input:
#include
void p(char c){std::cout<’A'){s(2*(c-’A')-1);p(c);}p(‘\n’);}
int main()
{
char e,n(‘A’);std::cin.get(e);
while(n=’A')r(n–,e);
}
Nice challenge!
3:08 pm on June 13th, 2009 90
Some plain old C++ that read the ending character from standard input:
#include <iostream>
void p(char c){std::cout<<c;}
void s(int w){while(w–)p(‘ ‘);}
void r(char c,char e){s(e-c);p(c);if(c>’A'){s(2*(c-’A')-1);p(c);}p(‘\n’);}
int main()
{
char e,n(‘A’);std::cin.get(e);
while(n<e)r(n++,e);while(n>=’A')r(n–,e);
}
Nice challenge!
10:53 am on June 17th, 2009 91
Here is my C# offering. Nothing new. I see that the two key subtleties (the Abs and Substring) are found in previous entries. I wish I knew how to read them all. Maybe then I could find a job? Hmmmm? Naaah!
char c = Console.ReadKey().KeyChar;
int m = c – ‘A’;
for(int n = m + m; n >= 0; n–) {
int i = Math.Abs(n – m); // …, 2, 1, 0, 1, 2, …
string s = new string((char)(‘A’ + m – i), 1); // A, B, …, B, A
Console.WriteLine(s.PadLeft(i + 1) + s.PadLeft(2 * (m – i) + 1).Substring(1));
}
9:42 am on July 10th, 2009 92
[...] but after a few hours hacking it doesn’t seem that bad. For my first program I decided to solve this little puzle. This great guide got me going quickly and a few small pointers from verte in the friendly seeming [...]
1:27 am on August 28th, 2009 93
To Dan Bron:
Your “numeric” version still can be easily translated to the required “letter”:
a. {~ 32+(,}.@|.)|:(|.,}.)(*=)33+i.(64-~a.&i.) ‘E’
Here is also my Haskell solution:
sol e =
let bl = inits $ repeat ‘ ‘
qu = zipWith (++) bl $ reverse $ zipWith (:) ['A'..e] bl
ln = zipWith (++) qu $ map (tail.reverse) qu
all = reverse ln ++ (tail ln)
in unlines all
main = do
e <- getChar
putStr $ sol e
6:48 am on September 11th, 2009 94
Hello,
This is my Java version… Hope you like it guys=)
Please email me at jayson_rq2d3@yahoo.com if you have problem with the code and please acknowledge me when using this code, and most importantly email me if you can optimize this code in java, I would really like to see your code. Thanks.
System.exit(0); =)
/*JAYSON P. ZANARIAS
IV-BSCS, 19Yrs.Old
*/
class Diamond{
public static void main(String[]args){
String alphabet = “ABCDEFGHIJKLMNOPQRSTUVWXYZ”;
int index = alphabet.indexOf(args[0].toUpperCase());
for(int j, k=-index; k<=index; k++){
j = Math.abs(Math.abs(k)-index);
for(int i=-index; i<=index; i++){
if(i==j || i==-j)
System.out.print(alphabet.charAt(j));
else
System.out.print(" ");
if(i==index && k!=index)
System.out.println();
}
}
}
}
8:45 am on September 11th, 2009 95
this is done in C in Linux. not a very efficient code for after printing the rightmost characters it still prints spaces to occupy the remaining length until it reaches the maximum length of the diamond:
#include
main(){
int num, i, x, y;
char input;
char alpha[26] = “ABCDEFGHIJKLMNOPQRSTUVWXYZ”;
printf(“Enter a character from a-z: “);
input = toupper(getchar());
for (i = 0; i < 26; i++){
if (alpha[i] == input)
num = i;
}
for (y = -num; y <= num; y++){
for (x = -num; x <= num; x++){
if (abs(x) + abs(y) == num)
printf("%c", alpha[num-abs(y)]);
else
printf(" ");
}
printf("\n");
}
}
9:33 pm on January 11th, 2010 96
#!/bin/bash
j=0
char=”${1:-E}”
alphabet=( A B C D E F G H I J K L M N O P Q R S T U V W X Y Z )
if [ "${char}" = "" -o "${char}" = "A" -o "${char}" = "${char/[A-Z]/}” ] ; then
echo “USAGE: Specify an uppercase letter greater than A as in ${0} E” && exit
fi
for ((i=39;i>=1;i–,j++)) ; do
output=”$( jot -b ‘ ‘ -s ” ${i} )”
echo -n “${output}${alphabet[${j}]}”
[ ${j} -gt 0 ] && echo “$( jot -b ‘ ‘ -s ” $((${j}*2-1)) )${alphabet[${j}]}” || echo
[ "${alphabet[${j}]}” = “${char}” ] && break
[ ${j} -ge 25 ] && j=$((j%25))
done
let j-=1
for ((k=$(($i+1));k<=39;k++,j–)) ; do
output="$( jot -b ' ' -s '' ${k} )"
echo -n "${output}${alphabet[${j}]}"
[ ${j} -gt 0 ] && echo "$( jot -b ' ' -s '' $((${j}*2-1)) )${alphabet[${j}]}" || echo
[ ${j} -le 0 ] && j=25
done
9:40 pm on January 11th, 2010 97
Posting in the comments changes single and double quotes (somewhat randomly) and double dashes (‘”–”‘). Another marvel of modern computing, swell.
3:19 pm on February 1st, 2010 98
A version in clojure, a dialect of lisp: http://pastebin.com/f5e342bc
10:10 pm on May 13th, 2010 99
This is a VB.NET console application:
Module Module1
Sub Main()
Dim keyInfo As ConsoleKeyInfo = Nothing
Dim wideChar As Char = ” “c
Dim iA As Integer = 0, iB As Integer = 0
Dim iX As Integer = 0
Do
Console.Write(“Input Widest Character: “)
keyInfo = Console.ReadKey(True)
With keyInfo
If System.Char.IsLetter(.KeyChar) Then
wideChar = .KeyChar.ToString.ToUpper
Console.WriteLine(wideChar)
End If
End With
Loop Until wideChar ” “c
iA = Asc(“A”c)
iB = Asc(wideChar)
Console.WriteLine()
For iX = iA To iB
Console.WriteLine(Space(iB – iX + 1) & Chr(iX) & Space((iX – iA) * 2) & Chr(iX))
Next
For iX = iB – 1 To iA Step -1
Console.WriteLine(Space(iB – iX + 1) & Chr(iX) & Space((iX – iA) * 2) & Chr(iX))
Next
Console.WriteLine()
Console.Write(“Press Any Key”)
Console.ReadKey()
End
End Sub
End Module
3:23 pm on June 10th, 2010 100
My ASCII independent PERL version: http://pastebin.com/QKiT3xPX
Why independent? Cause standards can change!
4:38 pm on June 21st, 2010 101
makeDiamond := $E.
charValue := makeDiamond asInteger.
diff := charValue – 65 + 1.
diamondStream := WriteStream on: String new.
mid := 0.
diamondBlock := [:x |
start := diff - mid.
1
to: start
do: [:y | diamondStream nextPut: Character space].
diamondStream nextPut: x asCharacter.
1
to: mid * 2 – 1
do: [:y | diamondStream nextPut: Character space].
mid > 0 ifTrue: [diamondStream nextPut: x asCharacter].
diamondStream nextPut: Character cr].
65
to: charValue
do:
[:x |
diamondBlock value: x.
mid := mid + 1].
mid := mid – 2.
(65 to: charValue – 1)
reverseDo:
[:x |
diamondBlock value: x.
mid := mid - 1].
^diamondStream contents asText emphasizeAllWith: #family -> #courier