Skip to main content
added 200 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17

Wolfram Language (Mathematica), 131 129 120 119 102 98 97 9696 95 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d],L]+v~PadRight~L]~Solve~v,{d,L=Length@#L=Tr[1^#]}];w)&

Try it online!Try it online!

Iterate through the length−1 byte thanks to attinat: we can write L=Tr[1^#] instead of L=Length@# when the outputargument is a list, starting from of numbers.

Code explanation: Iterate through the lengthshrinkage Ld of the(difference between input list minus 1, and going down to length 1output lengths). For each output list length, construct a list of unknowns v and convolve it with the list v={1,0,0x[1],0x[2],...,0,0,1x[L-d]} to stretchand add it to itself left-padded and right-padded to length L (PadLeft[]+PadRight[]PadLeft[v,L]+PadRight[v,L]), then set itthis sum equal to the input list and solve for the unknowns x[1]...x[L-d]. Pick the shortest solution, which is the last one generated: just keep overwriting the variable w every time a solution is found.

F = Function[A,                                  (* A is the input list *)
  Module[{L = Length[A],                         (* length of A *)
          v,                                     (* list of unknowns *)
          x,                                     (* unknowns in v *)
          w = A},                                (* variable for solution, defaults to A *)
    Do[                                          (* loop over shrinkage: d = Length[A]-Length[output] *)
      v = Array[x, L - d];                       (* list of unknowns to be determined *)
      (w = v /. #) & /@                          (* overwrite w with every... *) 
        Solve[                                   (* ...solution of... *)
          Thread[A==PadLeft[vThread[PadLeft[v,L]+PadRight[v,L]]L]==A], (* ...v added to itself, left-justifiedpadded and right-justifiedpadded, equals A *)
          v],                                    (* solve for elements of v *)
    {d, L}];                                     (* loop for shrinkage from 1 to L (the last case d=L is trivial) *)
    w]];                                         (* return the last solution found *)

Wolfram Language (Mathematica), 131 129 120 119 102 98 97 96 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d],L]+v~PadRight~L]~Solve~v,{d,L=Length@#}];w)&

Try it online!

Iterate through the length of the output list, starting from the length L of the input list minus 1, and going down to length 1. For each output list length, construct a list of unknowns v and convolve it with the list {1,0,0,0,...,0,0,1} to stretch it to length L (PadLeft[]+PadRight[]), then set it equal to the input list and solve for the unknowns. Pick the shortest solution, which is the last one generated: just keep overwriting the variable w every time a solution is found.

F = Function[A,                                  (* A is the input list *)
  Module[{L = Length[A],                         (* length of A *)
          v,                                     (* list of unknowns *)
          x,                                     (* unknowns in v *)
          w = A},                                (* variable for solution, defaults to A *)
    Do[                                          (* loop over shrinkage: d = Length[A]-Length[output] *)
      v = Array[x, L - d];                       (* list of unknowns to be determined *)
      (w = v /. #) & /@                          (* overwrite w with every... *) 
        Solve[                                   (* ...solution of... *)
          Thread[A==PadLeft[v,L]+PadRight[v,L]], (* ...v added to itself, left-justified and right-justified, equals A *)
          v],                                    (* solve for elements of v *)
    {d, L}];                                     (* loop for shrinkage from 1 to L (the last case d=L is trivial) *)
    w]];                                         (* return the last solution found *)

Wolfram Language (Mathematica), 131 129 120 119 102 98 97 96 95 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d],L]+v~PadRight~L]~Solve~v,{d,L=Tr[1^#]}];w)&

Try it online!

−1 byte thanks to attinat: we can write L=Tr[1^#] instead of L=Length@# when the argument is a list of numbers.

Code explanation: Iterate through the shrinkage d (difference between input and output lengths). For each output list length, construct a list of unknowns v={x[1],x[2],...,x[L-d]} and add it to itself left-padded and right-padded to length L (PadLeft[v,L]+PadRight[v,L]), then set this sum equal to the input list and solve for the unknowns x[1]...x[L-d]. Pick the shortest solution, which is the last one generated: just keep overwriting the variable w every time a solution is found.

F = Function[A,                                  (* A is the input list *)
  Module[{L = Length[A],                         (* length of A *)
          v,                                     (* list of unknowns *)
          x,                                     (* unknowns in v *)
          w = A},                                (* variable for solution, defaults to A *)
    Do[                                          (* loop over shrinkage: d = Length[A]-Length[output] *)
      v = Array[x, L - d];                       (* list of unknowns to be determined *)
      (w = v /. #) & /@                          (* overwrite w with every... *) 
        Solve[                                   (* ...solution of... *)
          Thread[PadLeft[v,L]+PadRight[v,L]==A], (* ...v added to itself, left-padded and right-padded, equals A *)
          v],                                    (* solve for elements of v *)
    {d, L}];                                     (* loop for shrinkage from 1 to L (the last case d=L is trivial) *)
    w]];                                         (* return the last solution found *)
added 4 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17

Wolfram Language (Mathematica), 131 129 120 119 102 98 9797 96 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d],L]+v~PadRight~L]~Solve~v,{d,L=Length@#}];w)&;&

Try it online!Try it online!

Wolfram Language (Mathematica), 131 129 120 119 102 98 97 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d],L]+v~PadRight~L]~Solve~v,{d,L=Length@#}];w)&;

Try it online!

Wolfram Language (Mathematica), 131 129 120 119 102 98 97 96 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d],L]+v~PadRight~L]~Solve~v,{d,L=Length@#}];w)&

Try it online!

deleted 159 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17

Wolfram Language (Mathematica), 131 129 120 119 102102 98 97 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d+1],L]+PadRight[vd],L]]~Solve~vL]+v~PadRight~L]~Solve~v,{d,2,L=Length@#}];w)&;

Try it online!Try it online!

Un-golfed version:

F = Function[A,                                  (* A is the input list *)
  Module[{L = Length[A],                         (* length of A *)
          v,                                     (* list of unknowns *)
          x,                                     (* unknowns in v *)
          w = A},                                (* variable for solution, defaults to A *)
    Do[                                          (* loop over shrinkage: d = Length[A]-Length[output] *)
      v = Array[x, L - d];                       (* list of unknowns to be determined *)
      (w = v /. #) & /@                          (* overwrite w with every... *) 
        Solve[                                   (* ...solution of... *)
          Thread[A==PadLeft[v,L]+PadRight[v,L]], (* ...v added to itself, left-justified and right-justified, equals A *)
          v],                                    (* solve for elements of v *)
    {d, L}];                                     (* loop for shrinkage from 1 to L (the last case d=L is trivial) *)
    w]];                                         (* return the last solution found *)

Wolfram Language (Mathematica), 131 129 120 119 102 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d+1],L]+PadRight[v,L]]~Solve~v,{d,2,L=Length@#}];w)&;

Try it online!

Wolfram Language (Mathematica), 131 129 120 119 102 98 97 bytes

(w=#;Do[(w=v/.#)&/@Thread[#==PadLeft[v=Array[x,L-d],L]+v~PadRight~L]~Solve~v,{d,L=Length@#}];w)&;

Try it online!

Un-golfed version:

F = Function[A,                                  (* A is the input list *)
  Module[{L = Length[A],                         (* length of A *)
          v,                                     (* list of unknowns *)
          x,                                     (* unknowns in v *)
          w = A},                                (* variable for solution, defaults to A *)
    Do[                                          (* loop over shrinkage: d = Length[A]-Length[output] *)
      v = Array[x, L - d];                       (* list of unknowns to be determined *)
      (w = v /. #) & /@                          (* overwrite w with every... *) 
        Solve[                                   (* ...solution of... *)
          Thread[A==PadLeft[v,L]+PadRight[v,L]], (* ...v added to itself, left-justified and right-justified, equals A *)
          v],                                    (* solve for elements of v *)
    {d, L}];                                     (* loop for shrinkage from 1 to L (the last case d=L is trivial) *)
    w]];                                         (* return the last solution found *)
deleted 159 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17
Loading
added 104 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17
Loading
deleted 16 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17
Loading
deleted 16 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17
Loading
added 9 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17
Loading
added 176 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17
Loading
added 360 characters in body
Source Link
Roman
  • 2k
  • 9
  • 17
Loading
Source Link
Roman
  • 2k
  • 9
  • 17
Loading