2
$\begingroup$

I want to use Mathematica to solve the following problem:

For example I have a sequence 101. I want to compare it with $1101$ and $0101$. The comparison has the following procedure:

  1. Check the first term of $101$ is $1$ or $0$. If it is $1$, compare $101$ to $1101$, term by term; If it is $0$, compare $101$ to $0101$. Stop the process before the first term they are different, or all the terms of $101$ have been compared without stopping the process, and report all the terms that have been compared.

In our case, the first term of $101$ is $1$, so we compare it with $1101$. Then, $101$ and $1101$ only has one term in common, the first term $1$. So the program should report $1$, and go to next step.

  1. Recording the remaining sequence of $101$.

In our case, as only $1$ is reported, the remaining sequence is $01$.

  1. Restart the process. Check the first term of $01$ is $0$ or $1$. If it $0$, compare $01$ with $0101$, if it is $1$, compare $01$ with $1101$. Stop the process before the first term they are different, or the sequence of $01$ has been run out. Report all the timers that have been compared.

*In our case, the first term of $01$ is $0$, so we compare $01$ with $0101$. Then the first two terms agree, and then $01$ ran out. The program should report $01$, and then stop.

  1. Repeating the process again and again until there is no remaining sequence.

I tried to use the commend "If" to write this but it did not work, since I did not know how to let Mathematica to "remember" what has been compared.

Then, I tried to use commend "Order" and "Sort", but it seems that I need to program a comparison function.

Is there anyway for me to achieve this using Mathematica? Thank you!

$\endgroup$

2 Answers 2

3
$\begingroup$

Update: We can use Split to get the desired result in a single step:

ClearAll[sPlit] sPlit[s0_, s1_][s_] := Module[{ref, x = Characters @ s}, ref["0"] = Characters @ s0; ref["1"] = Characters @ s1; Module[{i = 0, rf = ref[x[[1]]]}, StringJoin /@ Split[x, Or[{##} == rf[[{i++, i}]], i = 1; rf = ref[#2]] &]]] 

Examples:

sPlit["0101", "1101"]["101"] 
 {"1", "01"} 
sPlit["010111010", "110111010"]["10111010"] 
 {"1", "01", "1101", "0"} 
sPlit[s0, s1][s] (* s, s0, s1 from the original answer below *) 
 {"0", "1", "1", "101", "001", "0", "101", "0", "1"} 

Original answer:

ClearAll[lW, tD, steP, fP] lW[l0_, l1_][x_] := LengthWhile[Range @ Length @ x, x[[#]] == l0[[#]] || x[[#]] == l1[[#]] &] tD[l0_, l1_][x_] := TakeDrop[x, lW[l0, l1][x]] steP[l0_, l1_][{a___, b_List /; Length[b] > 0}] := {a, ## & @@ tD[l0, l1][b]} steP[l0_, l1_][a : {___, {}}] := a fP[s0_String, s1_String][s_String] := Module[{c = Characters /@ {s0, s1, s}}, StringJoin /@ Most[FixedPoint[steP[c[[1]], c[[2]]], {c[[3]]}]]] 

Examples:

fP["0101", "1101"]["101"] 
 {"1", "01"} 
fP["010111010", "110111010"]["10111010"] 
{"1", "01", "1101", "0"} 
SeedRandom[123] s = RandomChoice[{"0", "1"}, 15]; {s, s0, s1} = StringJoin /@ {s, Prepend["0"]@s, Prepend["1"]@s} 
{"011101001010101", "0011101001010101", "1011101001010101"} 
fP[s0, s1][s] 
{"0", "1", "1", "101", "001", "0", "101", "0", "1"} 
$\endgroup$
1
  • $\begingroup$ OMG. Nice answer!!! $\endgroup$ Commented Nov 14, 2020 at 15:06
2
$\begingroup$

Such a Reading comprehension :)

Split the string:

a = StringSplit["101", ""] b = StringSplit["1101", ""] 

Get the large position by using NestWhile:

maxPos = NestWhile[# + 1 &, 1, a[[#]] == b[[#]] &] - 1 

1

a[[1 ;; maxPos]] 

{"1"}

The remaining items:

Take[a, Length@a - maxPos] 

{"1", "0"}

Then Get the large position by using NestWhile:, repeat it.

I'll leave the left to you :)

$\endgroup$
1
  • $\begingroup$ Thank you so much! And thank you for reading my long post :)) Brilliant code $\endgroup$ Commented Nov 14, 2020 at 15:05

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.