проверка строки в Mathematica

Question

У меня есть функция проверки строки, которую я хочу оптимизировать. Строка имеет длину 2n и состоит из 0 и 1, например, str="100001". Я хочу проверить:

1) равно ли число (должно быть не менее 1) 1 в нечетно проиндексированных позициях в строке тому же числу, что и в равномерно индексированных позициях

2) если для каждого StringTake[str,2*i], i работает от 1 до n-1, число 1 в нечетно проиндексированных позициях в строке не равно количеству в равномерно индексированных позициях .

В сумме я хочу проверить, равна ли позиция 2n 1018 * в первый раз число 1 в нечетно индексированных позициях в строке равно количеству в равномерно индексированных позициях ,

"100001" и 101101 - хорошая строка, но не 100100, 100000 или 000000.

Большое спасибо.

Answer 1

Этот код не проверяет наличие недопустимых строк (символы не "0" или "1", длина не четная).

goodString[str_String] := Module[
  {digits, cumdiffs, pos},
  digits = Transpose[Partition[
    IntegerDigits[ToExpression[str], 10, StringLength[str]], 2]];
  cumdiffs = Subtract @@ Accumulate /@ digits;
  pos = Position[cumdiffs, 0, 1, 1];
  Length[pos] == 1 && pos[[1, 1]] == Length[cumdiffs]
]

Ваши примеры:

goodString /@ {"100001" , "101101", "100100", "100000", "000000"}

Out [302] = {True, True, False, False, False}

Там могут быть более быстрые способы, например с NestList. Также, если скорость является большой проблемой и строки, вероятно, будут длинными, вы можете разделить IntegerDigits [ToExpression [...]] при предварительной обработке и использовать Compile для остальных.

Даниэль Лихтблау Wolfram Research

Answer 2

(извиняюсь за код школьника, это моя первая попытка работы со Strings в Mathematica, поэтому я оставил в своем размышлении, а также некоторые закомментированные значения отладки / трассировки)

charcountsvec[s_String, c_String] := Table[
   If[StringTake[s, {i, i}] == c, 1, 0]
   , {i, 1, StringLength[s]}
];

oddchars[s_String] := StringTake[s, {1, -1, 2}]; (*pick out odd chars*)    
evenchars[s_String] := StringTake[s, {2, -1, 2}];

validatestr[str_String] :=     
 Block[{evencounts, oddcounts, answer1, answer2 (*, odds, evens*)},
  evencounts = Accumulate@charcountsvec[(*evens=*)evenchars[str], "1"];
  oddcounts = Accumulate@charcountsvec[(*odds=*)oddchars[str], "1"];
  (*my interpretation of "number of 1's in odd positions the same as in even positions"*)      
  answer1 = Last[oddcounts] == Last[evencounts]; 
  (*my interpretation of "for every..string...whether number of 1's in even/odd positions is not equal"*)      
  answer2 = Fold[And, True, 
    MapThread[Unequal, {Most[oddcounts], Most[evencounts]}]];

  {str, And[answer1, answer2](*,odds,evens,oddcounts,evencounts,answer1,answer2*)}
  ];

Тестирование:

validatestr/@{"100001","101101","100100","100000","000000"}

{{"100001", True}, {"101101", True}, {"100100", False}, {"100000", False}, {"000000", False}}

validatestr["0000001"](*odd length string pukes, and returns False*)

Во время оценки (Локальный) В [428]: = MapThread :: mptc: Несовместимые размеры объектов в позициях {2, 1} и {2, 2} MapThread [Unequal, {{0,0,0} , {0,0}}]; размеры: {3} и {2}. >>

(Локальный) Out [432] = {"0000001", False}