Doubled-letter steganography

Question

Steganography hides a given message inside a given carrier, producing a package that does not look suspicious. For this challenge, you will write a program that takes an ASCII message and an ASCII carrier as input, and return or print a package that is identical to the carrier except characters corresponding to the message are doubled, in the same order that they appear in the message.

Rules:

1. If the carrier already contains sequences of the same character more than once, and they are not used to encode a character of the message, the program will reduce them to a single character.
2. If the carrier does not contain the message characters in the right order, the program may return nothing, the carrier itself, or an error.
3. You may assume that the message and carrier are non-empty ASCII strings.
4. Capitalization matters: A is not equivalent to a.
5. When more than one package is valid, your program may output any or all of them.
6. Space is a character like any other character.

Test cases:

Message      Carrier              Package
"hi"         "has it arrived?"    "hhas iit arived?" OR "hhas it ariived?"
"sir"        "has it arrived?"    "hass iit arrived?"
"foo"        "has it arrived?"    "" OR "has it arrived?" OR an error.
"Car"        "Cats are cool."     "CCaats arre col."
"car"        "Cats are cool."     "" OR "Cats are cool." OR an error.
"Couch"      "Couch"              "CCoouucchh"
"oo"         "oooooooooo"         "oooo"
"o o"        "oooo oooa"          "oo  ooa"

This is code golf, so fewest bytes wins.

Answer 1

Jelly, 28 bytes

ẹⱮŒp<ƝẠ$ƇṪ
nƝ+çṬ¥a⁸ḟ0Ḥç¦ð¹ç?

A full program taking carrier and message as command line arguments which prints the result
(For a non-packable message prints the unchanged carrier).

Try it online! Or see the test-suite.

How?

ẹⱮŒp<ƝẠ$ƇṪ - Link 1, helper function to find the indices to double: carrier, message
           -                               e.g. "programming", "rom"
 Ɱ         - map across message with:
ẹ          -   indices of                       [[2,5], [3], [7,8]]
  Œp       - Cartesian product                  [[2,3,7],[2,3,8],[5,3,7],[5,3,8]]
        Ƈ  - filter keep if:
       $   -   last two links as a monad:
     Ɲ     -     for neighbours:
    <      -       less than?                    [1,1]   [1,1]   [0,1]   [0,1]
      Ạ    -     all truthy?                     1       1       0       0
           -                                    [[2,3,7],[2,3,8]]
         Ṫ - tail (if empty yields 0)                    [2,3,8]

nƝ+çṬ¥a⁸ḟ0Ḥç¦ð¹ç? - Main Link: carrier, message
                ? - if...
               ç  - ...condition: last Link (the helper function) as a dyad
             ð    - ...then: perform the dyadic chain to the left (described below)
              ¹   - ...else: do nothing (yields carrier)
                  - (the then clause:)
 Ɲ                - for neighbours in the carrier
n                 - not equal?
     ¥            - last two links as a dyad:
   ç              -   call last Link (the helper function) as a dyad
    Ṭ             -   untruth (e.g. [2,5] -> [0,1,0,0,1])
  +               - add (vectorises)
      a⁸          - logical AND with carrier
        ḟ0        - filter out zeros
            ¦     - sparse application...
           ç      - ...to indices: call last Link (the helper function) as a dyad
          Ḥ       - ...do: double (e.g. 'x' -> 'xx')

Answer 2

JavaScript (ES6), 71 bytes

Takes input as (message)(carrier).

s=>g=([c,...C],p)=>c?(c==s[0]?(s=s.slice(1),c)+c:p==c?'':c)+g(C,c):s&&X

Try it online!

---

Alternate version, 66 bytes

If we can take the message as an array of characters:

s=>g=([c,...C],p)=>c?(c==s[0]?s.shift()+c:p==c?'':c)+g(C,c):s+s&&X

Try it online!

---

Edit: Thanks to @tsh for noticing that I forgot to remove some code when switching from non-recursive to recursive versions.

Answer 3

Haskell, 124 121 107 101 97 95 90 bytes

(#).(++"ü")
"ü"#[]=[]
p@(m:n)#e@(c:d)|m/=c=c:p#snd(span(==c)d)|m==n!!0=m:m:n#d|1<2=m:n#e

Raises the "Non-exhaustive patterns" exception if the carrier does not contain the message.

Try it online!

Edit: -5 bytes thanks to @Laikoni.

Answer 4

Retina 0.8.2, 67 bytes

+`(.)(\1*)\1*(.*¶)(?(\1)(\1(\2)))(.*)$(?!¶)
$1$4$5¶$3$6
M!s`.*¶$
¶

Try it online! Takes the carrier on the first line and the message on the second line. Explanation:

+`(.)(\1*)\1*(.*¶)(?(\1)(\1(\2)))(.*)$(?!¶)
$1$4$5¶$3$6

Process runs of 1 or more identical characters of the carrier. If there is also a run of 1 or more of the same characters in the message, then append the shorter of the two runs to the output in duplicate, otherwise append a single character of the carrier to the output. Each run of output characters is terminated with a newline to distinguish it from the input. The (?!¶) at the end prevents the regex from thinking the carrier is the message once the message is exhausted, as normally $ is allowed to match where ¶$ would match.

M!s`.*¶$

Delete everything if the message wasn't completely encoded.

¶

Remove the newlines from the output.

Answer 5

Clean, 118 bytes

import StdEnv,StdLib
$[][]=[]
$[u:v]b#(_,w)=span((==)u)v
|b%(0,0)==[u]=[u,u: $if(v%(0,0)<>b%(1,1))w v(tl b)]=[u: $w b]

Try it online!

Takes the carrier first, then the message.

Errors with Run time error, rule '$;2' in module 'main' does not match if message won't fit.

Answer 6

Ruby, 73 bytes

f=->m,c,b=p{x,*c=c;x ?(x==m[0]?x+m.shift: x==b ?'':x)+f[m,c,x]:m[0]?x:''}

Try it online!

Recursive function, takes inputs as array of characters.

For once I was hoping to make use of Ruby's built-in squeeze method that contracts consecutive runs of the same character to a single instance. But unfortunately, nope - the last two test cases screwed everything so badly, that I had to resort to a completely different approach, and this turned out to be basically a port of Arnauld's answer.

Answer 7

Powershell, 134 bytes

param($m,$c)$c-csplit"([$m])"|%{$i+=$o=$_-ceq$m[+$i]
if($o-or$_-cne"`0$h"[-1]){$h+=($_-replace'(.)(?=\1)')*($o+1)}}
$h*!($i-$m.Length)

The script returns the empty string if the carrier does not contain the message characters in the right order.

Less golfed test script:

$f = {

param($message,$carrier)
$carrier-csplit"([$message])"|%{                # split by chars of the message, chars itself included ([])
    $offset=$_-ceq$message[+$i]                 # 0 or 1 if current substring is a current message char (case-sensitive equality)
    $i+=$offset                                 # move to next message char if need it
    if($offset-or$_-cne"`0$h"[-1]){             # condition to remove redundant doubles after message char: arrrived -> arrived, ooo -> oo, etc
                                                # `0 to avoid exception error if $h is empty
        $h+=($_-replace'(.)(?=\1)')*($offset+1) # accumulate a double message char or a single substring without inner doubles: arried -> arived, anna -> ana, etc
    }
}
$h*!($i-$message.Length)                        # repeat 0 or 1 times to return '' if the carrier does not contain the message characters in the right order

}

@(
    ,('hi'         ,'has it arrived?'    ,'hhas iit arived?', 'hhas it ariived?')
    ,('hi?'        ,'has it arrived?'    ,'hhas iit arived??', 'hhas it ariived??')
    ,('sir'        ,'has it arrived?'    ,'hass iit arrived?')
    ,('foo'        ,'has it arrived?'    ,'')
    ,('Car'        ,'Cats are cool.'     ,'CCaats arre col.')
    ,('car'        ,'Cats are cool.'     ,'')
    ,('Couch'      ,'Couch'              ,'CCoouucchh')
    ,('oo'         ,'oooooooooo'         ,'oooo')
    ,('o o'        ,'oooo oooa'          ,'oo  ooa')
    ,('er'         ,'error'              ,'eerorr', 'eerror')
    ,('a+b'        ,'anna+bob'           ,'aana++bbob')
) | % {
    $message,$carrier,$expected = $_
    $result = &$f $message $carrier
    "$($result-in$expected): $result"
}

Output:

True: hhas iit arived?
True: hhas iit arived??
True: hass iit arrived?
True:
True: CCaats arre col.
True:
True: CCoouucchh
True: oooo
True: oo  ooa
True: eerror
True: aana++bbob

Answer 8

C (gcc), 69+12 = 81 bytes

g(char*m,char*_){for(;*_;++_)*m-*_?_[-1]-*_&&p*_):p p*m++));*m&&0/0;}

Compile with (12 bytes)

-Dp=putchar(

Try it online!

g(char*m,char*_){
    for(;*_;++_)        //step through _
        *m-*_?          //check if character should be encoded
            _[-1]-*_&&  //no? skip duplicates
                p*_)    //    print non-duplicates
        :p p*m++));     //print encoded character twice
    *m&&0/0;            //if m is not fully encoded, exit via Floating point exception
}