一个有限制的排序算法题

老刘1号

昨天群里看到的，

【吐槽】Tiger<haotian.fan@qq.com> 下午 2:09:55
网上看见一道题目，问下大家，
如果一个List只能移动第一项，请问如何排序？
【中华】zhonghua(1138520994) 下午 3:02:33
@Tiger Tiger 只能移动第一项是啥意思，栈之类的结构么
【吐槽】Tiger<haotian.fan@qq.com> 下午 3:02:56
就比如说 5 1 3 2 4只能移动5，不能移动其他元素
【吐槽】Tiger<haotian.fan@qq.com> 下午 3:03:11
stack overflow看到的，有点解不开
【中华】zhonghua(1138520994) 下午 3:04:28
这个移动是啥意思
pop（0）？
【吐槽】Tiger<haotian.fan@qq.com> 下午 3:04:54
比如说移到3后面就编程1 3 5 2 4

我的解法(伪插入排序，效率底下，各位大佬见笑)：

@echo off
Setlocal enabledelayedexpansion
::CODER BY 老刘 POWERD BY iBAT
Set /p List=
Call :GetList !List!
Set /A Count=1
:Loop 首项逆向比较
	Set /A Flag1=0
	For /l %%a in (!prt! -1 1) Do (
		If !.1! Gtr !.%%a! (
			Call :MoveTo %%a
			Set /A Flag1=1
			Goto :JmpOut
		)
	)
	:JmpOut
	If !Flag1! Equ 1 Goto Loop
	Set /A Count+=1
	If !Count! Leq !prt! (
		Call :MoveTo !Count!
		Goto :Loop
	)
	For /l %%a in (1 1 !prt!) Do Set .%%a
pause&"%~0"
 
:GetList
	Set /A Prt=0
	Set list=%*
	For %%a In (%*) Do (
		Set /A Prt+=1
		Set .!Prt!=%%a
	)
Goto :Eof
 
:MoveTo 移动到原先第%1项的后面
	Set /A #=.1
	For /l %%a in (1 1 %1) Do (
		Set /A PlusOne=%%a+1
		Set /A .%%a=.!PlusOne!
	)
	Set /A .%1=#
Goto :EofCOPY

523066680

回复 1# 老刘1号

问题1，只有首个元素可以移动，他可以移动到任意位置吗
若按C数组操作，如果你可以移动到中间位置，那不是还等于其他元素也可以移动了
问题2，想看stackoverflow原帖，也许是leetcode上面的题目？

老刘1号

回复 2# 523066680


    刚去拷问了一波问主，原话

每次移动完以后，只能移动第一个，插入以后，列表开头就是新的可移动元素

523066680

int a[5] = {a,b,c,d,e} 把数组变成 {b,c,a,d,e}
b和c 不是从 1,2的位置变成了 0,1的位置吗。（这种允许的话，感觉跟打牌手法的插入排序差不多。）

除非说这是一个定制的数据结构，每个数之间有足够的间隙，开头的数字可以插入任意数字中间而其他数字不需要移动。
比如 a,,,,b,,,,c,,,,d,,,,e,,,,

回复 5# 老刘1号
    不纠结数据结构，纠结的是描述。觉得你现在的描述就比较合理了，其他数字被动移动。

老刘1号

回复 4# 523066680


    总觉得不需要纠结结构……
我觉得问主的意思就是，第一个随意移动，其余的被动移动，顺便改变位置

老刘1号

补一个优化版

@echo off
Setlocal enabledelayedexpansion
::CODER BY 老刘 POWERD BY iBAT
Set /p List=
Call :GetList !List!
Set /A Count=1
:Loop
	Rem 首项逆向比较
	Set /A Flag1=0
	For /l %%a in (!prt! -1 1) Do (
		If !.1! Gtr !.%%a! (
			Call :MoveTo %%a
			set/p=移动到%%a后：<nul
			For /l %%a in (1 1 !prt!) Do Set/p=!.%%a!-<nul
			Echo.
			Set /A Flag1=1
			Goto :JmpOut
		)
	)
	:JmpOut
	If !Flag1! Equ 1 Goto Loop
	
	Rem 判断是否排序完成。
	Set /A Flag2=0
	For /l %%a in (1 1 !prt!) Do (
		Set /A PlusOne=%%a+1
		Set /A "#=.!PlusOne!"
		If !#! Lss !.%%a! (
			Set Flag2=1
			If %%a equ !prt! Set Flag2=0
			Goto :JmpOut2
		)
	)
	:JmpOut2
	If !Flag2! Equ 0 Goto End
	
	Rem 继续排序
	Set /A Count+=1
	If !Count! Leq !prt! (
		Call :MoveTo !Count!
		Set/p=移动到!Count!后：<nul
		For /l %%a in (1 1 !prt!) Do Set/p=!.%%a!-<nul
		Echo.
		Goto :Loop
	)
	:End
	For /l %%a in (1 1 !prt!) Do Set/p=!.%%a!-<nul
Echo.&pause&"%~0"
 
:GetList
	Set /A Prt=0
	Set list=%*
	For %%a In (%*) Do (
		Set /A Prt+=1
		Set .!Prt!=%%a
	)
Goto :Eof
 
:MoveTo 移动到原先第%1项的后面
	Set /A #=.1
	For /l %%a in (1 1 %1) Do (
		Set /A PlusOne=%%a+1
		Set /A .%%a=.!PlusOne!
	)
	Set /A .%1=#
Goto :EofCOPY

5 1 3 2 4
移动到5后：1-3-2-4-5-
移动到2后：3-1-2-4-5-
移动到3后：1-2-3-4-5-
1-2-3-4-5-
请按任意键继续. . .
3 2 1
移动到3后：2-1-3-
移动到2后：1-2-3-
1-2-3-
请按任意键继续. . .
7 3 4 1 10 9 8 11 24
移动到4后：3-4-1-7-10-9-8-11-24-
移动到3后：4-1-3-7-10-9-8-11-24-
移动到3后：1-3-4-7-10-9-8-11-24-
移动到2后：3-1-4-7-10-9-8-11-24-
移动到2后：1-3-4-7-10-9-8-11-24-
移动到3后：3-4-1-7-10-9-8-11-24-
移动到3后：4-1-3-7-10-9-8-11-24-
移动到3后：1-3-4-7-10-9-8-11-24-
移动到4后：3-4-7-1-10-9-8-11-24-
移动到4后：4-7-1-3-10-9-8-11-24-
移动到4后：7-1-3-4-10-9-8-11-24-
移动到4后：1-3-4-7-10-9-8-11-24-
移动到5后：3-4-7-10-1-9-8-11-24-
移动到5后：4-7-10-1-3-9-8-11-24-
移动到5后：7-10-1-3-4-9-8-11-24-
移动到5后：10-1-3-4-7-9-8-11-24-
移动到7后：1-3-4-7-9-8-10-11-24-
移动到6后：3-4-7-9-8-1-10-11-24-
移动到6后：4-7-9-8-1-3-10-11-24-
移动到6后：7-9-8-1-3-4-10-11-24-
移动到6后：9-8-1-3-4-7-10-11-24-
移动到6后：8-1-3-4-7-9-10-11-24-
移动到5后：1-3-4-7-8-9-10-11-24-
1-3-4-7-8-9-10-11-24-
请按任意键继续. . .
1 2 3 5 4
移动到2后：2-1-3-5-4-
移动到2后：1-2-3-5-4-
移动到3后：2-3-1-5-4-
移动到3后：3-1-2-5-4-
移动到3后：1-2-3-5-4-
移动到4后：2-3-5-1-4-
移动到4后：3-5-1-2-4-
移动到4后：5-1-2-3-4-
移动到5后：1-2-3-4-5-
1-2-3-4-5-
请按任意键继续. . .COPY

523066680

有缺陷/未完成，大概方向，unshift 取出首个数字，和剩下的各个元素做减法，找出相差距离最近的数字（分为L和R）的对应坐标，插入。可能做足判断会好一些，待完善。

my @arr = qw/5 1 9 3 2 4 6/;
my ($first, $L,$R,$r_id, $l_id, $dt);
my $max = 100000;
 
for (1..5)
{
    $first = shift @arr;
    $L = -$max;
    $R = $max;
    $r_id = 0;
    $l_id = 0;
    for $i ( 0 .. $#arr ) {
        $dt = $arr[$i] - $first;
        if ( $dt > 0 && $dt <= $R) { $r_id = $i, $R = $dt; }
        if ( $dt < 0 && $dt >= $L) { $l_id = $i, $L = $dt; }
    }
 
    if ( $R == $max ) {
        push @arr, $first;
    } else {
        splice( @arr, $r_id, 0, $first );
    }
    #printf "%d - %d: %d, %d: %d\n", $first, $l_id, $L, $r_id, $R;
    print join(",", @arr), "\n";
}
 
#print join("", @arr);COPY

1,9,3,2,4,5,6
9,3,1,2,4,5,6
3,1,2,4,5,6,9
1,2,3,4,5,6,9

特地找一副扑克牌玩了一下，为啥人玩起来就这么自然…… 转成代码总是有纰漏，
纠正了某些情况下不能完全处理的问题，也未经过严格验证，暂时这样。

my @arr = qw/7 3 4 1 10 9 8 11 24/;
my ($first, $L,$R,$r_id, $l_id, $dt);
my $max = 100000;
my $ok = 0;
 
while (1)
{
    $first = shift @arr;
    $L = -$max;
    $R = $max;
    $r_id = 0;
    $l_id = 0;
    for $i ( 0 .. $#arr ) {
        $dt = $arr[$i] - $first;
        if ( $dt > 0 && $dt <= $R) { $r_id = $i, $R = $dt; }
        if ( $dt < 0 && $dt >= $L) { $l_id = $i, $L = $dt; }
    }
 
    if ( $L != -$max )
    {
        # 如果有相对较小的数字，优先移至最邻近者
        splice( @arr, $l_id+1, 0, $first );
    } else {
        if ( $R == $max ) {
            # 如果未找到更大的数字，直接堆到最后
            push @arr, $first;
        } else {
            # 判断数组中是否还有 左边大于右边的情况
            $ok = 1;
            for my $i ( 0 .. $#arr-1 ) {
                if ( $arr[$i] > $arr[$i+1] ) {
                    splice( @arr, $i+1, 0, $first );
                    $ok = 0;
                    last;
                }
            }
            last if $ok;
        }
    }
    #printf "%d -- [%d]: %d, [%d]: %d\n", $first, $l_id, $L, $r_id, $R;
    print join(",", @arr), "\n";
}COPY

3,4,7,1,10,9,8,11,24
4,7,1,3,10,9,8,11,24
7,1,3,4,10,9,8,11,24
1,3,4,7,10,9,8,11,24
3,4,7,10,1,9,8,11,24
4,7,10,1,3,9,8,11,24
7,10,1,3,4,9,8,11,24
10,1,3,4,7,9,8,11,24
1,3,4,7,9,10,8,11,24
3,4,7,9,10,1,8,11,24
4,7,9,10,1,3,8,11,24
7,9,10,1,3,4,8,11,24
9,10,1,3,4,7,8,11,24
10,1,3,4,7,8,9,11,24
1,3,4,7,8,9,10,11,24COPY

2,3,5,1,4
3,5,1,2,4
5,1,2,3,4
1,2,3,4,5COPY

老刘1号

回复 7# 523066680


    好思路，若完成效率应该比我那个高
250技术不忍破坏

523066680

回复 8# 老刘1号

    已更新

老刘1号

回复 9# 523066680


    若不考虑效率的话，感觉可以把只移动首个元素这个限制用一个算法去除掉，直接完成任意两元素交换。

a b c d e f
b <-- --> e
b c d e f a
c d e b f a
d e b f a c
e b f a c d
b f a e c d
f a e c d b
a e c d b f

a b c d e f
a <-- --> c
b c a d e f
c a d e f b
a d e f c b
d e f c b a
e f c b a d
f c b a d e
c b a d e f

a b c
a <-- --> c
b c a
c a b
a c b
c b a

脑补算法中

523066680

试试粗暴一点，递归求不同解、最优解。（逻辑不够完整，怕卡太久，限制了层数 lv <= 5），

my @arr = qw/8 9 1 2 5/;
my @order = ();
our @ways;
solver(0, \@order, @arr);
 
my $first;
for my $w ( @ways )
{
    printf "Solution: %s\n", join(",", @$w);
    my @brr = @arr;
    for my $mov ( @$w )
    {
        $first = shift @brr;
        splice( @brr, $mov, 0, $first );
        printf "%s\n", join(",", @brr);
    }
    printf "\n";
}
 
sub solver
{
    my ($lv, $order) = (shift, shift);
    my @arr = @_;
    my @brr;
    my $first;
    my $res;
    return if $lv == 5;
    if (check(\@arr) == -1) {
        #printf "[%d] %s %s\n", $lv, join(",", @arr), join(",", @brr);
        for my $i ( 1 .. $#arr ) {
            @brr = @arr[1..$#arr];
            splice(@brr, $i, 0, $arr[0] );
            $order[$lv] = $i;
            $res = solver( $lv+1, $order, @brr );
            #if ( $res == 1 ) {last;}
        }
        return 1 if $res == 1;
    } else {
        #printf "%s\n", join(",", @arr);
        push @ways, [@{$order}[0..$lv-1] ];
        return 1;
    }
}
 
sub check
{
    my $ar = shift;
    grep { return -1 if ( $ar->[$_] > $ar->[$_+1] ) } ( 0 .. $#$ar-1);
    return 1;
}COPY

Solution: 1,1,4,4
9,8,1,2,5
8,9,1,2,5
9,1,2,5,8
1,2,5,8,9
 
Solution: 1,4,3
9,8,1,2,5
8,1,2,5,9
1,2,5,8,9
 
Solution: 2,4,1,3
9,1,8,2,5
1,8,2,5,9
8,1,2,5,9
1,2,5,8,9
 
Solution: 4,1,1,4
9,1,2,5,8
1,9,2,5,8
9,1,2,5,8
1,2,5,8,9
 
Solution: 4,4
9,1,2,5,8
1,2,5,8,9
 
[Finished in 0.1s]COPY

粗暴中发现那个数组的处理过程可以更短，6次解决：

Move Steps: 5,5,5,2,6,5
3,4,7,1,10,9,8,11,24 <- Original
4,7,1,10,9,3,8,11,24
7,1,10,9,3,4,8,11,24
1,10,9,3,4,7,8,11,24
10,9,1,3,4,7,8,11,24
9,1,3,4,7,8,10,11,24
1,3,4,7,8,9,10,11,24COPY

523066680

回复 1# 老刘1号

    Tiger就是那个初中一年级，做MIT英文原版数学试卷、精通C++、Python、JAVA，熟练 PyTorch、 Tensorflow、会写CNN DNN RNN KNN，的神奇少年吗。
看到那个群里这么多大神，吓得我退群点了个外卖。

老刘1号

回复 12# 523066680


    哈哈哈，人是那个人，群不是那个群

老刘1号

回复 12# 523066680


    伪元素交换的算法摸清了……
找个位置真费脑……杀了一大片脑细胞

@echo off
Setlocal enabledelayedexpansion
::CODER BY 老刘 POWERD BY iBAT
::Set /p List=
Call :GetList 1 2 3 4 5
Call :Xchg 1 4
Call :Echo
Call :Xchg 2 3
Call :Echo
Call :Xchg 2 5
Call :Echo
Call :Xchg 3 4
Call :Echo
Pause
Exit
 
:GetList
	Set /A Prt=0
	Set list=%*
	For %%a In (%*) Do (
		Set /A Prt+=1
		Set .!Prt!=%%a
	)
Goto :Eof
 
:XChg 两元素互换
	Rem 将需要互换的第一个元素换到第一位
	Set /A SubOne=%1-1
	For /l %%a in (1 1 !SubOne!) Do Call :MoveTo !Prt!
	Set /a Steps+=SubOne
	Rem 将需要互换的第一个元素塞到第二个元素后面
		Rem 计算新list中第二个元素的位置
		Set /A Arg2Index=%2-SubOne
		Rem 挪
		Call :MoveTo !Arg2Index!
		Set /a Steps+=1
	Rem 将需要互换的第二个元素换到第一位
	Set /a Arg2SubArg1SubOne=%2-%1-1
	For /l %%a in (1 1 !Arg2SubArg1SubOne!) Do Call :MoveTo !Prt!
	Set /a Steps+=Arg2SubArg1SubOne
	Rem 将第二个元素塞到原先第一个元素的位置
		Rem 计算新list中第一个元素之前元素的位置
		Set /a 第一个元素之前元素的位置=(%1+1)-(SubOne+1+Arg2SubArg1SubOne)+prt-1
		Rem 挪
		Call :MoveTo !第一个元素之前元素的位置!
		Set /a Steps+=1
	Rem 还原其余各元素位置
	Set /A Reserve=prt-((SubOne+1+Arg2SubArg1SubOne)-1)-1
	For /l %%a in (1 1 !Reserve!) Do Call :MoveTo !Prt!
	Set /a Steps+=Reserve
Goto :Eof
 
:MoveTo 移动到原先第%1个元素的后面
	Set /A #=.1
	For /l %%a in (1 1 %1) Do (
		Set /A PlusOne=%%a+1
		Set /A .%%a=.!PlusOne!
	)
	Set /A .%1=#
Goto :Eof
 
:Echo
	For /l %%a in (1 1 !prt!) Do Set/p=!.%%a!-<nul
	Echo.
Goto :EofCOPY

4-2-3-1-5-
4-3-2-1-5-
4-5-2-1-3-
4-5-1-2-3-
请按任意键继续. . .

523066680

回复 14# 老刘1号

你用批处理，在解决问题的时候还要为批处理伤脑筋，很不容易～
要是换成其他脚本，各种骚操作、语法糖用了再说，舒服。

但仔细想想确实很蛋疼的感觉，不想写