85
\$\begingroup\$

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.

\$\endgroup\$
  • 12
    \$\begingroup\$ Also, will it be one word per line, or can there be spaces? If there are spaces, should they collapse down, or can spaces bear weight? \$\endgroup\$ – Glen O Aug 24 '15 at 4:30
  • 53
    \$\begingroup\$ "P Prog &uzz Coderam Golflesming", sounds like there's a new candidate for the site's title.. \$\endgroup\$ – jcai Aug 24 '15 at 6:44
  • 1
    \$\begingroup\$ Someone's going to use Marbelous (github.com/marbelous-lang/marbelous.py) ? \$\endgroup\$ – Charlie Aug 26 '15 at 20:11
  • \$\begingroup\$ I decide to use a physics engine and hold a 0 byte \$\endgroup\$ – l4m2 May 21 '18 at 7:05
  • 2
    \$\begingroup\$ Can there be trailing spaces in the output? \$\endgroup\$ – Erik the Outgolfer Jun 15 '18 at 10:23

28 Answers 28

57
\$\begingroup\$

Pyth, 10 bytes

jb_.T.T_.z

Try it online in the Pyth Compiler/Executor.

Idea

We can achieve the desired output by applying four simple transformations:

  1. Reverse the order of the lines:

    Golf
    Code
    &
    Puzzles
    Programming
    
  2. Transpose rows and columns:

    GC&PP
    oour
    ldzo
    fezg
    lr
    ea
    sm
    m
    i
    n
    g
    

    This top justifies, collapsing the original columns.

  3. Transpose rows and columns:

    Golflesming
    Coderam
    &uzz
    Prog
    P
    
  4. Reverse the order of the lines:

    P
    Prog
    &uzz
    Coderam
    Golflesming
    

Code

        .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.
\$\endgroup\$
  • 1
    \$\begingroup\$ Grr, was gonna post exactly this :). Have an upvote instead. \$\endgroup\$ – Maltysen Aug 24 '15 at 4:36
  • \$\begingroup\$ I had plans for posting something similar too... Upvoting too \$\endgroup\$ – WallyWest Aug 24 '15 at 7:49
  • \$\begingroup\$ What happens if you transpose the rows & columns before reversing the order? \$\endgroup\$ – John Odom Aug 26 '15 at 16:34
  • 1
    \$\begingroup\$ @JohnOdom Simply transposing twice will move the characters to the top instead of moving them to the bottom. You can start by transposing, by then you'd have to reverse each row, which would be one byte longer. \$\endgroup\$ – Dennis Aug 26 '15 at 16:38
  • \$\begingroup\$ Holy FoxPro, this was clever. \$\endgroup\$ – workoverflow Jun 18 '18 at 9:43
37
\$\begingroup\$

Haskell, 62 bytes

import Data.List
p=reverse;o=transpose
f=unlines.p.o.o.p.lines

I'm very mature.

\$\endgroup\$
  • 19
    \$\begingroup\$ +1 Because I rarely ever see Haskell, and for pooping lines. \$\endgroup\$ – Carcigenicate Aug 25 '15 at 18:41
17
\$\begingroup\$

Python 2, 104 bytes

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])
\$\endgroup\$
12
\$\begingroup\$

CJam, 11 bytes

qN/W%zzW%N*

Try it online in the CJam interpreter.

How it works

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.
\$\endgroup\$
7
\$\begingroup\$

JavaScript (ES6), 146

(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>

\$\endgroup\$
  • \$\begingroup\$ Reduce a few bytes by replacing S(t.reverse()),t.reverse().join with S(R=t.reverse()),R.join. \$\endgroup\$ – Ismael Miguel Aug 25 '15 at 19:14
  • \$\begingroup\$ @IsmaelMiguel no, S changes t, so t after S is not the same as t before S \$\endgroup\$ – edc65 Aug 25 '15 at 19:31
5
\$\begingroup\$

R, 223 bytes

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.

\$\endgroup\$
5
\$\begingroup\$

Matlab / Octave, 99 bytes

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)

\$\endgroup\$
4
\$\begingroup\$

JavaScript ES6, 119 bytes

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>

\$\endgroup\$
4
\$\begingroup\$

APL (Dyalog Extended), 13 11 bytesSBCS

-2 with my extensions to Dyalog APL.

Anonymous tacit function, taking and returning a character matrix.

~∘' '⍤1⍢⍉⍢⊖

Try it online!

~ remove
 the
' ' spaces
 from
1 rows (lit. 1D sub-arrays)
 while
 transposed
 while
 flipped

\$\endgroup\$
  • \$\begingroup\$ wait how is this 33 bytes? \$\endgroup\$ – Conor O'Brien Oct 18 '16 at 2:55
3
\$\begingroup\$

R, 190 178 175 Bytes

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
>   
\$\endgroup\$
3
\$\begingroup\$

STATA, 323 bytes

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.

\$\endgroup\$
  • \$\begingroup\$ Why would your submission be invalid, just because it requires a non-free compiler? \$\endgroup\$ – Dennis Aug 25 '15 at 15:16
  • \$\begingroup\$ @Dennis I thought that was decided in meta that programming languages must be runnable in some free environment. Also, the restrictions on input length might invalidate it. \$\endgroup\$ – bmarks Aug 25 '15 at 20:25
  • 1
    \$\begingroup\$ The character restriction would be a problem, but I'm not aware of any meta consensus that requires a free implementation. (If you got this idea from the Hello World quiz, that question explicitly asked for free languages.) \$\endgroup\$ – Dennis Aug 25 '15 at 20:47
  • \$\begingroup\$ @Dennis I figured this was a consensus: meta.codegolf.stackexchange.com/questions/988/… \$\endgroup\$ – bmarks Aug 25 '15 at 23:12
  • \$\begingroup\$ The answer suggests downvoting untestable posts, which doesn't really require consensus, and doesn't happen in practice. In fact, Mathematica and TI-BASIC answers are usually quite popular. \$\endgroup\$ – Dennis Aug 25 '15 at 23:21
2
\$\begingroup\$

R, 171 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
\$\endgroup\$
2
\$\begingroup\$

Jelly, 6 bytes (non-competing)

ỴṚZZṚY

Try it online!

How it works

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.
\$\endgroup\$
2
\$\begingroup\$

Turtlèd, 72 bytes, noncompeting

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]

Try it online!

Explanation:

!                          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
\$\endgroup\$
2
\$\begingroup\$

Perl, 133 bytes

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

Usage

Save as vertically-collapse-text.pl.

perl vertically-collapse-text.pl <<< 'Programming
Puzzles
&
Code
Golf'
P
Prog
&uzz
Coderam
Golflesming
\$\endgroup\$
2
\$\begingroup\$

SmileBASIC, 90 bytes

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.

\$\endgroup\$
1
\$\begingroup\$

Ruby, 99 82 bytes

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]
\$\endgroup\$
1
\$\begingroup\$

K, 30

{+{(-#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"
\$\endgroup\$
  • \$\begingroup\$ {+{(-#x)$x@&~^x}'+(|/#:'x)$x} for 29. \$\endgroup\$ – streetster Jun 16 '18 at 10:04
1
\$\begingroup\$

pb - 310 bytes

^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.

\$\endgroup\$
1
\$\begingroup\$

J, 17 bytes

-.&' '"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.)

Test case explained

   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

Test cases

   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|    |    |
+-----------+----+----+
\$\endgroup\$
  • \$\begingroup\$ ;@;:&.(|:@|.) for 13 \$\endgroup\$ – FrownyFrog May 17 at 10:11
1
\$\begingroup\$

Actually, 13 bytes

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.
\$\endgroup\$
1
\$\begingroup\$

Racket 312 bytes

(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")
\$\endgroup\$
1
\$\begingroup\$

JavaScript (ES6), 103 bytes

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.

\$\endgroup\$
1
\$\begingroup\$

Japt, 8 bytes

y kS ù y

Try it online!

How it works

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.

\$\endgroup\$
  • \$\begingroup\$ 7 bytes. Welcome to Japt, by the way (if I haven't welcomed you already). \$\endgroup\$ – Shaggy May 22 '18 at 7:17
1
\$\begingroup\$

05AB1E, 10 9 bytes

¶¡RζðмζR»

Try it online.

or with alternative start:

.BRøðмζR»

Try it online.

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
\$\endgroup\$
1
\$\begingroup\$

R, s81 52 bytes

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"
\$\endgroup\$
  • \$\begingroup\$ Welcome (back) to PPCG! As long as OP is fine with your format, you're safe! the usual way is to ask it in a comment to the question. \$\endgroup\$ – JayCe Jun 15 '18 at 14:58
  • \$\begingroup\$ as mentioned in your answer to another question, answers need to be full fuinctions or programs so function(x) need to be included in the byte count. \$\endgroup\$ – JayCe Jun 15 '18 at 14:59
1
\$\begingroup\$

R, 196 189 170 bytes

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:

  1. Take the first "bad" line, i.e., line which is longer than the next line, take the "extra" part and add it to the next line
  2. Check if there are any "bad" lines left, if yes go to #1

(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"
\$\endgroup\$
0
\$\begingroup\$

Julia 0.6, 141 bytes

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"))

Try it online!

Broadcasting with g.([w], [d d]) allows me to get rid of any map statement and saves me around 7 bytes.

\$\endgroup\$

Your Answer

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

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