Say I have text like this (each word on one line, with no spaces)
Programming
Puzzles
&
Code
Golf
That makes no sense! It totally defies the laws of physics.
Your challenge is to remedy this impossible situation and collapse the text like so:
P
Prog
&uzz
Coderam
Golflesming
So that there is no empty space underneath any character but the characters retain their vertical order.
The goal is to satisfy the requirements but use the fewest bytes of source code possible.
jb_.T.T_.z
Try it online in the Pyth Compiler/Executor.
We can achieve the desired output by applying four simple transformations:
Reverse the order of the lines:
Golf
Code
&
Puzzles
Programming
Transpose rows and columns:
GC&PP
oour
ldzo
fezg
lr
ea
sm
m
i
n
g
This top justifies, collapsing the original columns.
Transpose rows and columns:
Golflesming
Coderam
&uzz
Prog
P
Reverse the order of the lines:
P
Prog
&uzz
Coderam
Golflesming
.z Read the input as a list of strings, delimited by linefeeds.
_ Reverse the list.
.T.T Transpose the list twice.
_ Reverse the list.
jb Join its strings; separate with linefeeds.
import Data.List
p=reverse;o=transpose
f=unlines.p.o.o.p.lines
I'm very mature.
l=[]
for x in input().split('\n'):n=len(x);l=[a[:n]+b[n:]for a,b in zip(l+[x],['']+l)]
print'\n'.join(l)
An iterative one-pass algorithm. We go through each line in order, updating the list l of lines to output. The new word effectively pushes from the bottom, shifting all letters above it one space. For example, in the test case
Programming
Puzzles
&
Code
Golf
after we've done up to Code, we have
P
Prog
&uzzram
Codelesming
and then adding Golf results in
P
Prog
&uzz
Coderam
Golflesming
which we can view as the combination of two pieces
P |
Prog |
&uzz |
Code | ram
Golf | lesming
where the first piece got shifted up by golf. We perform this shifting with a zip of the output list with the element at the end (left side) and output list precedence by a blank line (right side), cutting off each part at the length of the new element.
It might seem more natural to instead iterate backwards, letting new letters fall from the top, but my attempt at that turned out longer.
For comparison, here's a zip/filter approach, with map(None,*x) used for iziplongest (109 bytes):
f=lambda z:[''.join(filter(None,x))for x in map(None,*z)]
lambda x:'\n'.join(f(f(x.split('\n')[::-1]))[::-1])
qN/W%zzW%N*
Try it online in the CJam interpreter.
The idea in the same as in my Pyth answer.
q e# Read from STDIN.
N/ e# Split at linefeeds.
W% e# Reverse the resulting array.
zz e# Transpose it twice.
W% e# Reverse the resulting array.
N* e# Join its strings; separate with linefeeds.
(The 2 newlines inside template strings are significant and counted)
The idea of @Dennis implemented in JavaScript. The lengthy S function do the transposition line by line and char by char, leaving the result in the t array.
a=>(S=z=>{for(t=[];z.join``;t.push(w))for(w='',n=z.length;n--;z[n]=z[n].slice(1))w+=z[n][0]||''},S(a.split`
`),S(t.reverse()),t.reverse().join`
`)
Less golfed inside the snippet (try in Firefox)
F=a=>(
S=z=>{
for(t=[];z.join``;t.push(w))
for(w='',n=z.length;n--;z[n]=z[n].slice(1))
w+=z[n][0]||''
},
S(a.split`\n`),
S(t.reverse()),
t.reverse().join`\n`
)#I,#O { margin:0; width: 200px; height:100px; border: 1px solid #ccc }<table><tr><td>
Input<br><textarea id=I>Programming
Puzzles
&
Code
Golf
</textarea></td><td>
Output<pre id=O></pre>
</td></tr></table>
<button onclick='O.innerHTML=F(I.value)'>go</button>
S(t.reverse()),t.reverse().join with S(R=t.reverse()),R.join.
\$\endgroup\$
Aug 25, 2015 at 19:14
function(x){a=apply(do.call(rbind,lapply(p<-strsplit(strsplit(x,"\n")[[1]],""),function(x)c(x,rep(" ",max(lengths(p))-length(x))))),2,function(x)c(x[x==" "],x[x!=" "]));for(i in 1:nrow(a))cat(a[i,][a[i,]!=" "],"\n",sep="")}
This is an absurdly long, naïve way of doing it.
Ungolfed:
f <- function(x) {
# Start by spliting the input into a vector on newlines
s <- strsplit(x, "\n")[[1]]
# Create a list consisting of each element of the vector
# split into a vector of single characters
p <- strsplit(s, "")
# Pad each vector in p to the same length with spaces
p <- lapply(p, function(x) c(x, rep(" ", max(lengths(p)) - length(x))))
# Now that the list has nice dimensions, turn it into a matrix
d <- do.call(rbind, p)
# Move the spaces to the top in each column of d
a <- apply(d, 2, function(x) c(x[x == " "], x[x != " "]))
# Print each row, omitting trailing whitespace
for (i in 1:nrow(a)) {
cat(a[i, ][a[i, ] != " "], "\n", sep = "")
}
}
You can try it online.
function f(s)
c=char(strsplit(s,[10 '']));[~,i]=sort(c>32);[m,n]=size(c);c(i+repmat((0:n-1)*m,m,1))
Example:
Define an input string in a variable, say s. 10 is the line feed character:
>> s = ['Programming' 10 'Puzzles' 10 '&' 10 'Code' 10 'Golf'];
Call function f with input s:
>> f(s)
ans =
P
Prog
&uzz
Coderam
Golflesming
Or try it online (thanks to @beaker for help with the online Octave interpreter)
F=s=>(C=o=>--a.length?C(a.reduce((p,c,i)=>c+p.slice((a[i-1]=p.slice(0,c.length)).length)))+`
`+o:o)(a=(s+`
`).split`
`)
Here it is ungolfed and in ES5 with comments explaining how it works:
function F(s) {
var arr = (s+'\n').split('\n'); // Create an array of words and append an empty member
return (function C(output) {
return --arr.length ? // Remove the last item from the array
C(arr.reduce(function(p,c,i) { // If the array still has length reduce it to a string and recurse
var intersection = (arr[i-1] = p.slice(0, c.length)) // Overwrite the previous word with the part that intersects the current word
return c + p.slice(intersection.length) // Add the part of the previous word that doesn't intersect to the current value
})) + '\n' + output : output // Add the last level of recursions output on to the end of this
})(arr);
}
input.addEventListener('input', updateOutput, false);
function updateOutput() {
var oldLength = input.value.length;
var start = this.selectionStart;
var end = this.selectionEnd;
input.value = input.value.split(/ +/).join('\n');
var newLength = input.value.length;
input.setSelectionRange(start, end + (newLength - oldLength));
output.value = F(input.value).trim();
}
updateOutput();textarea {
width: 50%;
box-sizing: border-box;
resize: none;
float: left;
height: 10em;
}
label {
width: 50%;
float: left;
}<p>Type in the input box below, spaces are automatically converted to newlines and the output updates as you type</p>
<label for="input">Input</label>
<label for="output">Output</label>
<textarea id="input">
Type inside me :)
</textarea>
<textarea id="output" disabled>
</textarea>
-2 with my extensions to Dyalog APL.
Anonymous tacit function, taking and returning a character matrix.
~∘' '⍤1⍢⍉⍢⊖
~ remove
∘ the
' ' spaces
⍤ from
1 rows (lit. 1D sub-arrays)
⍢ while
⍉ transposed
⍢ while
⊖ flipped
Probably still some room for golfing in this. Probably a couple of unnecessary operations in there
l=lapply;s=substring;C=rbind;d=do.call;cat(C(d(C,l(apply(d(C,l(a<-scan(,''),s,1:(w=max(nchar(a))),1:w))[(h=length(a)):1,],2,paste0,collapse=''),s,1:h,1:h))[,h:1],'\n'),sep='')
Ungolfed and explained
a<-scan(,'') # get STDIN
h<-length(a) # number of lines
w=max(nchar(a)) # length of longest line
M<-lapply(a,substring,1:w,1:w) # create a list of split strings with empty chars
M<-do.call(rbind,M)[h:1,] # turn it into a matrix with line order reversed
M<-apply(M,1,paste0,collapse='') # paste together the columns
M<-lapply(M,substring,1:h,1:h) # split them back up
M<-do.call(rbind,M)[,h:1] # reform a matrix
M<-rbind(M,'\n') # add some carriage returns
cat(M,sep='') # output with seperators
Test Run. It is interesting to note that due to the way that scan works, the whole sentence can be input with spaces and still give the output as specified.
> l=lapply;s=substring;C=rbind;d=do.call;cat(C(d(C,l(apply(d(C,l(a<-scan(,''),s,1:(w=max(nchar(a))),1:w))[(h=length(a)):1,],2,paste0,collapse=''),s,1:h,1:h))[,h:1],'\n'),sep='')
1: Programming
2: Puzzles
3: &
4: Code
5: Golf
6:
Read 5 items
P
Prog
&uzz
Coderam
Golflesming
> l=lapply;s=substring;C=rbind;d=do.call;cat(C(d(C,l(apply(d(C,l(a<-scan(,''),s,1:(w=max(nchar(a))),1:w))[(h=length(a)):1,],2,paste0,collapse=''),s,1:h,1:h))[,h:1],'\n'),sep='')
1: Programming Puzzles & Code Golf beta
7:
Read 6 items
P
Prog
&uzz
Code
Golfram
betalesming
>
Takes input in a file called a.b Only works for up to 24 characters now. Will update later to make it work with more. Also, doesn't work in the online compiler. Requires the non-free compiler.
gl l=24/
forv x=1/$l{
gl a="$a str a`x' `x'"
}
infix $a using a.b
gl b=_N
forv k=1/$l{
gen b`k'=0
qui forv i=$b(-1)1{
forv j=`i'/$b{
replace b`k'=1 if _n==`j'&a`k'==""
replace a`k'=a`k'[_n-1] if _n==`j'&a`k'==""
replace a`k'="" if _n==`j'-1&b`k'[_n+1]==1
replace b`k'=0
}
}
}
forv i=1/$b{
forv k=1/$l{
di a`k'[`i'] _c
}
di
}
Edit: moved the quietly (to suppress output) to the loop itself from each statement in the loop, saving 8 bytes.
S=scan(,"");while(any((D<-diff(N<-sapply(S,nchar)))<0)){n=max(which(D<0));S[n+1]=paste0(S[n+1],substr(S[n],N[n]+D[n]+1,N[n]));S[n]=substr(S[n],1,N[n]+D[n])};cat(S,sep="\n")
With newlines and indentation:
S=scan(,"") #Takes input from stdin
while(any((D<-diff(N<-sapply(S,nchar)))<0)){
n=max(which(D<0))
S[n+1]=paste0(S[n+1],substr(S[n],N[n]+D[n]+1,N[n]))
S[n]=substr(S[n],1,N[n]+D[n])
}
cat(S,sep="\n")
Usage:
> S=scan(,"");while(any((D<-diff(N<-sapply(S,nchar)))<0)){n=max(which(D<0));S[n+1]=paste0(S[n+1],substr(S[n],N[n]+D[n]+1,N[n]));S[n]=substr(S[n],1,N[n]+D[n])};cat(S,sep="\n")
1: Programming
2: Puzzles
3: &
4: Code
5: Golf
6:
Read 5 items
P
Prog
&uzz
Coderam
Golflesming
ỴṚZZṚY
The idea in the same as in my Pyth answer.
ỴṚZZṚY Main link. Argument: s (string)
Ỵ Split at linefeeds.
Ṛ Reverse the order of the lines.
ZZ Zip/transpose twice.
Ṛ Reverse the order of the lines.
Y Join, separating by linefeeds.
Fairly sure I could change approach to save bytes, but later.
:p Non-golf esolang beats regular langs :p
The odd thing about Turtlèd is it was originally made after discussion about ascii art langs, but it actually seems to be best at these kinds of challenges
Turtlèd can not take newline input but for multiple inputs, and this takes only one input: terminate each word with a space, including the last one.
!l[*,+r_][ l]ur[*,[ -.]+.[ r{ d}u+.]-.[ -.]{ l}[ l]r[ u]_]' d[ d]u[ ' r]
! Take string input
l Move left, off the asterisk at the start of grid
[* ] Until cell is *
,+r_ write *, string pointer+=1, move right, write * if pointed char is last char
[ l]ur move left until finding a space, move up and right
[* ] Until cell is *
, write *
[ ] until cell is [space]
-. decrement string pointer, write pointed char
+. increment and write string pointer
[ ] until cell is [space]
r{ d} move right, move down until finding nonspace
u+. move up, string pointer+=1 and write pointed char
-. decrement string pointer and write pointed char
[ ] until cell is [space]
-. string pointer-=1 and write pointed char
{ l} move left until finding nonspace
[ l] move left until finding space
r move right
[ u] move up until finding space
_ write * if pointed char is last char
(if it is written, loop ends)
' d[ d]u[ ' r] just cleanup
This was one of those challenges that changed in my head from being too hard, to being easy, to being a lot more code than I'd anticipated... I'm not particularly happy with the approach, I'm sure there's a much better way to reduce the print pop@F... bit perhaps using -n or just pure regex, but I can't get there right now... Originally I was using say, but I think I'd have to score that higher (use 5.01) because of $'.
@F=(/.+/g,@F)for<>;$_%=$#F,($x=length$F[$_++])<length$F[$_]&&($F[$_]=~/.{$x}/,$F[$_-1].=$',$F[$_]=$&)for 0..1e2;print pop@F,$/while@F
Save as vertically-collapse-text.pl.
perl vertically-collapse-text.pl <<< 'Programming
Puzzles
&
Code
Golf'
P
Prog
&uzz
Coderam
Golflesming
X=RND(50)Y=RND(20)G=CHKCHR(X,Y+1)<33LOCATE X,Y+G?CHR$(CHKCHR(X,Y));
LOCATE X,Y?" "*G
EXEC.
Applies gravity to all text in the console. I'm not sure if this is valid, or if I have to use a string array.
Getting there...
f=->a,i=-1{a.map{|l|i+=1;(0...l.size).map{|c|a.map{|x|x[c]}.join[~i]}*''}.reverse}
An attempted explanation:
f=->a,i=-1{a.map{|l|i+=1; # For each line `l` with index `i` in string array `a`
(0...l.size).map{|c| # For each column `c` in `l`
a.map{|x|x[c]}.join # Make a string of non-nil characters `c` across `a`...
[~i] # ...and grap the `i`th character *from the end*, if any
}*''}.reverse} # Join the characters grabbed from each column and reverse the result
Run it like this:
a = %w[
Programming
Puzzles
&
Code
Golf
]
puts f[a]
{+{(-#x)$x@&~^x}'+x@\:!|/#:'x}
.
k){+{(-#x)$x@&~^x}'+x@\:!|/#:'x}("Programming";"Puzzles";,"&";"Code";"Golf")
"P "
"Prog "
"&uzz "
"Coderam "
"Golflesming"
Explanation
x@\:!|/#:'x extends each string to create a square char matrix.
k){x@\:!|/#:'x}("Programming";"Puzzles";,"&";"Code";"Golf")
"Programming"
"Puzzles "
"& "
"Code "
"Golf "
+ transposes it
k){+x@\:!|/#:'x}("Programming";"Puzzles";,"&";"Code";"Golf")
"PP&CG"
"ru oo"
"oz dl"
"gz ef"
"rl "
"ae "
"ms "
"m "
"i "
"n "
"g "
{(-#x)$x@&~^x} will remove any spaces from a string and then pad the string by its original length
k){(-#x)$x@&~^x}"a b c de f"
" abcdef"
Apply that function to each of the transposed strings, then flip the output to get the result
k){+{(-#x)$x@&~^x}'+x@\:!|/#:'x}("Programming";"Puzzles";,"&";"Code";"Golf")
"P "
"Prog "
"&uzz "
"Coderam "
"Golflesming"
^w[B!0]{w[B=32]{vb[1]^b[0]}>}b[1]vb[1]>b[2]<[X]w[B!2]{t[T+B]b[0]>}b[0]v[T]w[X!-1]{b[1]<}b[1]vb[1]w[B!0]{w[B!0]{^w[B!0]{>}<<<<^[Y+1]w[B!0]{<}>t[B]b[0]w[B!1]{v}v<[X]w[B!0]{>}b[T]}b[0]vb[1]^w[X!0]{<vb[1]^t[B]b[0]^w[B!0]{^}b[T]w[B!0]{v}}vw[B!0]{^^w[B!0]{>}<b[0]vvw[B=0]{<}b[0]<[X]}^^>w[B=0]{vb[1]}v<<}>>^b[0]^<b[0]
What a disaster. I barely remember anything about how it works.
Because of the way pb's input works (a single line all at once), you have to use spaces instead of newlines in the input. If the interpreter wasn't garbage and you could include newlines in the input, the only change would be the [B=32] at the beginning becoming [B=10].
I'm working on an update to pbi (the interpreter) that will clean up the visuals if you want to watch the program run. It still needs a lot of work but in the mean time, you can watch this program on YouTube.
-.&' '"1&.(|:@|.)
Quite pleasant solution.
Explanation:
-.&' '"1&.(|:@|.) input: list of strings y
|. reverse lines
|:@ then transpose
-.&' '"1 remove blanks from columns
&. and undo the inside
|:@|. (that is, transpose and reverse again.)
s
Programming
Puzzles
&
Code
Golf
|.s
Golf
Code
&
Puzzles
Programming
|:|.s
GC&PP
oo ur
ld zo
fe zg
lr
ea
sm
m
i
n
g
-.&' '"1|:|.s
GC&PP
oour
ldzo
fezg
lr
ea
sm
m
i
n
g
|.-.&' '"1|:|.s
g
n
i
m
sm
ea
lr
fezg
ldzo
oour
GC&PP
|.|:-.&' '"1|:|.s
P
Prog
&uzz
Coderam
Golflesming
(-.&' '"1)&.(|:@|.)s
P
Prog
&uzz
Coderam
Golflesming
-.&' '"1&.(|:@|.)s
P
Prog
&uzz
Coderam
Golflesming
f =: -.&' '"1&.(|:@|.)
f
-.&' '"1&.(|:@|.)
f >'Programming';'Puzzles';'&';'Code';'Golf'
P
Prog
&uzz
Coderam
Golflesming
g =: [: > [: <;._1 '|'&,
g 'Programming|Puzzles|&|Code|Golf'
Programming
Puzzles
&
Code
Golf
f g 'Programming|Puzzles|&|Code|Golf'
P
Prog
&uzz
Coderam
Golflesming
F =: f @ g
F &. > 'Programming|Puzzles|&|Code|Golf' ; '1|23|456|7890' ; '1234|567|89|0'
+-----------+----+----+
|P |1 |1 |
|Prog |23 |52 |
|&uzz |456 |863 |
|Coderam |7890|0974|
|Golflesming| | |
+-----------+----+----+
This uses the algorithm described in Dennis' Jelly answer. Input and output are both lists of strings. Unfortunately, the builtin transpose function does not work very well if the inner lists or strings aren't all the same length, which would kind of defeat the point of vertically collapsing in the first place. Golfing suggestions welcome. Try it online!
R2`;i(lZ♂Σ`nR
Ungolfing
Implicit input s.
R Reverse s.
2`...`n Run the following function twice.
;i Duplicate and flatten onto the stack.
(l Get the number of strings in the list.
Z Zip len strings together, which results in a list of lists of characters.
♂Σ Sum each list of characters, which essentially joins them together.
This function essentially transposes
R Reverse the result.
Implicit return.
(let((lr list-ref)(ls list-set)(sl string-length)(ss substring)(l(string-split s)))(let p((ch #f))
(for((i(-(length l)1)))(define s(lr l i))(define r(lr l(+ 1 i)))(define n(sl s))(define m(sl r))
(when(> n m)(set! l(ls l i(ss s 0 m)))(set! l(ls l(+ 1 i)(string-append r(ss s m n))))(set! ch #t)))(if ch(p #f)l)))
Ungolfed:
(define (f s)
(let ((lr list-ref)
(ls list-set)
(sl string-length)
(ss substring)
(l (string-split s)))
(let loop ((changed #f))
(for ((i (sub1 (length l))))
(define s (lr l i))
(define r (lr l (add1 i)))
(define n (sl s))
(define m (sl r))
(when (> n m)
(set! l (ls l i (ss s 0 m)))
(set! l (ls l (add1 i)(string-append r (ss s m n))))
(set! changed #t)))
(if changed (loop #f)
l))))
Testing:
(f "Programming Puzzles & Code Golf")
Output:
'("P" "Prog" "&uzz" "Coderam" "Golflesming")
v=>(v=v.split`
`).map(_=>v=v.map((x,i)=>v[++i]?x.slice(0,n=v[i].length,v[i]+=x.slice(n)):x))&&v.join`
`
Split on CR, outer map ensures we loop enough times to allow "gravity" to drop letters as far as they need to drop.
Inner map first checks if there is a next line, if so, and it is shorter, drop the overflow to the next line. i.e if the 1st line has "ABCD" and the 2nd line has "FG", drop the "CD" from 1st line to the 2nd so that the 1st line becomes "AB" and the 2nd becomes "FGCD".
As we do this as many times as there are lines, the letters drop as far as they should, leaving us with the desired outcome.
y kS ù y
Uy kS ù y
Uy Transpose at newline
kS Replace spaces with nothing
ù Left-pad to fit the longest line
y Transpose at newline
There's also z which rotates the 2D string by a multiple of 90 degrees, but it somehow truncates the string when height > length.
¶¡RζðмζR»
or with alternative start:
.BRøðмζR»
Similar approach as @Dennis♦' Pyth answer.
-1 byte thanks to @Emigna replacing ðõ: with ðм.
Explanation:
¶¡ # Split on new-lines
R # Reverse the list
ζ # Zip/Transpose with unequal-length items (with space filler by default)
ðм # Remove all spaces
ζ # Zip/Transpose unequal-length items (with space filler) again
R # Reverse the list again
» # Join the list by newlines, and output implicitly
Alternative explanation:
.B # Box (implicitly splits on new-lines and appends spaces)
ø # Zip/Transpose with equal-length items
# Rest is the same
function(x)apply(x,2,function(.).[order(!is.na(.))])
#old,longer version did the same but less efficiently
#function(x)apply(x,2,function(x){n<-na.omit(x);c(rep("",length(x)-length(n)),n)}))
I took some liberty in interpreting the question and presumed that the text is represented in a matrix with one character per cell, thus:
x <- as.matrix(read.fwf(textConnection("Programming
Puzzles
&
Code
Golf"), widths=rep(1, 11)))
So x becomes:
V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11
[1,] "P" "r" "o" "g" "r" "a" "m" "m" "i" "n" "g"
[2,] "P" "u" "z" "z" "l" "e" "s" NA NA NA NA
[3,] "&" NA NA NA NA NA NA NA NA NA NA
[4,] "C" "o" "d" "e" NA NA NA NA NA NA NA
[5,] "G" "o" "l" "f" NA NA NA NA NA NA NA
Now I use order and [ to sort the columns so that the NA's come first and then all other values:
V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11
[1,] "P" NA NA NA NA NA NA NA NA NA NA
[2,] "P" "r" "o" "g" NA NA NA NA NA NA NA
[3,] "&" "u" "z" "z" NA NA NA NA NA NA NA
[4,] "C" "o" "d" "e" "r" "a" "m" NA NA NA NA
[5,] "G" "o" "l" "f" "l" "e" "s" "m" "i" "n" "g"
It becomes longer if it is required that the output be words:
s <- (function(x)apply(x,2,function(.).[order(!is.na(.))]))(x)
s[is.na(s)]<-""
apply(s, 1, paste, collapse="")
# [1] "P" "Prog" "&uzz" "Coderam" "Golflesming"
function(x) need to be included in the byte count.
\$\endgroup\$
function(x){l=nchar;o=function(y)which(diff(l(y))<0)[1];d=function(x,i)"[<-"(x,i:(j<-i+1),c(a<-substr(x[i],1,l(x[j])),sub(a,x[j],x[i])));while(!is.na(o(x)))x=d(x,o(x));x}
A human-readable version:
f<-function(x){
l=nchar;
# find the first line in x that is longer than the next line
# if no such line exists o(x) will be NA
o = function(y) which(diff(l(y))<0)[1]
# d(x,i) --> clips the line i in x, adding the remainder to x[i+1]
d = function(x,i) "[<-"(x,i:(j<-i+1),
c(a<-substr(x[i],1,l(x[j])), sub(a,x[j],x[i])))
# a --> clipped x[i], sub(a,x[j],x[i]) --> expanded x[j]
while(!is.na(o(x)))x=d(x,o(x));x
}
How it works:
(Or in other words, "superfluous" parts fall down until everything that can fall down has fallen down.)
Input: a character vector.
x<-readLines(textConnection("Programming\nPuzzles\n&\nCode\nGolf"))
f(x)
# [1] "P" "Prog" "&uzz" "Coderam" "Golflesming"
□Ṙ∩∩Ṙ⁋
Uses the same idea as Pyth answer
□ Input as a list separated by newlines
Ṙ Reverse
∩ Transpose rows and columns
∩ Same as above
Ṙ Reverse
⁋ Join by newlines
Implicit output the result
l=length
g(z,i)=(n=z[i];m=z[i+1];(N,M)=l.([n,m]);z[i:i+1]=[n[1:min(N,M)],m*n[M+1:N]])
f(s,w=split(s),d=1:l(w)-1)=(g.([w],[d d]);join(w,"\n"))
Broadcasting with g.([w], [d d]) allows me to get rid of any map statement and saves me around 7 bytes.
